Сюди викладатимемо всякі корисні поради та коди.
Прості запитання та відповіді
Сообщений 1 страница 10 из 13
Поделиться22008-12-11 00:04:29
Щоб в TextBox'і можна було писати тільки цифри:
Код:
Private Sub Text1_Change() Dim s As String, l As Long s = Text1.Text If Len(s) > 0 Then For l = 1 To Len(s) If Asc(Mid(s, l, 1)) < 48 Or Asc(Mid(s, l, 1)) > 57 Then MsgBox "error" Text1.Text = "" Exit Sub End If Next l End If End Sub
Поделиться32008-12-11 00:08:56
Перевести слово навпаки.Наприклад: з "програміст" в "тсімаргорп".
Код:
Option Explicit Dim strStroka As String Private Sub Form_Load() Text1.Text = "" Text2.Text = "" End Sub Private Sub Text1_Change() strStroka = Text1.Text Text2.Text = StrReverse(strStroka) End Sub
Поделиться42008-12-11 00:11:07
Розмноження картинкі на формі для фона:
Код:
Private Sub Form_Paint() Dim X As Integer, Y As Integer Dim ImgWidth As Integer Dim ImgHeight As Integer Dim FrmWidth As Integer Dim FrmHeight As Integer 'использование Image1 в PaintPicture methods: ImgWidth = Image1.Width ImgHeight = Image1.Height FrmWidth = Form1.Width FrmHeight = Form1.Height 'залить целую форму (Метод 1) For X = 0 To FrmWidth Step ImgWidth For Y = 0 To FrmHeight Step ImgHeight PaintPicture Image1, X, Y Next Y Next X 'залить левый край (Метод 2) 'For Y = 0 To FrmHeight Step ImgHeight 'PaintPicture Image1, 0, Y 'Next Y End Sub
Поделиться52008-12-11 00:16:26
Для того,щоб загрузити картинку в PictureBox або Image з диска,потрібно:
Код:
Private Sub Form_Load()
Picture1.Picture = LoadPicture("C:\Картинка.bmp(формат)") 'Шлях де лежить картинка
End SubПоделиться62008-12-11 00:19:17
Щоб переміщати форму при нажиманні на картинку:
Код:
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Sub ReleaseCapture Lib "User32" () Private Const WM_NCLBUTTONDOWN = &HA1 Private Const HTCAPTION = 2 Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim ReturnValue As Long If Button = 1 Then Call ReleaseCapture ReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub
Поделиться72008-12-11 00:42:38
Копіювати файли:
Код:
Option Explicit
Dim i As Integer
Dim strName As String
Private Sub Command1_Click()
strName = Dir(App.Path & "\123\*.*")
Do While strName <> vbNullString
FileCopy App.Path & "\123\" + strName, App.Path & "\333\" + strName
strName = Dir
Loop
End Sub
Private Sub Form_Load()
End SubПоделиться82008-12-11 00:45:40
Змінювати розширення екрану:
Код:
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean Const DM_PELSWIDTH = &H80000 Const DM_PELSHEIGHT = &H100000 Const CCFORMNAME = 32 Const CCDEVICENAME = 32 Private Type DEVMODE dmDeviceName As String * CCDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type Public Sub ChangeResolution(iWidth As Single, iHeight As Single) Dim DevM As DEVMODE Dim a As Boolean Dim i As Long Dim b As Long i = 0 Do a = EnumDisplaySettings(0&, i&, DevM) i = i + 1 Loop Until (a = False) DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT DevM.dmPelsWidth = iWidth DevM.dmPelsHeight = iHeight b = ChangeDisplaySettings(DevM, 0) End Sub Private Sub Command1_Click() ChangeResolution 640, 480 'Задавати можна любий розмір End Sub
Поделиться92008-12-11 00:47:32
Аналоговий годинник:
На форму поставити Timer1.
Код:
Const y = 100 Dim alpha_sec As Double Dim alpha_min As Double Dim alpha_hr As Double Private Sub Form_Load() Form1.ScaleMode = vbPixels Timer1.Interval = 1000 End Sub Private Sub Timer1_Timer() Me.Cls Me.Caption = Format(Time, "hh:mm:ss") alpha_sec = (2 * pi * Second(Time) / 60) - (pi / 2) alpha_min = (2 * pi * Minute(Time) / 60) - (pi / 2) alpha_hr = (4 * pi * Hour(Time) / 24) - (pi / 2) Me.DrawWidth = 1: Me.ForeColor = vbBlack Me.Circle (x, y), Rsec + 10 Me.Line (x, y)-(x + Rsec * Cos(alpha_sec), y + Rsec * Sin(alpha_sec)) Me.DrawWidth = 2: Me.ForeColor = vbBlue Me.Line (x, y)-(x + Rmin * Cos(alpha_min), y + Rmin * Sin(alpha_min)) Me.DrawWidth = 3: Me.ForeColor = vbRed Me.Line (x, y)-(x + Rhr * Cos(alpha_hr), y + Rhr * Sin(alpha_hr)) End Sub
Поделиться102008-12-11 00:54:36
відтворити звуковий файл:
Private Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
Код:
' Відтворення mciExecute "play c:\musicfile.mp3" ' Пауза mciExecute "pause c:\musicfile.mp3" ' Зупинити mciExecute "stop c:\musicfile.mp3" ' Закриття файла mciExecute "close c:\musicfile.mp3"