Помощь проекту
|
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
|
|