Леонтьев Б.К. Я изучаю Microsoft Office Visio 2003 (PDF)

Temp = Temp + Number

End If

Temp = Temp Xor (10 — Number)

Password = Password & Chr$(Temp)

Counter = Counter + 1

Loop

EncryptPassword = Password

End Function

Function DecryptPassword(Number As _

Byte, EncryptedPassword As String)

Dim Password As String, Counter As Byte

Dim Temp As Integer

Counter = 1

Do Until Counter = _

Len(EncryptedPassword) + 1

Temp = Asc(Mid(EncryptedPassword, _

Counter, 1)) Xor (10 — Number)

If Counter Mod 2 = 0 Then 'see if even

Temp = Temp + Number

Else

Temp = Temp — Number

End If

Password = Password & Chr$(Temp)

Counter = Counter + 1

Loop

DecryptPassword = Password

End Function

Отслеживание DOUBLE CLICK для кнопок на «тулбаре»

Visual Basic 6.3 поддерживает встроенный в Windows XP контрол Toolbar, позволяющий пользователям добавлять кнопки на Тулбар. У этих кнопок есть событие ButtonClick, но если вы хотите отлавливать dou# ble#click, то стандартного события ButtonDoubleClick нет. Для того, чтобы исправить это, объявите две переменные уровня формы:

Private mbSingleClicked As Boolean Private mbDoubleClicked As Boolean

In the Toolbars ButtonClick event, add this code:

В событии ButtonClick Тулбара добавьте следующий код:

Private Sub Toolbar1_ButtonClick_

(ByVal Button As Button)

Dim t As Single

t = Timer

If mbSingleClicked = True Then mbDoubleClicked = True

MsgBox "Double Clicked" Else

mbSingleClicked = True

'позволить юзеру кликнуть еще раз, если он хочет дабл кликнуть Do While Timer — t < 1 And mbSingleClicked = True

DoEvents Loop

'если юзер сделал DoubleClick, выйти из процедуры

If mbDoubleClicked = True Then mbSingleClicked = False mbDoubleClicked = False

Exit Sub

End If

End If

If mbDoubleClicked = False Then MsgBox "Single Clicked"

End If

'пример обработки этих событий 'If mbDoubleClicked Then ' code

'ElseIf mbSingleClicked Then ' code

'End If

'при выходе из процедуры надо реинитить переменные, иначе мы 'упремся в SingleClickи

If mbDoubleClicked = False Then mbSingleClicked = False mbDoubleClicked = False

End If

End Sub

Объем каталога в байтах

Эта функция возвращает число байт, занятых файлами в каталоге:

Function DirUsedBytes(ByVal dirName As _ String) As Long

Dim FileName As String

Dim FileSize As Currency

' добавить \, если не было

If Right$(dirName, 1) <> "\" Then dirName = dirName & "\"

Endif

FileSize = 0

FileName = Dir$(dirName & "*.*") Do While FileName <> "" FileSize = FileSize + _ FileLen(dirName & FileName) FileName = Dir$

Loop

DirUsedBytes = FileSize End Function

Пример вызова такой функции:

MsgBox DirUsedBytes(«C:\Windows»)

Как сделать имитацию нажатия клавиши CTRL для выделения несвязанных кусков в LIST BOX

Когда свойство MultiSelect обычного listboxа установлено в 1 — Simple или в 2 — Extended, то юзеру надо жать Ctrl при кликании внутри этого listboxа, чтобы выделять несвязанные (не идущие подряд) элементы. Следующий метод позволяет пользователю выбирать несколько элемен тов, не нажимая при этом Ctrl. Поместите нижеприведенный код в модуль.

Declare Function GetKeyboardState Lib _ "user32" (pbKeyState As Byte) _

As Long

Declare Function SetKeyboardState Lib _ "user32" (lppbKeyState As Byte) _

As Long

Public Const VK_CONTROL = &H11 Public KeyState(256) As Byte

Этот код поместите в событие MouseDown вашего listboxа (назовем его List1), у которого свойство MultiSelect установлено в Simple или

Extended:

' "нажимает" Ctrl GetKeyboardState KeyState(0) KeyState(VK_CONTROL) = _ KeyState(VK_CONTROL) Or &H80 SetKeyboardState KeyState(0)

Этот код поместите в процедуру, в которой надо «отжать» Ctrl, к примеру, List1_LostFocus:

