Создаём
форму и добавляем на нее: Picture1, Command1
Вставляем этот код.
Private Declare Function GetDesktopWindow Lib
"user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As
Long
Private 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
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex
As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Sub Command1_Click()
Dim hDesk, hDeskDC
'получаем дескриптор рабочего стола
hDesk = GetDesktopWindow()
' получаем контекст устройства
hDeskDC = GetDC(hDesk)
Form1.Visible = False
DoEvents
' получаем картинку
BitBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hDeskDC, 0, 0,
SRCCOPY
Form1.Visible = True
Picture1.Refresh
SavePicture Picture1.Image, "c:\qwe.bmp"
End Sub
Private Sub Form_Load()
Picture1.AutoRedraw = True
Form1.ScaleMode = 3 'Pixel
GetScreenResolution
End Sub
'Получаем разрешение экрана
Public Function GetScreenResolution() As Boolean
Dim X As Integer
Dim y As Integer
X = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)
Picture1.Height = y
Picture1.Width = X
End Function
Как сделать так, чтобы
нельзя было запустить две копии моей программы?
Добавьте в событие form_load главной
формы следующий код:
If App.PrevInstance = True Then
MsgBox "Программа уже запущенна!"
End
End I
Программное переключение клавиатуры RUS/LAT?
Следующий пример демонстрирует как это
сделать:
' Функция
для переключения раскладок клавиатуры
Private Declare Function ActivateKeyboardLayout Lib "user32" _
(ByVal HKL As Long, ByVal flags As Long) As Long
'Константы
Const kb_lay_ru As Long = 68748313 ' русский
Const kb_lay_en As Long = 67699721 ' английский
'
Переключить на русский язык
ActivateKeyboardLayout kb_lay_ru, 0
' Переключить
на английский язык
ActivateKeyboardLayout kb_lay_en, 0
Как открыть
файл?
Следующий пример демонстрирует как это
сделать:
' Функция для
запуска файла.
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String, ByVal nShowCmd As Long) As Long
' Константы
для максимизирования окна открываемого приложения.
Public Const SW_SHOWMAXIMIZED = 3
Call ShellExecute(0, "open", " C:\readme.txt","",
"", SW_SHOWMAXIMIZED) 'Открываем файл C:\readme.txt
Как изменить обои рабочего стола?
Следующий пример демонстрирует как это
сделать:
'Функция
изменяет различные системные настройки
Private Declare Function SystemParametersInfo Lib "user32"
Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As
Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
'Константа определяет
рисунок
рабочего
стола
Public Const SPI_SETDESKWALLPAPER = 20
'Использование
SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal "Имя файла", True
Как проиграть файл в формате *.mp3?
'Функция для проигрывания
файлов в формате *.mp3
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand
As String) As Long
'чтобы
воспроизвести файл
Call mciExecute("play имя вашего файла")
'чтобы
закрыть файл
Call mciExecute("close имя вашего файла")
Как проиграть файл в формате *.mid?
'Функция для проигрывания
файлов
в
формате *.mid
Private Declare Function mciSendString Lib
"winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As
String, ByVal lpstrReturnString As String, ByVal uRetrunLength As Long, ByVal
hwndCallback As Long) As Long
'Открываем файл
Call mciSendString ("open ИМЯ ВАШЕГО ФАЙЛА
type sequencer alias passport", 0, 0,0)
'Проигрываем файл
Call micSendString ("play
passport", 0, 0, 0)
'Останавливаем файл
Call micSendString ("stop
passport", 0, 0, 0)
Как проиграть файл в формате *.wav?
Функция для проигрывания
файлов в формате *.wav
Private Declare Function sndPlaySound Lib "winmm.dll" Alias
"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
As Long
'Проигрываем файл
Call sndPlaySound("ИМЯ ВАШЕГО ФАЙЛА", 0)
Как сделать не закрываемую форму?
' если у Вас VB3, раскомментируйте следующую строку
' Const vbFormControlMenu = 0
Private Sub Form_QueryUnload(Cancel As _
Integer, UnloadMode As Integer)
If UnloadMode = vbFormControl_
Menu Then
Cancel = True
End If
End Sub
Как работать с файлами?
Теория
Доступ к
бинарным файлам, в отличии от текстовых, происходит к отдельному байту в нутрии
любого файла.
Прежде чем
начать работу с бинарным файлом, его надо открыть, делается это при помощи
оператора Open:
Open ("имя_файла") For Binary As #Номер_файла
Считывание данных из бинарного файла производится оператором Get:
Get #Номер_файла, Байт,
Переменная
Запись данных
в бинарный файл производится оператором Put:
Put #Номер_файла, Байт,
Переменная
Практика
Для примера
создадим на диске C:\ новый файл mybf.txt, в который занесем данные из переменной usr:
Dim MyFile
Dim usr
As String
usr = "Hello!"
MyFile = FreeFile
Open ("C:\mybf.txt") For
Binary As #MyFile
После выполнения этого кода на диске C:\ должен появится файл mybf.txt, открым который вы увидите
строку "Hello!". Теперь, давайте, в операторе Put изменим 1 на 10:
Dim
MyFile
Dim usr
As String
usr = "Hello!"
MyFile = FreeFile
Open ("C:\mybf.txt") For
Binary As #MyFile
Put
#MyFile, 10, usr
Close
#MyFile
После этого, открыв файл mybf.txt, вы увидите нечто вроде
этого "Щ Ђ Ё Hello!". Как вы видите, слово "Hello!" начинается с 10 символа, а поскольку в
файле было 0
символов, то автоматически были добавлены еще символы в начале файла.
А теперь,
давайте, из файла mybf.txt занесем 12
байт в переменную usr:
Dim MyFile
Dim usr
As String * 1
MyFile = FreeFile
Open ("C:\mybf.txt")
For Binary As
#MyFile
Get
#MyFile, 12, usr
Close
#MyFile
MsgBox usr
После
выполнения этого кода, должно появится сообщение "l". Как вы видите, в
коде, после объявления типа переменной usr стоит "*1", это значит, что
переменная usr может иметь только один символ, попробуйте 1 изменить на 3, и в сообщение уже будет не
"l",
а "llo".