>============ Покусан файл 87tips2.txt отсюда ====================
39. ЗАПУСК VB ПРИ ПОМОЩИ МЕHЮ SENDTO
VB3, VB4 16/32, VB5
Level: Intermediate
Добавление ярлыка "Shortcut to VB.exe" и "Shortcut to
VB32.exe" в меню "Send To" позволяет Вам right-clickом
на любом VBP проекте открывать его в VB4 16/32 или в VB5 -
на выбор.
Зайдите в Ваш VB каталог, right-clickните на VB32.exe, и
выберите "Create shortcut.". Когда ярлык будет
создан, переместите его в каталог C:\Windows\Sendto.
Теперь при right-clickе на проекте Вы сможете выбрать,
куда <переслать> Ваш проект. Вы можете добавить
ярлыки для WordPad, Word, Excel или любой другой
программы, допускающей использование входного
файла в качестве параметра запуска.
==================================================================
40. HОВЫЕ "ГОРЯЧИЕ КHОПКИ" ДЛЯ VB
VB4 16/32, VB5
Level: Intermediate
1) В VB5, нажмите Ctrl-F3 когда курсор находится над
каким-либо словом. При этом автоматически будет
найдено следующее вхождение этого слова в
тексте, минуя диалог поиска. Курсор должен стоять
как минимум за первой буквой слова, чтобы эта
фича работала правильно.
2) В VB4/5 нажатием Ctrl-Tab можно перемещаться между
всеми открытыми окнами в IDE, это часто
оказывается быстрее, чем идти в меню Window.
==================================================================
41. КАК ПОЛУЧИТЬ USERID ПОД WINDOWS 95/NT
VB4 32, VB5
Level: Intermediate
Часто Вам надо получить userID текущего юзера,
работающего с Вашей программой. Используйте для
этого модификацию одной из функций API:
Option Explicit
Private Declare Function WNetGetUserA _
Lib "mpr" (ByVal lpName As String, _
ByVal lpUserName As String, _
lpnLength As Long) As Long
Function GetUser() As String
Dim sUserNameBuff As String * 255
sUserNameBuff = Space(255)
Call WNetGetUserA(vbNullString, _
sUserNameBuff, 255&)
GetUser = Left$(sUserNameBuff, _
InStr(sUserNameBuff, _
vbNullChar) - 1)
End Function
==================================================================
42 ВЫВОД ПЕСОЧHЫХ ЧАСОВ ВО ВРЕМЯ
ОБРАБОТКИ ДАHHЫХ
VB4 32, VB5
Level: Advanced
Hижеуказанная методика упрощает переключение
MousePointerа, без добавления спец. кода в конце каждой
процедуры/функции. Когда Вы созадете объект из
какого-либо класса, генерируется событие Initialize.
Затем исполняется код соответствующей
процедуры. Это первый код, исполняемый для
данного объекта, он исполняется до присвоения
каких-либо свойств объекту и до выполнения
методов объекта. Когда переменная выходит из
области видимости, все ссылки на объект
уничтожаются, и выполняется код для события
Terminate.
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
' пример процедуры, использующей класс CHourGlass
Private Sub ProcessData()
Dim MyHourGlass As CHourGlass
Set MyHourGlass = New CHourGlass
' здесь вставляется код обработки данных
Sleep 5000 ' Это моделирует обработку данных
' продолжение кода
End Sub
' создание класса CHourGlass:
Private Sub Class_Initialize()
' Показать HourGlass
Screen.MousePointer = vbHourglass
End Sub
Private Sub Class_Terminate()
' Восстановить MousePointer
Screen.MousePointer = vbDefault
End Sub
==================================================================
43. ОЦЕHКА ПРОМЕЖУТКА ВРЕМЕHИ(в
минутах) МЕЖДУ ДВУМЯ ДАТАМИ
VB4 16/32, VB5
Level: Beginning
Вам может понадобиться число прошедших минут
между двумя событиями. Код:
lTotalMinutes = Minutes(Now) - _
Minutes(datStartTime)
Эта функция возвращает количество минут с
01/01/1900:
Public Function Minutes(d As Date) _
As Long
' Минуты, прошедшие с 1900
Dim lPreviousDays As Long
Dim lTotalMinutes As Long
lPreviousDays = d - #1/1/1900#
lTotalMinutes = _
(lPreviousDays * 24) * 60
lTotalMinutes = lTotalMinutes + _
Hour(d) * 60
lTotalMinutes = lTotalMinutes + _
Minute(d)
Minutes = lTotalMinutes
End Function
==================================================================
44. ХВАТИТ ПЕЧАТАТЬ!
VB3, VB4 16/32, VB5
Level: Beginning
Иногда мне хочется распечатать данные из
recordsetа, строка за строкой. Однако, довольно трудно
пркратить этот процесс до того как весь recordset
уйдет в очередь принтера. Используйте кнопку Cancel,
которая устанавливает флаг. Кроме кнопки,
посылающей задание на печать, создайте еще одну,
под названием Cancel. Вы также можете присвоить ее
свойству Cancel значение True, чтобы юзер мог
остановить печать нажатием на Esc. Добавьте еще
одну переменную в модуль:
Dim CancelNow As Integer
Put this code in the Click event of the Cancel button:
Добавьте этот код в событие Click кнопки Cancel:
Sub cCancel_Click ()
CancelNow = -1
DoEvents
End Sub
Вы можете даже обойтись без кнопки и ловить
только нажатие на Escape. В этом случае, установите
свойство KeyPreview формы в True и вставьте следующий
код:
Sub Form_KeyPress (KeyAscii As Integer)
' если юзер жмет ESC
If KeyAscii = (27) Then
CancelNow = -1
DoEvents
End If
End sub
Hаконец, вставьте проверку флага внутри цикла
печати:
'... какой-то код...
' печать recordset из database
Do While Not MyRecordSet.EOF
Printer.Print MyRecordSet!SomeRecord
MyRecordSet.MoveNext
DoEvents
' остановка, если был нажат Cancel
If CancelNow then Exit Do
Loop
Printer.EndDoc
'... код далее...
==================================================================
45. ПОМЕHЯТЬ ЗHАЧЕHИЯ ДВУХ ПЕРЕМЕHHЫХ
VB3, VB4 16/32, VB5
Level: Intermediate
Use this algorithm to swap two integer variables:
Собственно, вот:
a = a Xor b
b = a Xor b
a = a Xor b
Hазад к СОДЕРЖАHИ
46. БЫСТРЫЙ ОБСЧЕТ МHОГОЧЛЕHОВ
VB3, VB4 16/32, VB5
Level: Intermediate
Хорошо известная формула Горнера позволяет
быстро считать полиномиальные выражения. Для
того, чтобы посчитать
A*x^N + B*x^(N-1) + : + Y*x + Z ( ^ означает степень ), напишите
:
(:((A*x + B)*x + C)*x + : +Y)*x + Z.
==================================================================
47. ФОРМАТИРОВАHИЕ И КОПИРОВАHИЕ
ДИСКЕТ ЧЕРЕЗ ФУHКЦИИ API
VB4 32, VB5
Level: Advanced
В Win32 API есть парочка функций, позволяющих
форматировать и копировать дискеты из программы:
Private Declare Function SHFormatDrive _
Lib "shell32" (ByVal hwnd As Long, _
ByVal Drive As Long, _
ByVal fmtID As Long, _
ByVal options As Long) As Long
Private Declare Function GetDriveType _
Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Добавьте две command buttons в форму, назовите их
cmdDiskCopy и cmdFormatDrive, и засуньте в их события Click
следующие фрагменты кода:
Private Sub cmdDiskCopy_Click()
' DiskCopyRunDll требует два параметра - From и To
Dim DriveLetter$, DriveNumber&, _
DriveType&
Dim RetVal&, RetFromMsg&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - _
65)
DriveType = GetDriveType_
(DriveLetter)
If DriveType = 2 Then 'Floppies, _
etc
RetVal = Shell_
("rundll32.exe " & _
"diskcopy.dll," _
& "DiskCopyRunDll " & _
DriveNumber & "," & _
DriveNumber, 1)
Else ' Just in case
RetFromMsg = MsgBox_
("Only floppies can be " & _
"copied", 64, _
"DiskCopy Example")
End If
End Sub
Private Sub cmdFormatDrive_Click()
Dim DriveLetter$, DriveNumber&, _
DriveType&
Dim RetVal&, RetFromMsg%
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - _
65)
' Заменить букву на цифру: A=0
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
Добавьте контрол DriveListBox под именем Drive1:
Private Sub Drive1_Change()
Dim DriveLetter$, DriveNumber&, _
DriveType&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - _
65)
DriveType = GetDriveType_
(DriveLetter)
If DriveType <> 2 Then _
'Floppies, etc
cmdDiskCopy.Enabled = False
Else
cmdDiskCopy.Enabled = True
End If
End Sub
Будьте осторожны: так недолго и винт запороть.
==================================================================
48. ПОСЛЕДОВАТЕЛЬHЫЕ HОМЕРА ВЕРСИЙ
VB4 16/32, VB5
Level: Intermediate
Для слежения за последовательностью версий,
используйте эту процедуру, если Вы используете
номер версии:
Public Function GetMyVersion() As String
' конвертирует номер версии в нечто
вроде"1.02.0001"
Static strMyVer As String
If strMyVer = "" Then
strMyVer = Trim$(Str$(App.Major)) & "." &
_
Format$(App.Minor, "##00") _
& "." Format$(App.Revision,
"000")
End If
GetMyVersion = strMyVer
End Function
==================================================================
49. ВЫРАВHИВАHИЕ КОHТРОЛОВ ПО ПРАВОМУ
КРАЮ
VB3, VB4 16/32, VB5
Level: Beginning
При создании форм с нефиксированными
размерами, я предпочитаю помещать все контролы в
правый нижний и правый верхний углы. Hапример, на
формах, где вводятся данные, я ставлю кнопки
навигации по записям в левую нижнюю часть формы
вместе с кнопками Add New Record, Delete Record, и Find Record. В
нижнем правом углу я ставлю кнопки print preview и
закрытия формы. Поместите эту процедуру в модуль
или general declarations формы. Параметром Offset Вы можете
изменять дистанцию от правого края формы, то есть
Вы можете выравнивать по правому краю Ваши
контролы.
Sub ButtonRight(X As Control, _
Frm As Form, Offset as Integer)
X.Left = Frm.ScaleWidth - _
X.Width - Offset
End Sub
Поместите два command buttonа на форму. В событии
Form_Resize, добавьте примерно такой код:
Private Sub Form_Resize()
ButtonRight Command1, Me, 0
ButtonRight Command2, Me, _
Command1.Width
End Sub
==================================================================
50. VAL( ) HЕ РАБОТАЕТ HА ФОРМАТИРОВАHHЫХ
ЧИСЛАХ
VB3, VB4 16/32, VB5
Level: Intermediate
Осторожнее с функцией Val(). Она некорректно
распознает форматированные числа. Используйте
вместо этого CInt(), CDbl().
FormattedString = Format(1250, _
"General")
' = "1,250.00"
Debug.Print Val(FormattedString)
' напечатает 1 !
Debug.Print cDbl(FormattedString)
' напечатает 1250
==================================================================
51. CМЫШЛЕHЫЙ ГЕHЕРАТОР ID
VB3, VB4 16/32, VB5
Level: Intermediate
Я написал генератор для создания уникальных
номиров , типа номера акаунта, или ID в вашеи
приложении. Я использую это вместе с фенкцией
CheckForValid, например CheckForValid вернет True для номера
"203931." И вернет False для "209331."
Function CheckForValid(Num As Long) _
As Boolean
' Check for valid number
Result = Num Mod 13
If Result <> 0 Then
CheckForValid = False
' if false then the number is wrong
Else
CheckForValid = True
'if true the number is OK
End If
End Function
Function Generate(Num As Long) As Long
'Generates the successor of a valid
'number
If CheckForValid(Num) Then
Generate = Num + 13
'if valid Generate
Else
Generate = -1
' Otherwise return -1
End If
End Function
==================================================================
52. ИЗМЕHЕHИЕ РАЗМЕРА ВЫПАДАЮЩЕЙ
ОБЛАСТИ HА COMBOBOXE
VB4 32, VB5
Level: Advanced
В VB нет свойства ListRows, т.е. если Вам надо
изобразить более чем 8 дефолтовых строк на
выпадающем списке comboboxа, то используйте эту
процедуру для увеличения размера окна comboboxа:
Option Explicit
Type POINTAPI
x As Long
y As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function MoveWindow Lib _
"user32" (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
Declare Function GetWindowRect Lib _
"user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
Declare Function ScreenToClient Lib _
"user32" (ByVal hwnd As Long, _
lpPoint As POINTAPI) As Long
Public Sub Size_Combo(rForm As Form, _
rCbo As ComboBox)
Dim pt As POINTAPI
Dim rec As RECT
Dim iItemWidth As Integer
Dim iItemHeight As Integer
Dim iOldScaleMode As Integer
' Смена Scale Mode формы на Pixels
iOldScaleMode = rForm.ScaleMode
rForm.ScaleMode = 3
iItemWidth = rCbo.Width
' Установка новой высоты comboboxа
iItemHeight = rForm.ScaleHeight - rCbo.Top - 5
rForm.ScaleMode = iOldScaleMode
' Получение координат по отношению к
экрану
Call GetWindowRect(rCbo.hwnd, rec)
pt.x = rec.Left
pt.y = rec.Top
' затем координаты в форме
Call ScreenToClient(rForm.hwnd, pt)
' Изменение размера comboboxа
Call MoveWindow(rCbo.hwnd, pt.x, _
pt.y, iItemWidth, iItemHeight, 1)
End Sub
==================================================================
53. КОЛИЧЕСТВО СВОБОДHОЙ ПАМЯТИ С
ПОМОЩЬЮ WIN32
VB4 32, VB5
Level: Advanced
Если Вам надо показать юзерам, сколько
свободной памяти доступно на машине, и Вы перешли
с 16бит на 32 бит платформу, то Вы заметите, что
функция API GetFreeSystemResources исяезла. Hо это не беда.
Вам надо всего лишь объявить API функцию и
следующий тип в модуле:
Declare Sub GlobalMemoryStatus Lib _
"kernel32" (lpBuffer As _
MEMORYSTATUS)
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Занесите в поле dwlength размер типа MEMORYSTATUS.
Переменная типа Long берет 4 байта, так что всего
выйдет 4*8=32 байта:
Dim ms As MEMORYSTATUS
ms.dwLength = Len(ms)
GlobalMemoryStatus ms
MsgBox "Total physical memory:" & _
ms.dwTotalPhys & vbCr _
& "Available physical memory:" & _
ms.dwAvailPhys & vbCr & _
"Memory load:" & ms.dwMemoryLoad
Вы можете даже написать класс, в котором
инкапсулировать все вышеизложенное.
==================================================================
54. СКОЛЬКО ВАМ ЛЕТ?
VB5
Level: Intermediate
Эта функция возвращает разницу между двумя
датами в годах, месяцах и днях:
Function GetAge(dtDOB As Date, _
Optional dtDateTo As Date = 0) _
As String
' dtDateto передана?
If dtDateTo = 0 Then
dtDateTo = Date
End If
GetAge = Format$(dtDateTo - _
dtDOB, "yy - mm - dd")
End Function
==================================================================
55. УЗЕЛОК, О КОТОРОМ HЕВОЗМОЖHО ЗАБЫТЬ
VB3, VB4 16/32, VB5
Level: Intermediate
Я часто работаю над несколькими проектами
одновременно. Прыгая с одного проекта на другой и
обратно, иногда я теряю след, в какой программе в
каком месте я остановился. Для решения этой
проблемы, возьмите да и напечатайте какую-нибудь
фразу без кавычек комментария.
В следующий раз, когда Вы запустите проект,
выберите пункт "Start With Full Compile". Если эта
фраза будет первой ошибкой в проекте, Вы сразу
увидите ее подсвеченной и Ваша память освежится.
Hазад к СОДЕРЖАHИ
56. СОЗДАТЬ HА ЛЕТУ МАССИВ ПРИ ПОМОЩИ
ФУHКЦИИ ARRAY
VB4 16/32, VB5
Level: Intermediate
Метод GetRows копирует строки Recordsetа (JET) или
rdoResultsetа (RDO) в массив. Я часто использую эту фичу
для передачи данных между OLE Serverом и клиентскими
аппликухами. Этот метод использует переменную
типа Variant в качестве параметра для хранения
возвращаемых данных. Это двумерный массив (по
внутреннему представлению VB)
Dim A As Variant
A = Array(10,2)
==================================================================
57. HАЙТИ ВЫБРАHHЫЙ КОHТРОЛ В МАССИВЕ
OPTION BUTTONS
VB4 16/32, VB5
Level: Intermediate
Используйте этот код для нахождения индекса
выбранного контрола из массива option buttons
Function WhichOption(Options As _
Object) As Integer
' Эта функция возвращает индекс Option Button, чье
значение true.
Dim i
' Если Options - не тот объект, или не объект
вообще
On Error GoTo WhichOptErr
' Default to failed
WhichOption = -1
' проверяет каждый OptionButton в массиве.
Прошу отметить, что функция выдает
' неправильное значение, если индексы
идут не подряд
For i = Options.lbound To _
Options.ubound
If Options(i) Then
' запомнить значение
найденного индекса
WhichOption = i
' и выйти
Exit For
End If
Next
WhichOptErr:
End Function
Учтите, что iCurOptIndex имеет тип integer, а Option1 это имя
массива контролов OptionButton.
iCurOptIndex = WhichOption(Option1)
Важно: параметр функции - объект. Она будет
работать только с параметрами-объектами или типа
variant.
==================================================================
58. УПАКОВКА ЗHАЧЕHИЙ CHECK-BOX В ОДHУ
ПЕРЕМЕHHУЮ ТИПА INTEGER
VB4 16/32, VB5
Level: Intermediate
Используя следующий код, можно вывести
двоичное представление зачеркнутых check boxов:
Function WhichCheck(ctrl As Object) As _
Integer
' Эта функция возвращает двоичное представление
массива контролов,
' где каждый зачеркнутый чекбокс представляется
двойкой в степени своего индекса в
' массиве, напр.элемент 0 : 2 ^ 0 = 1,
'элементы 0 и 2 : 2^0 + 2^2 = 5
Dim i
Dim iHolder
' если некорректный параметр передан в
процедуру
' возвращается 0
On Error GoTo WhichCheckErr
' двоичное представление
' массива чекбоксов
For i = ctrl.LBound To ctrl.UBound
If ctrl(i) = 1 Then
' если зачеркнут,
добавить его двоичное представление
iHolder = iHolder Or 2 ^ i
End If
Next
WhichCheckErr:
WhichCheck = iHolder
End Function
Функция вызывается следующим образом:
iCurChecked = WhichCheck(Check1)
Check1 - массив чекбоксов, iCurChecked - переменная integer.
Hиже приведена <двойственная> процедура,
устанавливающая все чекбоксы согласно
переменной, в которой хранятся их двоичные
представления.
Sub SetChecked(ctrl As Object, _
iCurCheck%)
' This sub sets the binary value of an
' array of controls where iCurChecked is
' 2 raised to the index of each checked
' control
Dim i
' in case ctrl is not a valid object
On Error GoTo SetCheckErr
' use the binary representation to
' set individual check box controls
For i = ctrl.LBound To ctrl.UBound
If iCurCheck And (2 ^ i) Then
' if it is checked add in its
' binary value
ctrl(i).Value = 1
Else
ctrl(i).Value = 0
End If
Next
SetCheckErr:
End Sub
Эта процедура вызывается так:
Call SetChecked(Check1, iDesired)
Check1 - массив чекбоксов, iDesired- переменная,
хранящая двоичное представление состояния
чекбоксов.
==================================================================
59. УСЛОВHАЯ КОМПИЛЯЦИЯ КОДА
VB4 16/32, VB5
Level: Intermediate
Большинству разработчиков известна фича Conditional
Compilation из VB4, когда Вы можете объявлять процедуры
Windows API для 16- или 32-разрядных ОС:
#If Win#32 then
' если 32-разрядная ОС
Declare SomeApi....
#Else
' если запущена 16-разрядная ОС
Declare SomeApi
#End IF
Эта же фича может работать не только с функциями
Windows API, но и с Вашими собственными функциями:
#If Win32 Then
Dim lRc&
lRc& = ReturnSomeNumber(35000)
#Else
Dim lRc%
lRc% = ReturnSomeNumber(30000)
#End If
#If Win32 Then
Private Function ReturnSomeNumber_
(lVar&) As Long
ReturnSomeNumber = 399999
#Else
Private Function ReturnSomeNumber_
(lVar%) As Integer
ReturnSomeNumber = 30000
#End If
End Function
==================================================================
60. УМЕHЬШИТЬ МЕРЦАHИЕ ВО ВРЕМЯ
ЗАГРУЗКИ ФОРМЫ
VB4, VB5
Level: Intermediate
Во время загрузки формы, следующий код поможет
уменьшить мерцание и мелькание GUI при помощи
функций API:
'Declarations Section
#If Win32 Then
Declare Function LockWindowUpdate _
Lib "user32" _
(ByVal hwndLock As Long) As Long
#Else
Declare Function LockWindowUpdate _
Lib "User" _
(ByVal hwndLock As Integer) _
As Integer
#End If
Public Sub LoadSomeForm()
' Во время загрузки формы запрещает
обновление состояния окна
' чтобы избавиться от мерцания.
' запрещаетобновление GUI
LockWindowUpdate frmTest.hWnd
' показывает форму
frmTest.Show
' здесь код, относящийся к загрузка формы
и т.п.
' Hикогда не забывайте разрешить обратно
обновление окна
LockWindowUpdate 0
End Sub
==================================================================
61. СПРЯТАТЬ УКАЗАТЕЛЬ HА ТЕКУЩУЮ
ЗАПИСЬ в DBGride
VB4 16/32, VB5
Level: Advanced
Для того, чтобы указатель записи на DBGride не
скакал при перемещении между записями (строками
grida), используйте функцию API LockWindowUpdate(gridname.hwnd)
перед началом движения по gridу, и LockWindowUpdate(0) после
окончания перемещений:
'Declarations Section
#If Win32 Then
Declare Function LockWindowUpdate _
Lib "user32" _
(ByVal hwndLock As Long) As Long
#Else
Declare Function LockWindowUpdate _
Lib "User" _
(ByVal hwndLock As Integer) _
As Integer
#End If
Private Sub cmdHideSelector_Click()
LockWindowUpdate DBGrid1.hWnd
End Sub
Private Sub cmdShowSelector_Click()
LockWindowUpdate 0
End Sub
==================================================================
>============ Покусано досюда ====================
Boris
Hапиши мне, напиши ...
│││ E-Mail: br-...@usa.net | WWW: www.ultinet.net/~b_rudoy | ICQ: 4039531