' "отжимает" Ctrl

GetKeyboardState KeyState(0)

KeyState(VK_CONTROL) = _

KeyState(VK_CONTROL) And &H7F

SetKeyboardState KeyState(0)

Имя текущего компьютера

Часто вам надо знать имя текущего компьютера под Windows XP из вашей VB программы. Используйте эту простенькую функцию API из kernel32.dll:

Private Declare Function GetComputerNameA Lib "kernel32"_ (ByVal lpBuffer As String, nSize _ As Long) As Long Public Function GetMachineName() As _ String

Dim sBuffer As String * 255

If GetComputerNameA(sBuffer, 255&) _ <> 0 Then GetMachineName =

Left$(sBuffer, _ InStr(sBuffer, vbNullChar) _ — 1) Else

GetMachineName = "(Not Known)" End If

End Function

Перехват правых кликов на узлах TREEVIEW

Событие Treeview_MouseDown происходит до события NodeClick. Для того, чтобы показать контекстное меню над узлом, используйте этот код и определите ключ (Key) для для каждого узла в виде буквы и идущим за ней числом.

+ Root (R01) ' the letter gives

| Child 1 (C01) ' the indication to | + Child 2 (C02) ' the context menu | | Child 2.1 (H01)

| | Child 2.2 (H02)

Dim bRightMouseDown as Boolean Private Sub Form_Load() bRightMouseDown = False

End Sub

Private Sub treeview1_MouseDown_ (Button As Integer, Shift As _ Integer, X As Single, Y As Single) If Button And vbRightButton Then bRightMouseDown = True

Else

bRightMouseDown = False End If

End Sub

Private Sub treeview1_MouseUp_ (Button As Integer, Shift As _ Integer, X As Single, Y As Single) bRightMouseDown = False

End Sub

Private Sub treeview1_NodeClick_ (ByVal Node As Node)

Select Case Left(Node.Key, 1) Case "R"

If Not bRightMouseDown Then

'do the normal node click,

'so you must here the code

'for the node code click Else

'выбор узла

treeview1.Nodes(Node.Key).Selected = True

'показать контекстное меню PopupMenu mnuContext1

End If Case "C"

If Not bRightMouseDown Then

'do the normal node click,

'so you must here the code

'for the node code click Else

'выбор узла

treeview1.Nodes(Node.Key).Selected = True

'показать контекстное меню PopupMenu mnuContext2

End If

'то же с остальными узлами

'....

End Select

End Sub

Горячие кнопки

В Visual Basic 6.3 нажмите Ctrl#F3 когда курсор находится над каким либо словом. При этом автоматически будет найдено следующее вхождение этого слова в тексте, минуя диалог поиска. Курсор должен стоять как минимум за первой буквой слова, чтобы это работало правильно.

В Visual Basic 6.3 нажатием Ctrl#Tab можно перемещаться между всеми открытыми окнами в IDE, это часто оказывается быстрее, чем идти в меню Windows.

Как получить USERID

Часто вам надо получить 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

Вывод песочных часов во время обработки данных

Нижеуказанная методика упрощает переключение 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

Быстрый «обсчет» многочленов

Хорошо известная формула Горнера позволяет быстро считать по линомиальные выражения. Для того, чтобы посчитать:

