Все то, что вы найдёте здесь,
Однажды встанет Вам удачей!
Однажды встанет Вам удачей!
Помощь проекту
Visual Basic
- Как в Visual Basic отформатировать диск (скопировать дискету)?
- Как в Visual Basic очистить Корзину?
- Как в Visual Basic очистить строку от ненужны символов?
- Как в Visual Basic перебрать все файлы?
- Как в Visual Basic перебрать все элементы управления?
- Как в Visual Basic перекрасить точку на экране?
- Как в Visual Basic переместить окно?
- Как в Visual Basic переместить элемент списка?
- Как в Visual Basic показать песочные часы?
- Как в Visual Basic получить изображение экрана?
Как в Visual Basic отформатировать диск (скопировать дискету)?
Поместите данный код в модуль
Public Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Копирование дискет
Public Sub DiskCopy(ByVal Drv as Sting)
Dim DriveLetter as String, DriveNumber as Long, DriveType as Long
Dim RetVal as Long, RetFromMsg as Long
DriveLetter = UCase(Drv)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then
RetVal = Shell("rundll32.exe " & "diskcopy.dll," & "DiskCopyRunDll " & DriveNumber & "," & DriveNumber, 1)
Else
RetFromMsg = MsgBox("Only floppies can be " & "copied", 64, "DiskCopy Example")
End If
End Sub
Форматирование диска
Public Sub FormatDrive(ByVal Drv as String)
Dim DriveLetter as String, DriveNumber as Long, DriveType as Long
Dim RetVal as Long, RetFromMsg as Long
DriveLetter = UCase(Drv)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then
RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Else
RetFromMsg = MsgBox("This drive is NOT a removeable drive! Format this drive?", 276, "SHFormatDrive Example")
If RetFromMsg = 6 Then
' раскоментируйте для форматирования диска
' RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
End If
End If
End Sub
Внимание! Будьбе очень осторожны в экспериментах, вы можете отформатировать винчестр, а это потеря всех данных!
Как в Visual Basic очистить Корзину?
Public Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOCONFIRMATION = &H1
Const SHERB_NOPROGRESSUI = &H2
Const SHERB_NOSOUND = &H4
Комбинация флагов:
SHERB_NOCONFIRMATION ' Не показывать подверждение удаления файлов пользователю
SHERB_NOPROGRESSUI ' Не показывать диалоговое окно,показывающее процесс удаления файлов из Корзины
SHERB_NOSOUND ' Не воспроизводить звук после удаления файлов из Корзины
Код очистки Корзины выглядит так:
a = SHEmptyRecycleBin(Form1.hWnd, "", SHERB_NOPROGRESSUI)
Как в Visual Basic очистить строку от ненужны символов?
Private Function StringCleaner(s As String, Search As String) As String
Dim i As Integer, res As String
res = s
Do While InStr(res, Search)
i = InStr(res, Search)
res = Left(res, i - 1) & Mid(res, i + 1)
Loop
StringCleaner = res
End Function
Как в Visual Basic перебрать все файлы?
Поместите на форму элементы Dir, File и List для создания списка найденных файлов. Свойству Pattern объекта File задайте нужную маску (по умолчанию "*.*")
Private Sub Searsh(ByVal PathFiles As String)
Dim i As Integer
Dir1.Path = PathFiles
File1.Path = Dir1.Path
For i = 0 To File1.ListCount - 1
List1.AddItem Dir1.Path & Iif(Right(Dir1.Path, 1) = "\","","\") & File1.List(i)
Next
For i = 0 To Dir1.ListCount - 1
Searsh Dir1.List(i)
Next
Dir1.Path = Dir1.List(-2)
End Sub
Как в Visual Basic перебрать все элементы управления?
Dim myControl
For Each myControl In Me.Controls
If TypeOf myControl Is ComandButton Then
myControl.Visible = False
End If
Next
Как в Visual Basic перекрасить точку на экране?
Public Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Как в Visual Basic переместить окно?
Public Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Поместите этот код в процедуру:
a = MoveWindow(Form1.hWnd, 200, 150, 175, 300, 1)
Как в Visual Basic переместить элемент списка?
Dim TmpText As String
Dim Old_Index As Integer
Dim New_Index As Integer
Private Sub List1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Old_Index = List1.ListIndex
TmpText = List1.Text
End Sub
Private Sub List1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
New_Index = List1.ListIndex
If New_Index <> Old_Index Then
List1.RemoveItem Old_Index
List1.AddItem TmpText, New_Index
End If
End Sub
Как в Visual Basic показать песочные часы?
Screen.MousePointer = vbHourglass ' показать песочные часы
...
Screen.MousePointer = vbDefault ' востановить указатель по умолчанию
Как в Visual Basic получить изображение экрана?
Код описания функций и констант лучше поместить в модуль
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Const SRCCOPY = &HCC0020
Код, копирующий изображение экрана в окно. Размещается в форме. Не забудьте свойство формы AutoRedraw установить в True.
Dim hDesk as Long, hDeskDC as Long
hDesk = GetDesktopWindow()
hDeskDC = GetDC(hDesk)
BitBlt Me.hDC, 0, 0, Width, Height, hDeskDC, 0, 0, SRCCOPY
