Леонтьев Б.К. Я изучаю Microsoft Office Visio 2003 (PDF). Удк 004. 738. 5 Ббк 32. 973. 26 018. 2

• Название: Удк 004. 738. 5 Ббк 32. 973. 26 018. 2
• Анкор: Леонтьев Б.К. Я изучаю Microsoft Office Visio 2003 (PDF).pdf
• Дата: 25.04.2017
• Размер: 0.88 Mb.
• Имя файла: Леонтьев Б.К. Я изучаю Microsoft Office Visio 2003 (PDF).pdf
• Тип: Документы; #4822
• Категория: Информатика. Вычислительная техника
• страница: 27 из 35

array для переменных,
вам придется пересмотреть ваш код при переносе его под Visual Basic 6.3.
Это слово является теперь зарезервированным (
reserved keyword) и не мо жет быть использовано в качестве имени переменной. Вы можете легко переделать ваш код при помощи команды
Replace в IDE Visual Basic 6.3,
не забудьте при этом черкнуть
Find whole words only.
Запуск AUTOMATION MANAGER как HIDDEN задачи
В случае, если вы используете
OLE Remote Automation, вы должны заранее запустить
Automation Manager на сервере до того, как случится первая
OLE remote communication. По умолчанию, это приложение visible,
но вы можете его спрятать.
Для этого создайте ярлык для
Automation Manager, который бы включал в командной строке переключатель
/Hidden:
C:\Windows\System\AutMgr32.Exe /Hidden
С другой стороны, вы можете поменять значение соответствую щего ключа в регистре.
Использование коллекции для отфильтровывания дублированных значений
Этот код иллюстрирует, как использовать коллекции (
Collection)
для генерации уникального набора величин из набора, содержащего дуб ликаты.
В этом примере сканируется массив строк и сортируются все уни кальные с использованием
list box контрола:
Sub Remove_Duplicates(arr() As String)
Dim i As Long
Dim RawData As String
Dim DataValues As New Collection
On Error Resume Next
Это вставлено для игнорирования ошибки 457 — Duplicate key.
For i = LBound(arr) To UBound(arr)
RawData = arr(i)
DataValues.Add RawData, RawData
В случае, если Run time error 457 случилась, то повторяющееся значение игнорируется.
Next
On Error GoTo 0
Использование редактора Visual Basic
277 278
Использование редактора Visual Basic

' Сохранение в List Box
' (свойство Sorted выставлено True) lstSortedData.Clear
For Each DataValue In DataValues lstSortedData.AddItem DataValue
Next
End Sub
Запись текущей позиции и размера формы при помощи SAVESETTING
Функции
SaveSetting и GetSetting облегчают написание сеттин гов. Эти две функции восстанавливают и запоминают текущие позиции формы:
Public Sub FormPosition_Get(F As Form)
' Считывает позицию формы F из ' ini/reg файла и соответственно ' позиционирует форму
Dim buf As String
Dim l As Integer, t As Integer
Dim h As Integer, w As Integer
Dim pos As Integer buf = GetSetting(app.EXEName, _
"FormPosition", F.Tag, "")
If buf = "" Then
' defaults для центрирования формы
F.Move (Screen.Width — F.Width) \ _
2, (Screen.Height — F.Height) \ 2
Else
' выделить l,t,w,h и выставить форму pos = InStr(buf, ",") l = CInt(Left(buf, pos — 1)) buf = Mid(buf, pos + 1) pos = InStr(buf, ",") t = CInt(Left(buf, pos — 1)) buf = Mid(buf, pos + 1) pos = InStr(buf, ",") w = CInt(Left(buf, pos — 1)) h = CInt(Mid(buf, pos + 1))
F.Move l, t, w, h
End If
End Sub
Public Sub FormPosition_Put(F As Form)
' Пишет op,left,height и ' width позиции формы F в reg/ini файл приложения
Dim buf As String buf = F.left & "," & F.top & "," & _
F.Width & "," & F.Height
SaveSetting app.EXEName,_
"FormPosition", F.Tag, buf
End Sub
Вам следует поместить эти процедуры в модуль и вызывать их из событий
Load и Unload форм. Вы должны написать имя формы в ее свой ство
Tag, чтобы эти процедуры работали корректно:
Sub Form_Load()
FormPosition_Get Me
End Sub
Sub Form_Unload()
FormPosition_Put Me
End Sub
Зашифрованные пароли
Следующие две функции легко и эффективно шифруют/дешиф руют текстовый пароль. Функции имеют два аргумента: число от 1 до 10
чтобы сдвигать позицию символа ASCII в пароле, и собственно строка пароля. Функция
EncryptPassword проходит через каждый символ строки
DecryptedPassword, проверяет символ на четность/нечетность, и сдвигает его вверх/вниз согласно параметру
Number. Эту делает зашифрованную строку нечитабельной. Зашифрованный пароль «укатывается» затем оператором
XOR, который еще более запутывает строку. В приведенном ниже коде ограничен параметр
Number числом 10, поскольку не надо де лать проверку на «неправильные» символы ASCII. Функция
DecryptPass
word повторяет в обратном порядке процесс шифрования, применяя
XOR, а затем сдвиг.
Function EncryptPassword(Number As _
Byte, DecryptedPassword As String)
Dim Password As String, Counter As Byte
Dim Temp As Integer
Counter = 1
Do Until Counter = _
Len(DecryptedPassword) + 1
Temp = Asc(Mid(DecryptedPassword, _
Counter, 1))
If Counter Mod 2 = 0 Then
'see if even
Temp = Temp — Number
Else
Использование редактора Visual Basic
279 280
Использование редактора Visual Basic

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
Использование редактора Visual Basic
281 282
Использование редактора Visual Basic

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
Использование редактора Visual Basic
283 284
Использование редактора Visual Basic

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
Использование редактора Visual Basic
285 286
Использование редактора Visual Basic

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
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
Сколько вам лет?
Эта функция возвращает разницу между двумя датами в годах, ме сяцах и днях:
Использование редактора Visual Basic
287 288
Использование редактора Visual Basic

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
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)