A*x^N + B*x^(N#1) + … + Y*x + Z (^ означает степень), напишите:

(…((A*x + B)*x + C)*x + … +Y)*x + Z.

Последовательные номера версий

Для слежения за последовательностью версий, используйте эту процедуру, если вы используете номер версии:

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

Изменение размера выпадающей области на COMBOBOX

В Visual Basic 6.3 нет свойства ListRows, то есть если вам надо изо бразить более чем восемь дефолтовых строк на выпадающем списке 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

288 Использование редактора Visual Basic

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

Сколько вам лет?

Эта функция возвращает разницу между двумя датами в годах, ме сяцах и днях:

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

Создать на лету массив при помощи функции ARRAY

Метод GetRows копирует строки Recordset (JET) или rdoResultset

(RDO) в массив. Этот метод использует переменную типа Variant в каче стве параметра для хранения возвращаемых данных. Это двумерный мас сив (по внутреннему представлению VB):

Dim A As Variant

A = Array(10,2)

Упаковка значений CHECK BOX в одну переменную типа INTEGER

Используя следующий код, можно вывести двоичное представле ние зачеркнутых 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

290 Использование редактора Visual Basic

Next

WhichCheckErr:

WhichCheck = iHolder

End Function

Функция вызывается следующим образом:

iCurChecked = WhichCheck(Check1)

Check1 — массив чекбоксов, iCurChecked — переменная integer. Ниже приведена «двойственная» процедура, устанавливающая все чек боксы согласно переменной, в которой хранятся их двоичные представ ления.

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 — переменная, хранящая двоичное представление состояния чекбоксов.

Условная компиляция кода

Вы можете объявлять процедуры Windows API для 16 или 32 раз рядных операционных систем при использовании Conditional Compila tion из Visual Basic 6.3:

#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

Уменьшить мерцание во время загрузки формы

Во время загрузки формы, следующий код поможет уменьшить мерцание и мелькание 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

'здесь код, относящийся к загрузка формы и т.п.

'Никогда не забывайте разрешить обратно обновление окна LockWindowUpdate 0

End Sub

Спрятать указатель на текущую запись в DBGride

Для того, чтобы указатель записи на 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

Как узнать разделители даты и времени без функции API

Вот простой алгоритм, как узнать разделители даты, времени и де сятичной точки в Windows, не залезая в Locale Settings или функции API.

DateDelimiter = Mid$(Format(Date, _

"General Date"), 3, 1)

TimeDelimiter = Mid$(Format(0.5, _

"Long Time"), 3, 1)

DecimalDelimiter = Mid$(Format(1.1, _

"General Number"), 2, 1)

Дублирование строк кода без синтаксических ошибок

Часто приходится переписывать сходный по смыслу код с неболь шими изменениями в каждой строке; для облегчения проблемы можно сделать шаблон того, что надо копировать, быстро вставлять копию в нужное место, и делать добавления. Однако часто шаблонный текст вы зывает ошибки со стороны Visual Basic 6.3 редактора. Одолеть эту про блему можно, закомментировав шаблон перед использованием. Когда вы закончите редактирование вставленного фрагмента, раскомменти руйте его и он готов. Это особенно просто под Visual Basic 6.3, в котором есть команда Block Uncomment. Ниже приведен пример добавления чле на в коллекцию.

While Not mRS.EOF oObject.FName = mRS!FName oObject.LName = mRS!LName oObject.Phone = mRS!Phone

cCollection.Add oObject, oObject.FName Wend

В случае, если же у вашего объекта 20 или 30 свойств, быстрее бу дет создать шаблон:

' oObject. = mRS!

Скопируйте его, вставьте 20 или 30 раз, вернитесь к началу и впе чатайте имена свойств и полей, и уберите символ комментария. Символ комментария позволяет вам свободно бегать по всему фрагменту, не за ботясь о синтаксических ошибках.

Ярлык для загрузки последнего рабочего проекта в Visual Basic 6.3

Часто вы стартуете Visual Basic 6.3 и возобновляете работу с по следним проектом, но вам не хочется загромождать desktop иконками для текущих работ. В качестве решения предлагается программа, кото рую нужно скомпилировать и запустить на вашем desktopе. Эту програм му можно применить и к другим, использующим INI файлы.

Option Explicit

Declare Function GetPrivateProfile_ String Lib "kernel32" _

Alias "GetPrivateProfileStringA" _ (ByVal lpApplicationName As _ String, ByVal lpKeyName As Any, _ ByVal lpDefault As String, _ ByVal lpReturnedString As _

294 Использование редактора Visual Basic

String, ByVal nSize As Long, _ ByVal lpFileName As String) _ As Long

Public Sub Main()

Dim temp As String, rVal$, tmp _ As Long

rVal$ = String$(256, 0)

tmp = GetPrivateProfileString_ ("Visual Basic", _ "vb32location", "", rVal$, _ ByVal Len(rVal$) — 1, _ "c:\windows\vb.ini")

temp = Left$(rVal$, tmp) rVal$ = String$(256, 0)

tmp = GetPrivateProfileString_ ("Visual Basic", "RecentFile1", _ "", rVal$, ByVal Len(rVal$) _

1, "c:\windows\vb.ini")

temp = temp & " """ & Left$(rVal$, _ tmp) & """"

Shell temp, 1 End

End Sub

Создание временных файлов

При программировании баз данных можно создавать временные файлы для, к примеру, вывода результата инструкции SQL или из вре менной базы данных, чтобы более эффективно работать с записями. Функция FileAux возвращает имя временного файла. В случае, если надо создать несколько временных файлов одновременно, сохраните их име на в заранее определенных переменных:

Function FileAux(Ext As String) _ As String

Dim i As Long, X As String

If InStr(Ext, ".") = 0 Then Ext = "." + Ext

End If

' Ищем уже имеющиеся файлы на винте i = 0

Do

X = "Aux" + Format$(i, "0000") _ + Ext

If FileExists(X) Then

i = i + 1 Else

Exit Do

End If Loop

FileAux = X End Function

Эта функция обращается к функции FileExists:

Function FileExist(filename As String) _ As Boolean

FileExist = Dir$(filename) <> "" End Function

А вот пример использования: Sub Test()

Dim File1 As String, File2 As _ String, File3 As String

Dim DB1 As database, DB2 As DataBase Dim FileNum As Integer

File1 = FileAux("MDB")

Set DB1 = CreateDataBase(File1) File2 = FileAux("MDB")

Set DB2 = CreateDataBase(File2) File3 = FileAux("TXT")

FileNum = FreeFile

Open File3 For OutPut As FileNum

'Ваш код

'...

Close FileNum End Sub

File1, File2 и File3 должны быть Aux0001.MDB, Aux0002.MDB и Aux0001.TXT соответственно.

Центрировать форму с учетом TaskBar

Для центрирования формы вам надо лишь вызвать API процедуру, и завести две константы. Это решение основано на том факте, что GetSystemMetrics возвращает истинное значение параметров экрана, ко торый может быть на самом деле занят таскбаром и Microsoft Office short cut barом:

Public Const SM_CXFULLSCREEN = 16

Public Const SM_CYFULLSCREEN = 17

296 Использование редактора Visual Basic

#If Win32 then

Declare Function GetSystemMetrics _ Lib "user32" _

(ByVal nIndex As Long) As Long #Else

Declare Function GetSystemMetrics _ Lib "User" _

(ByVal nIndex As Integer) _ As Integer

#End If

Public Sub CenterForm(frm As Form) frm.Left = Screen.TwipsPerPixelX * _ GetSystemMetrics_

(SM_CXFULLSCREEN) / 2 _frm.Width / 2

frm.Top = Screen.TwipsPerPixelY * _ GetSystemMetrics_

(SM_CYFULLSCREEN) / 2 _frm.Height / 2

End Sub

Очистка строки от ненужных символов

Иногда бывает полезно иметь функцию, которая очищает строку от нежелательных символов. Эта маленькая функция принимает в каче стве параметров строку для очистки и символ, от которого ее надо очис тить:

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

Добавление строки в TEXT BOX

Используйте данный код, чтобы заставить скроллер TextBox авто матически передвинуться, когда вы добавляете новый текст:

' Переход к концу текста MyTextBox.SelStart = Len(MyTextBox.Text)

' Новый текст будет стоять здесь MyTextBox.SelText = NewText$

Проверка аргументов в функции VAL

При использовании функции Val, Visual Basic 6.3 капризничает, порождая ошибку несоответствия типов. Например, Val(«25%») пра вильно возвращает 25, тогда как Val(«2.5%») неправильно интерпретиру ет входной параметр и возвращает ошибку несоответствия типов.

Это случается только тогда, когда в строке присутствует десятич ная точка и символ «%» или «&». Для того, чтобы исправить это, уберите эти символы из строки перед ее передачей в Val.

Ярлыки для Интернет

Visual Basic 6.3 умеет создавать web форму, но она работает только с Microsoft Internet Explorer и вам приходится таскать за собой SHD# OCVW.DLL при распространении программы. В случае, если вы исполь зуете функцию ShellExecute для запуска файла Internet Shortcut, то Windows запускает дефолтный браузер и переходит на указанный URL. Этот метод работает как Microsoft так и с Netscape браузерами, если они правильно прописаны в регистре, и вам не нужно перетаскивать никаких DLL при распространении программы.

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 Private Const SW_SHOWNORMAL = 1

'frm : ShellExecute использует обработчик окна.

'Вы можете использовать обработчик главного окна проги

'sUrl : это имя и путь к файлу .url (файл Internet shortcut)

'указывающий на Вашу страницу , напр.

'c:\MyWebPage.url использует Internet Explorer

'для создания файла ярлыка

Public Sub GoToMyWebPage(frm as Form, _ sUrl as string)

Dim lRet as Long

lRet = ShellExecute(frm.hwnd, _ "open", sUrl, vbNull, _ vbNullString, SW_SHOWNORMAL)

If lRet <= 32 Then

'случилась ошибка. Некоторые из ошибок,

'возвращаемых ShellExecute:

'ERROR_FILE_NOT_FOUND = 2&

'ERROR_PATH_NOT_FOUND = 3&

'ERROR_BAD_FORMAT = 11&

'SE_ERR_NOASSOC = 31

'SE_ERR_OOM = 8

Else

' если браузер запущен! End If

End Sub

Просмотр содержания HELP файла

Многие программисты любят добавлять к своим приложениям и хелп файлы. Как открыть содержание help файла Windows из вашей программы? Вот пример кода с использованием Win32 API функции.

' Объявление

Const HELP_CONTENTS = &H3& ' Функции Вывода содержимого

Declare Function WinHelp Lib "user32" _ Alias "WinHelpA" _

(ByVal hwnd As Long, _

ByVal lpHelpFile As String, _ ByVal wCommand As Long, _ ByVal dwData As Long) As Long ' Код

Sub OpenHelpFile(HelpFileName As String) ' HelpFileName — путь к хелп файлу. WinHelp hwnd, HelpFileName, _ HELP_CONTENTS, 0

End Sub

Быстрый поиск в базе данных

В Visual Basic 6.3 нет встроенной процедуры типа DLookUp из Аccess. Вы можете использовать нижеприведенный код для получения Name объекта по его ID:

Public Function MyDLookUp(Column As _ String, TableName As String, _ Condition As String) As Variant

Dim Rec As Recordset

On Error GoTo MyDlookUp_Err

' gCurBase — глобальная переменая, указывающая на текущкю БД

Set Rec = gCurBase.OpenRecordset_

("Select * From " & TableName)

Rec.FindFirst Condition

If Not Rec.NoMatch Then

'возвращает искомое поле, если найдено MyDLookUp = Rec(Column)

Exit Function End If

'возврат, если не найдено, или произошла другая ошибка MyDlookUp_Err:

MyDLookUp = 1 End Function

Легкое отслеживание положения фокуса

Lost_Focus и Got_Focus events часто используются для проверки правильности ввода текста. Вы можете использовать нижеприведенный код для отслеживания фокуса на форме, не программируя каждый кон трол отдельно.

Поместите timer control на форму, установите Interval property = 100 и Enabled = True.

Name the control tmrFocusTracking.

Timer event должен содержать следующий код: Private Sub tmrFocusTracking_Timer()

Dim strControlName As String Dim strActive As String strControlName = _ Me.ActiveControl.Name

Do

strActive = Me.ActiveControl.Name If strControlName <> strActive _ Then

Print strControlName & _ " — Lost Focus", _

strActive & " — Got Focus" strControlName = strActive End If

DoEvents Loop

End Sub

To implement universal highlighting, replace the Print statement with this code:

Me.Controls(strActive).SelStart = 0

Me.Controls(strActive).SelLength = _ Len(Me.Controls(strActive))

Для проверки (validation) правильности текста вместо Print state# ment используйте вызов процедуры проверки.

К моменту, когда случается команда Print, strActive равен контро лу, имеющему фокус, и strControlName содержит имя контрола, который потерял фокус.

Не размещайте эту процедуру где либо кроме таймера.

Незакрывающаяся форма

В случае, если выставить свойство ControlBox на форме в False, то кнопки Minimize и Maximize тоже исчезнут. Предположим, что вы хотите тем не менее давать возможность юзеру использовать кнопки Minimize и Maximize, но при этом чтобы он не мог закрыть форму кнопкой с крести ком. Добавьте следующий код в событие Query_Unload:

'если у Вас 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

Как просто отформатировать и округлить число

Пример округления с заданной точностью:

n = 12.345 Format(n, "0.00\0")

'возвращает "12.350" Format(n, "0.\0\0")

'возвращает "12.00"

Format(0.55, "#.0\0") ' возвращает ".60"

Будьте осторожны, здесь вам не С!

VB программеры, привыкшие к С, могут быть введены в заблужде ние следующей особенностью VB. Рассмотрим код:

Dim x As Integer Dim y As Integer Dim z As Integer x = 10

y = 20