87 Хитростей  и трюков для Visual Basica. 

Материалы любезно переведены Антоном Минко

Cодержание

1. УПРАВЛЕНИЕ СОБЫТИЯМИ В КОМБОБОКСЕ
2. КОММЕНТИРОВАНИЕ И РАСКОММЕНТИРОВАНИЕ БЛОКОВ КОДА
3. ЗНАЧЕНИЯ ПО УМОЛЧАНИЮ ДЛЯ НЕОБЯЗАТЕЛЬНЫХ ПАРАМЕТРОВ
4. НЕ СОЗДАВАЙТЕ ALIAS-НЫХ ПЕРЕМЕННЫХ
5. ЦЕНТРИРОВАНИЕ ФОРМЫ НА ЭКРАНЕ
6. НЕ УВЛЕКАЙТЕСЬ АВТООПТИМИЗИЦИЕЙ FAST CODE
7. НЕ ВСЕ ШАБЛОНЫ СОЗДАНЫ ОДИНАКОВО
8. НАСТРОЙКА ТУЛБАРОВ В VB
9. КАК СПРЯТАТЬ ВСЕ ОКОШКИ ПРОЕКТА
10. STANDALONE БИБЛИОТЕКИ ТИПОВ
11. OBJECT BROWSER ДЛЯ НАХОЖДЕНИЯ НЕДОКУМЕНТИРОВАННЫХ ВОЗМОЖНО
12. АДРЕС ПЕРЕМЕННОЙ
13. КОГДА BENCHMARK’и ПРОГРАММЫ ДЛЯТСЯ СУТКАМИ
14. APP.PATH МОЖЕТ ВОЗВРАЩАТЬ UNC-ПУТИ
15. ЕЩЕ ОБ УНИВЕРСАЛЬНЫХ ПАРАМЕТРАХ МАССИВОВ
16. УМЕНЬШИТЬ РАЗМЕР КОДА, ИСПОЛЬЗУЯ ОПЕРАТОРЫ IIF И SWITCH
17. УСКОРЬТЕ ВАШ КОД ИСПОЛЬЗОВАНИЕМ CHOOSE
18. GOSUBS РАБОТАЮТ МЕДЛЕННО В ОТКОМПИЛИРОВАННЫХ ПРОГРАММАХ
19. «ARRAY» - ОТНЫНЕ ЭТО ОШИБОЧНОЕ ИМЯ ДЛЯ ПЕРЕМЕННЫХ
20. ЗАПУСК AUTOMATION MANAGER КАК HIDDEN ЗАДАЧИ
21. ПРОБЛЕМЫ СО ВСПЛЫВАЮЩИМИ МЕНЮ
22. ИСПОЛЬЗОВАНИЕ КОЛЛЕКЦИИ ДЛЯ ОТБОРА УНИКАЛЬНЫХ ЗНАЧЕНИЙ
23. СОЗДАНИЕ «УДАЛЕННО КОНТРОЛИРУЕМЫХ» ФОРМ
24. ЗАПИСЬ ТЕКУЩЕЙ ПОЗИЦИИ И РАЗМЕРА ФОРМЫ ПРИ ПОМОЩИ SAVESETT
25. ЭФФЕКТИВНОЕ ИСПОЛЬЗОВАНИЕ ВНУТРЕННИХ VB КОНСТАНТ
26. ПРАВИЛЬНЫЙ ТЕСТ НА "FILE EXIST"
27. ПРОЦЕДУРЫ, РАБОТАЮЩИЕ С ГРУППАМИ КОНТРОЛОВ
28. УЛУЧШЕНИЕ СКРОЛЛИНГА РИСУНКОВ
29. ЗАШИФРОВАННЫЕ ПАРОЛИ
30. ПРОПИСНЫЕ-СТРОЧНЫЕ БУКВЫ - СОВЕТ ПО СЛЕЖЕНИЮ ЗА РЕГИСТРОМ
31. ОТСЛЕЖИВАНИЕ DOUBLE CLICK ДЛЯ КНОПОК НА ТУЛБАРЕ
32. ОБЪЕМ КАТАЛОГА В БАЙТАХ
33. ПОЛЕЗНАЯ ДИСКОВАЯ ИНФОРМАЦИЯ
34. ИМИТТАЦИЯ НАЖАТИЕ CTRL ДЛЯ ВЫДЕЛЕНИЯ ОТДЕЛЬНЫХ ITEM В LIST
35. ВЫБРАТЬ ВСЕ ФАЙЛЫ ПО МАСКЕ В ПОДДЕРЕВЕ КАТАЛОГОВ
36. ИМЯ ТЕКУЩЕГО КОМПЬЮТЕРА В WINDOWS 95/NT
37. КАК ПОКАЗАТЬ ШРИФТЫ, КОГДА ВЫ ВЫБИРАЕТЕ ИХ
38. ПЕРЕХВАТ ПРАВЫХ КЛИКОВ НА УЗЛАХ TREEVIEW
39. ЗАПУСК VB ПРИ ПОМОЩИ МЕНЮ SENDTO
40. НОВЫЕ "ГОРЯЧИЕ КНОПКИ" ДЛЯ VB
41. КАК ПОЛУЧИТЬ USERID ПОД WINDOWS 95/NT
42. ВЫВОД ПЕСОЧНЫХ ЧАСОВ ВО ВРЕМЯ ОБРАБОТКИ ДАННЫХ
43. ОЦЕНКА ПРОМЕЖУТКА ВРЕМЕНИ(в минутах) МЕЖДУ ДВУМЯ ДАТАМИ
44. ХВАТИТ ПЕЧАТАТЬ!
45. ПОМЕНЯТЬ ЗНАЧЕНИЯ ДВУХ ПЕРЕМЕННЫХ
46. БЫСТРЫЙ ОБСЧЕТ МНОГОЧЛЕНОВ
47. ФОРМАТИРОВАНИЕ И КОПИРОВАНИЕ ДИСКЕТ ЧЕРЕЗ ФУНКЦИИ API
48. ПОСЛЕДОВАТЕЛЬНЫЕ НОМЕРА ВЕРСИЙ
49. ВЫРАВНИВАНИЕ КОНТРОЛОВ ПО ПРАВОМУ КРАЮ
50. VAL НЕ РАБОТАЕТ НА ФОРМАТИРОВАННЫХ ЧИСЛАХ
51. СМЫШЛЕНЫЙ ГЕНЕРАТОР ID
52. ИЗМЕНЕНИЕ РАЗМЕРА ВЫПАДАЮЩЕЙ ОБЛАСТИ НА COMBOBOXE
53. КОЛИЧЕСТВО СВОБОДНОЙ ПАМЯТИ С ПОМОЩЬЮ WIN32
54. СКОЛЬКО ВАМ ЛЕТ?
55. УЗЕЛОК, О КОТОРОМ НЕВОЗМОЖНО ЗАБЫТЬ
56. СОЗДАТЬ НА ЛЕТУ МАССИВ ПРИ ПОМОЩИ ФУНКЦИИ ARRAY
57. НАЙТИ ВЫБРАННЫЙ КОНТРОЛ В МАССИВЕ OPTION BUTTONS
58. УПАКОВКА ЗНАЧЕНИЙ CHECK-BOX В ОДНУ ПЕРЕМЕННУЮ ТИПА INTEGER
59. УСЛОВНАЯ КОМПИЛЯЦИЯ КОДА
60. УМЕНЬШИТЬ МЕРЦАНИЕ ВО ВРЕМЯ ЗАГРУЗКИ ФОРМЫ
61. СПРЯТАТЬ УКАЗАТЕЛЬ НА ТЕКУЩУЮ ЗАПИСЬ в DBGride
62. ИСПОЛЬЗОВАНИЕ POP-UP МЕНЮ В ОКНЕ БЕЗ TITLE BAR
63. КАК УЗНАТЬ РАЗДЕЛИТЕЛИ ДАТЫ И ВРЕМЕНИ БЕЗ ФУНКЦИЙ API
64. ПРЕДОТВРАЩЕНИЕ ОШИБОК ПРИ ИСПОЛЬЗОВАНИИ GETSETTING
65. ДУБЛИРОВАНИЕ СТРОК КОДА БЕЗ СИНТАКСИЧЕСКИХ ОШИБОК
66. ЯРЛЫК ДЛЯ ЗАГРУЗКИ ПОСЛЕДНЕГО РАБОЧЕГО ПРОЕКТА В VB
67. КАК ВЫВЕСТИ СИМВОЛ "&" В LABEL
68. СОЗДАНИЕ ВРЕМЕННЫХ ФАЙЛОВ
69. МЫШИНЫЕ СОБЫТИЯ НЕ СЛУЧАЮТСЯ ЕСЛИ ENABLE УСТАНОВЛЕНО В FALSE
70. КАК ВЫВЕСТИ СВОЕ POPUP MENU НА TEXT BOXES
71. ЦЕНТРИРОВАТЬ ФОРМУ С УЧЕТОМ ТАСКБАРА
72. ОЧИСТКА СТРОКИ ОТ НЕНУЖНЫХ СИМВОЛОВ
73. ПРОВЕРКА ОБЪЕКТОВ ПРИ ПОМОЩИ TYPENAME
74. ДОБАВЛЕНИЕ СТРОКИ В TEXT BOX
75. ПРОВЕРКА АРГУМЕНТОВ В ФУНКЦИИ VAL
76. ЯРЛЫКИ ДЛЯ INTERNET
77. ПРОСМОТР СОДЕРЖАНИЯ HELP-ФАЙЛА
78. ЗАДАНИЕ ГРАНИЦ MDI ФОРМЫ ТОЧНО КАК В DESIGN-TIME
79. БЫСТРЫЙ ПОИСК В БАЗЕ ДАННЫХ
80. ЛЕГКОЕ ОТСЛЕЖИВАНИЕ ПОЛОЖЕНИЯ ФОКУСА
81. НЕЗАКРЫВАЮЩАЯСЯ ФОРМА
82. ПОМЕНЯТЬ СВОЙСТВО ЦЕЛОЙ ГРУППЕ КОНТРОЛОВ
83. КАК ПРОСТО ОТФОРМАТИРОВАТЬ И ОКРУГЛИТЬ ЧИСЛО
84. БУДЬТЕ ОСТОРОЖНЫ, ЗДЕСЬ ВАМ НЕ С!
85. ИСПОЛЬЗОВАТЬ BACKQUOTES ВМЕСТО АПОСТРОФОВ
86. ПРОСТРАНЕНИЕ НОВЫХ ВЕРСИЙ ПРОГРАММЫ ПО СЕТИ
87. ЗАКРЫТЬ ОКНО ПРОГРАММЫ, КАК ЭТО ДЕЛАЕТ WINDOWS 95

1 УПРАВЛЕНИЕ СОБЫТИЯМИ В КОМБОБОКСЕ

Две проблемы могут приключиться, когда смущенный юзер ползает по комбобоксу при помощи мышки вверх и вниз, а затем нажатием на Enter делает свой юзерский выбор. Во-первых, нажатие на серую стрелочку вызывает два события: Change и Click. Во-вторых, нажатие на Enter перемещает фокус к следующему элементу формы, тогда как нажатие на кнопку мыши не вызывает подобного эффекта (т.е. фокус остается на комбобоксе). Поэтому, если Ваш код помещен в секцию события Change, то на стрелочки вверх/вниз (клавиатурой) вызовет это событие, чего Вы, естественно, не хотите. Напротив, если Вы помещаете свой код только в секцию события Lost Focus и юзер щелкает мышью на своем выборе, то фокус не уйдет из комбобокса, а юзер будет созерцать текст, который он выбрал своей мышью, и думать, почему это ничего не происходит. Нижеприведенное решение «фильтрует базар» событий Click, генерирующихся нажатиями на стрелочки клавиатуры, и вынуждает контрол потерять фокус.В секции Declarations формы введите следующее

' В VB3 надо поменять тип флага на integer
Dim bNoise as Boolean
' True означает, что происходит «шум», на который не следует реагировать

А этот код введите в секции события Form_Load:

bNoise = False

        Этот код введите в событии KeyDown комбобокса:

Private Sub cbTest_KeyDown(KeyCode As _
        Integer, Shift As Integer)
        ' если юзер использует стрелки для езды по списку комбобокса
        ' игнорировать события Click
        If KeyCode = vbKeyDown Or KeyCode _
                = vbKeyUp Then bNoise = True
End Sub

Этот код вводится в событии Click комбобокса:

Private Sub cbTest_Click()
        If bNoise Then
                ' Ignore Noise events
                ' (up or down arrow)
                bNoise = False
        Else
                ' Увести фокус с контрола
                SendKeys "{TAB}", True
        End If
End Sub

Теперь Вам остается написать код, содержащий реакцию на выбор юзера, и занести его в секцию события LostFocus комбика.
 

Назад к СОДЕРЖАНИЮ

2. КОММЕНТИРОВАНИЕ И РАСКОММЕНТИРОВАНИЕ БЛОКОВ КОДА

VB5
Level: Beginning
 

VB 5.0 позволяет Вам разом закомментировать целый блок кода, а затем также быстро раскомментировать его. Это очень полезно при отладке, когда Вам не нужно исполнять целый ряд операторов, и в то же время Вы не можете их удалить вот так вот просто за здорово живешь. Между тем, пара кнопарей Comment/Uncomment присутствует только в тулбаре Edit, который надо специально вызывать :-(. Чтобы быстро вызвать тулбар Edit, кликните правой кнопкой мыши на любом тулбаре в VB, и выберите затем команду Edit.
 
 
 
 

Назад к СОДЕРЖАНИЮ 

3. ЗНАЧЕНИЯ ПО УМОЛЧАНИЮ ДЛЯ НЕОБЯЗАТЕЛЬНЫХ ПАРАМЕТРОВ

VB5
Level: Beginning

Если Вы когда-либо программили на VB4, то Вы возможно пользовались мощной фишкой под названием Необязательные параметры (Optional parameters). VB5 пошел еще дальше: теперь эти параметры могут быть любого типа (не только Variants), и могут появляться в процедурах Property. Интересно, что Вы можете теперь задавать для них значение по умолчанию.

Property Get Value _
        (Optional index As Long = 1)
End Property

Вы можете теперь делать это без бывшего ранее обязательным (и жутко тормозным) тестом IsMissing:

Property Get Value _
        (Optional index As Long)
If IsMissing(index) Then index = 1
...
End Property

Назад к СОДЕРЖАНИЮ

4. НЕ СОЗДАВАЙТЕ ALIAS-НЫХ ПЕРЕМЕННЫХ

VB5
Level: Beginning

Никогда не передавайтe глобальную переменную в качестве аргумента в процедуру, которая также напрямую обращается к этой переменной из себя (зачем??). Если Вы на 100% уверены, что следуете этому правилу в Ваших программах, то зачеркните опцию Assume No Aliasing в диалоговом окне Advanced Optimizations, которое вызывается из пункта Compile диалога Project Properties (уф, надеюсь, понятно). Если компилятор native code знает, что этих самых alias-ных переменных нет, то он спокойно копирует значения переменных в шустрые регистры ЦПУ, и переписывает их значения обратно в RAM только при выходе из процедуры. Это увеличивает скорость исполнения скомпилированных программ.
 
 
 

Назад к СОДЕРЖАНИЮ

5. ЦЕНТРИРОВАНИЕ ФОРМЫ НА ЭКРАНЕ

VB5
Level: Beginning

Все знают о маленьком кодике, позволяющем Вам центрировать форму на экране вне зависимости от графического разрешения. Теперь Вы можете достичь того же результата, всего лишь присвоив значение vbStartUpScreen (=2) новому свойству StartUpPosition формы (появилось в версии 5). Вы даже можете отцентрировать форму относительно ее родительского окна, присвоив значение vbStartUpOwner (=1). Присвоение можно сделать в окне Property соответствующей формы. Когда Вы центрируете  форму внутри родительского окна, не забудьте добавить второй аргумент в методе Show.

Form2.Show vbModal, Me
 
 

Назад к СОДЕРЖАНИЮ

6. НЕ УВЛЕКАЙТЕСЬ АВТООПТИМИЗИЦИЕЙ FAST CODE

VB5
Level: Beginning

Если взглянуть на опции native code оптимизации, то сперва так и подмывает щелкнуть на "Optimize for Fast Code". Однако, как ни странно это может прозвучать, данное действие далеко не всегда гарантирует ожидаемый эффект. Аппликухи, оптимизированные на скоростное исполнение, как правило, не оптимизируются (пардон за каламбур), а лишь получают большее количество памяти при загрузке. Это обращается для них более медленной загрузкой, что особенно заметно на машинах с недостаточным количеством RAM, и в итоге создает впечатление, что Ваша аппликуха работает медленнее, нежели оптимизированная под компактный код. По той же самой причине, советуется компилить аппликухи в P-code. В случае объемных, UI- и базоданских аппликух, выигрыш от компиляции в native-code отнюдь не перевесит увеличения размера аппликухи. Вообще, чтобы точно знать, какая компиляция нужна Вам, юзайте VB Application Performance Explorer (APE), который лежит на VB CD.
 

Назад к СОДЕРЖАНИЮ

7. НЕ ВСЕ ШАБЛОНЫ СОЗДАНЫ ОДИНАКОВО

VBA5
Level: Beginning

В отличие от других продуктов Office 97, шаблоны Word 97 содержат business-application engine, который хранится отдельно от документов, использюущих этот engine. Основанные на шаблонах книги Excel и презентации PowerPoint  хранят в себе шаблоны, на основе которых они созданы. На практике, все документы Word состоят из 2х VBA проектов: первый проект создан на базе основного(оригинального, хранящегося в Word) шаблона (все документы Word основаны на шаблонах), а второй проект принадлежит самому документу Word. С другой стороны, книги Excel и презентации PowerPoint, созданные на шаблонах, содержат только один VBA проект. Каждый файл содержит свою собственную копию проекта оригинального шаблона. Изменения, производимые в этом шаблоне, не затрагивают основной шаблон, хранящийся в приложении.
 

Назад к СОДЕРЖАНИЮ

8. НАСТРОЙКА ТУЛБАРОВ В VB

VB5
Level: Beginning

Вот несколько предложений по настройке IDE в VB5:
Добавить закладки в тулбокс можно, кликнув правой кнопкой мыши на кнопке General (что на тулбоксе), и выбрав Add Tab. Вы можете также перемещать и удалять закладки, и перемещать иконы контролов с одной закладки на другую, используя обычный метод drag-and-drop.
Вытащить кнопку любого пункта меню на тулбар можно, кликнув правой кнопкой на любом тулбаре и выбрав пункт Customize. Перейдите на закладку Commands, выберите нужный пункт меню в правом окошке, и перетащите его на тулбар. Первыми кандидатами на добавление являются пункты Project-References,Project-Properties, и Tools-Add Procedure.
Как создать совершенно новый тулбар на вкладке Toolbars диалогового окна Customize. После того, как Вы определили содержимое будущего тулбара, для добавления кнопок на этот тулбар используйте описанную абзацем выше процедуру. Когда у Вас на экране активизировано диалоговое окно Customize, кликните правой кнопкой на любой кнопке тулбара и Вы сможете поменять рисунок кнопки, создать разделитель, спрятать/показать текст и т.д.
 

Назад к СОДЕРЖАНИЮ

9. КАК СПРЯТАТЬ ВСЕ ОКОШКИ ПРОЕКТА

VB5
Level: Beginning

Когда Вы работаете с несколькими пректами сразу, можно запутаться в нагромождении туевой хучи окошек из разных проектов. Однако, Вы можете временно спрятать все окошки, относящиеся к данному проекту, щелкнув по пиктограмме проекта в окошке Project Explorer так, чтобы все ветви, торчащие из него, исчезли. Тогда же свернутся и все окна, относящиеся к данному проекту. Эту возможность можно отменить, щелкнув на сответствующем квадратике на закладке General в меню Tools-Options.
 

Назад к СОДЕРЖАНИЮ

10. STANDALONE БИБЛИОТЕКИ ТИПОВ

 VB4 16/32, VB5 (Enterprise Edition)
Level: Intermediate

Koгда Вы создаете Ваш out-of-process OLE сервер, то VB встраивает библиотеку типов сервера (companion type library) в EXE-файл, не генерируя при этом .TLB файл. Однако, если у Вас Enterprise Edition VB4 или VB5, то зачеркнув квадратик Remote Server File, Вы заставите VB создавать standalone билиотеку типов. В VB5, эта опция находится на вкладке Component диалогового окна Properties меню Project.
 
 

Назад к СОДЕРЖАНИЮ

11. ИСПОЛЬЗОВАНИЕ OBJECT BROWSER’a длЯ нахождениЯ недокументированных возможностей

VB5
Level: Intermediate
Если кликнуть правой кнопкой мыши в правом окошке Object Browser’а (там, где нарисованы члены классов), то выскочит контекстное меню с командой Show Hidden Members. Если щелкнуть на этой команде, то отныне Object Browserбудет показывать все hidden-свойства и методы (а также и классы) любой библиотеки, и Вы можете использовать это для более детального исследования библиотек объектов.
Например, в библиотеке VBA есть hidden класс под названием _HiddenModule, в который входят многие известные функции VBA плюс три недокументированные: ObjPtr, StrPtr, и VarPtr. ObjPtr возвращает адрес private area экземпляра объекта, StrPtr возвращает адрес первого символа в строке, VarPtr возвращает адрес переменной или дескриптора строки (string descriptor), если имеем случай переменной типа string.
 
 

Назад к СОДЕРЖАНИЮ

12. АДРЕС ПЕРЕМЕННОЙ

 VB4 16/32
Level: Advanced

В VB5 есть встроенная функция VarPtr (см. Совет «ИСПОЛЬЗОВАНИЕ OBJECT BROWSER’a длЯнахождениЯ недокументированных возможностей»), но этой функции нет в VB4. Runtime library в VB4 включает эту функцию, но перед использованием ее нужно сначала объявить:

#If Win16 Then
Declare Function VarPtr Lib  "VB40016.DLL" (variable As Any)  As Long
#Else
Declare Function VarPtr Lib  "VB40032.DLL" (variable As Any)   As Long
#End If

Эта функция полезна при передаче пользовательских типов (Type structure) во внешнюю процедуру API, и в этом типе какое-либо из полей является адресом другой переменной или записи.
 

Назад к СОДЕРЖАНИЮ

13. КОГДА BENCHMARK’и (ИЗМЕРЕНИЯ СКОРОСТИ РАБОТЫ ПРОГИ) ДЛЯТСЯ СУТКАМИ

 VB4 16/32, VB5
Level: Intermediate

Обычно, программисты на VB измеряют скорость выполнения кода при помощи Timer функции. Однако, если Ваша программа должна завершиться на следующий день, то Вы должны учесть, что значение, возвращаемое функцией Timer, ресетится в полночь. Если же Вас устроит значение с точностью до одной секунды, Вы можете упростить Ваш код с помощью функции Now.

Dim startTime As Date
StartTime = Now
' the code to be benchmarked
' ...
Print "elapsedSeconds = " & Format$   ((Now - startTime) * 86400, "#####")

Вам понадобится функция Format$ для округления результата до целого.
 

Назад к СОДЕРЖАНИЮ

14. APP.PATH МОЖЕТ ВОЗВРАЩАТЬ UNC-ПУТИ

 
VB5
Level: Intermediate

В отличие от VB4, App.Path в VB5 может возвращать UNC-путь, типа "\\server\programs\...", в зависимости от обстоятельств, от того как запущена программа и запущена она из VB IDE или скомпилирована в EXE-файл. Эта особенность может сильно испортить вам жизнь, если Вы используете App.Path для установки текущего каталога при старте программы.

ChDrive App.Path
ChDir App.Path

Поскольку ChDrive на умеет обрабатывать UNC-пути, этот код может вызвать фатальную ошибку времени выполнения, но можт быть защищен использованием On Error Resume Next. Однако этот фикс не защитит Вас от всех невзгод, могущих произойти. Наилучшее решение состоит в том, чтоюы предоставить юзеру самому ввести каталог во время исполнения программы, затем записать полученный путь в регистр или INI-файл. Для более подробной инфы, см. статью Q167167 в Microsoft Knowledge Base.
 
 

Назад к СОДЕРЖАНИЮ

15 ЕЩЕ ОБ УНИВЕРСАЛЬНЫХ ПАРАМЕТРАХ МАССИВОВ

 VB4 16/32, VB5
Level: Advanced
Вы можете написать единую процедуру для любых типов массива  с любым типом в качестве аргумента, используя параметр типа Variant. Внутри процедуры, адресация элементов массива происходит обычным способом:

' return the number of items
Function ItemCount(anArray As Variant) As Long
ItemCount = UBound(anArray) - LBound(anArray) + 1
' the first element is
' anArray(LBound(anArray))
End Function

Вы можете даже запулить в процедуру многомерный массив с любым колическтвом измерений, а чтобы разобраться, сколько же у этого массива измерений, нужно производить обращения к функциям UBound и Lbound до возникновения ошибки:

Function ItemCount(anArray As Variant)As Long
Dim items As Long, i As Integer
On Error Resume Next
items = UBound(anArray) - LBound(anArray) + 1
For i = 2 to 999
        items = items * (UBound(anArray, _
                i) - LBound(anArray, i) + 1)
        If Err Then Exit For
Next
ItemCount = items
End Function
 
 

Назад к СОДЕРЖАНИЮ

16. УМЕНЬШИТЬ РАЗМЕР КОДА, ИСПОЛЬЗУЯ ОПЕРАТОРЫ IIF И SWITCH

VB4 16/32, VB5
Level: Intermediate
Часто бывает целесообразным заменить блок If...Then...Else более компактной функцией Iif:

' возвращает большую из двух сравниваемых величин
maxValue = IIf(first >= second,first, second)

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

' надо узнать, х полижительный, отрицательный, или равен 0?
Print Switch(x < 0, "negative", x > 0, _
        "positive", True, "Null")

Заметим, что значение последней проверки всегда True, так как три условия являются взаимно исключающими и избыточными.
 

Назад к СОДЕРЖАНИЮ

17. УСКОРЬТЕ ВАШ КОД ИСПОЛЬЗОВАНИЕМ CHOOSE

VB3, VB4 16/32, VB5
Level: Beginning

Вы можете использовать  Choose там, где можно заменить массив или построить таблицы результатов, на стадии компиляции (compile-time), вместо того, чтобы делать это на стадии выполнения (run time). Например, если Вам надо знать значения факториалов чисел от 1 до 10, попробуйте следующий пример (Choose производит выбор факториала из набора имеющихся значений всесто того, чтобы высчитывать факториал каждый раз заново):

Function Factorial(number As Integer) _
        As Long
Factorial = Choose(number, 1, 2, 6, _
        24, 120, 720, 5040, 40320, _
        362880, 3628800)
End Function
 
 

Назад к СОДЕРЖАНИЮ

18. GOSUBS РАБОТАЮТ МЕДЛЕННО В ОТКОМПИЛИРОВАННЫХ ПРОГРАММАХ

 VB5
Level: Intermediate

Поскольку использование GoSubs относится к неструктурированному стилю программирования, то многие программисты стараются избегать его. Если Вы компилируете Вашу VB5 аппликуху в native code, у Вас появится еще одна причина избегать этот оператор, поскольку вызовы через GoSubs могут происходить в пять раз медленнее, чем вызовы обычной процедуры или функции.
 
 

Назад к СОДЕРЖАНИЮ

19. «ARRAY» - ОТНЫНЕ ЭТО ОШИБОЧНОЕ ИМЯ ДЛЯ ПЕРЕМЕННЫХ

VB5
Level: Intermediate

Если Вы, как и я, часто используете имя "array" для переменных, Вам придется пересмотреть Ваш код при переносе его под VB5. Это слово является теперь зарезервированным (reserved keyword) и не может быть использовано в качестве имени переменной. Вы можете легко переделать Ваш код при помощи команды Replace в IDE VB5, не забудьте при этом черкнуть "Find whole words only".
 

Назад к СОДЕРЖАНИЮ

20. ЗАПУСК AUTOMATION MANAGER КАК HIDDEN ЗАДАЧИ

VB4 16/32, VB5 Enterprise Edition
Level: Advanced

Если Вы мспользуете OLE Remote Automation, Вы должны заранее запустить Automation Manager на сервере до того как случится первая OLE remote communication. По умолчанию, это приложение visible, но Вы можете его спрятать, чтобы оно не мозолило глаза на таскбаре Чикаги. Для этого создайте ярлык для Automation Manager, который бы включал в командной строке переключатель /Hidden:
C:\Windows\System\AutMgr32.Exe /Hidden
С другой стороны, Вы можете поменять значение соответствующего ключа в регистре. Для более полной инфы, см. Статью Q138067 in the Microsoft Knowledge Base.

Назад к СОДЕРЖАНИЮ

21. ПРОБЛЕМЫ СО ВСПЛЫВАЮЩИМИ МЕНЮ

 VB4 16/32, VB5
Level: Advanced

Если Вы используете всплывающие меню (popup menus) в Ваших прогах, то опасайтесь бага, имеющегося в VB4 16/32 и VB5. Если у Вас есть две формы и одна из них вызывает вторую модальную через всплывающее меню, то из этой второй модальной Вы не сможете вызвать ни одного всплывающего меню, сколько бы их на ней ни было. Чтобы пофиксить это дело, используйте таймер на первой форме. Вместо показа фторой формы из всплывающего меню по событию Click, активизируйте таймер так, чтобы он показал эту вторую форму через несколько миллисекунд. Для более полной инфы, см. Статью Q167839 in the Microsoft Knowledge Base.
 
 

Назад к СОДЕРЖАНИЮ

22.  ИСПОЛЬЗОВАНИЕ КОЛЛЕКЦИИ ДЛЯ ОТФИЛЬТРОВЫВАНИЯ ДУБЛИРОВАННЫХ ЗНАЧЕНИЙ

VB4 16/32, VB5
Level: Intermediate
Этот код иллюстрирует, как использовать коллекции (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

        ' Сохранение в List Box
        ' (свойство Sorted выставлено True)
        lstSortedData.Clear
        For Each DataValue In DataValues
                lstSortedData.AddItem DataValue
        Next
End Sub
 

Назад к СОДЕРЖАНИЮ

23. СОЗДАНИЕ «УДАЛЕННО КОНТРОЛИРУЕМЫХ» ФОРМ

VB3
Level: Intermediate

Иногда мне требуется котролировать одну форму, когда фокус находится на другой. Например, когда я жму «ОК» на форме А, мне надо сделать resize на форме В. Итак, на каждой форме, которую мне надо «удаленно контролировать», я делаю невидимый text box, назовем его TextCommand, в событии Change которого находится следующий код:

Sub TextCommand_Change ()
        Dim msg as string
        msg = Trim$(Me.TextCommand.Text)
        If Len(msg) = 0 Then Exit Sub

        Select Case msg
                Case "COMMAND_RESIZE"
                        Call MyFormResize
                Case "COMMAND_REPAINT"
                        Call MyFormPaint
                ...
        End Select
        Me.TextCommand = ""
End Sub

Вы можете удаленно контролировать форму, засылая соответствующее значение в ее TextCommand:

Sub Command1_Click ()
        formB.TextCommand = "COMMAND_RESIZE"
        DoEvents
End Sub

Этот код можно использовать для отсылки мессагов из MDI формы к потомкам:

Dim f As Form
Set f = Me.ActiveForm
f.TextCommand = "COMMAND_RESIZE"

Если Вы сидите под VB4 или VB5, Вы можете также использовать Public-свойства и методы формы.
 

Назад к СОДЕРЖАНИЮ

24. ЗАПИСЬ ТЕКУЩЕЙ ПОЗИЦИИ И РАЗМЕРА ФОРМЫ ПРИ ПОМОЩИ SAVESETTING

VB4 16/32, VB5
Level: Intermediate
Функции 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
 

Назад к СОДЕРЖАНИЮ

25. ЭФФЕКТИВНОЕ ИСПОЛЬЗОВАНИЕ ВНУТРЕННИХ VB КОНСТАНТ

VB4 16/32, VB5
Level: Beginning

Мне приходилось видеть некоторые советы по использованию числовых значений вместо соответствующих VB констант. Например, Вы можете вывести message box, используя числовые константы:

rc = MsgBox(msg, 4 + 32 + 256, "Confirm Delete")

Но не легче ли прочесть следующее?

rc = MsgBox(msg, vbYesNo + vbQuestion _
        + vbDefaultButton2, _
        "Confirm Delete")

Вы можете использовать следующие константы для check box:

        VbUnchecked =0
        VbChecked =1
        VbGrayed =2

Также полезно знать строковые константы вместо соответствующих chr$(символы ASCII):

vbTab instead of Chr$(9)
        vbCr instead of Chr$(13)
        vbLf instead of Chr$(10)
        vbCrLf instead of Chr$(13)+Chr$(10)

Назад к СОДЕРЖАНИ

26 ПРАВИЛЬНЫЙ ТЕСТ НА "FILE EXIST"

VB3, VB4 16/32, VB5
Level: Intermediate

Dir$ генерирует runtime error, если ему суют несуществующее имя диска. Например, Dir$ ("d:\win\himems.sys") умирает , если  драйв d: не существует. Для проверки существования файла, добавьте обработчик ошибки:

Function FileExist(filename As String) _
        As Boolean
        On Error Resume Next
        FileExist = Dir$(filename) <> ""
        If Err.Number <> 0 Then FileExist _
                = False
        On Error GoTo 0
End Function
 
 

Назад к СОДЕРЖАНИЮ

27. ПРОЦЕДУРЫ, РАБОТАЮЩИЕ С ГРУППАМИ КОНТРОЛОВ

VB4 16/32, VB5
Level: Intermediate

Вы можете использовать почти забытую возможность VB иметь процедуру или функцию, работающую с неограниченным числом аргументов, что может быть полезно при работе с множеством контролов. Например, Вы можете enable/disable группу контролов одним вызовом процедуры:

EnableAll True, Text1, Text2, _
        Command1, Command2

Эта процедура проходит по всем контролам, передаваемым в качестве аргументов:

Sub EnableAll(Enabled As Boolean, _
        ParamArray objs() As Variant)
                Dim obj As Variant
                For Each obj In objs
                        obj.Enabled = Enabled
                Next obj
End Sub
 

Назад к СОДЕРЖАНИЮ

28 УЛУЧШЕНИЕ СКРОЛЛИНГА РИСУНКОВ

VB3, VB4 16/32, VB5
Level: Intermediate
Во-первых, сделайте, чтобы событие Scroll скроллбара картинки обновляло координаты картинки (как будто бы она движется) когда Вы возите мышой по картинке. Затем, объявите следующие переменные на уровне формы:

Dim StartX As Long, StartY As Long
Dim Moving As Boolean

Finally, declare these three events for PicPicture:
Наконец, объявите эти три события для PicPicture:

Private Sub PicPicture_MouseDown_
        (Button As Integer, Shift As _
        Integer, x As Single, y As Single)
                StartX = x
                StartY = y
                Moving = True
End Sub

Private Sub PicPicture_MouseMove_
        (Button As Integer, Shift As _
        Integer, x As Single, y As Single)
                If Moving Then
                        PicPicture.Move _
                                PicPicture.Left + x - StartX, PicPicture.Top + y - StartY
                End If
End Sub

Private Sub PicPicture_MouseUp_
        (Button As Integer, Shift As _
        Integer, x As Single, y As Single)
                Moving = False
End Sub

Теперь Вы можете скроллить картинку мышой. Не забудьте проверить границы картинки.

 
Назад к СОДЕРЖАНИЮ

29. ЗАШИФРОВАННЫЕ ПАРОЛИ

 VB3, VB4 16/32, VB5
Level: Intermediate

Следующие две функции легко и эффективно шифрут/дешифруют текстовый пароль. Функции имеют два аргумента: число от 1 до 10 чтобы сдвигать позицию символа ASCII в пароле, и собственно строка пароля. Функция EncryptPassword проходит через каждый символ строки DecryptedPassword, проверяет символ на четность/нечетность, и сдвигает его вверх/вниз согласно параметру Number. Эту делает зашифрованную строку нечитабельной. Зашифрованный пароль «укатывается» затем оператором XOR, который еще более запутывает строку. Я ограничил параметр Number числом 10, поскольку мне не надо делать проверку на «неправильные» символы ASCII. Функция DecryptPassword повторяет в обратном порядке процесс шифрования, применяя 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
                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

Назад к СОДЕРЖАНИЮ

30. ПРОПИСНЫЕ-СТРОЧНЫЕ БУКВЫ - СОВЕТ ПО СЛЕЖЕНИЮ ЗА РЕГИСТРОМ БУКВ

VB4 16/32, VB5
Level: Intermediate
Если Вы используете левую стрелку на клаве, чтобы перейти к началу слова, а затем нажимаете букву, то в итоге Вы получаете две заглавных буквы (первая уже была, а вторую ввели Вы - я так понимаю??). Применив код, который использует преимущества встроенной в VB4/VB5 функции StrConv(), Вы получите автоматическое приведение букв в нужный регистр во время ввода:

Private Sub Text1_Change()
        If Text1.Tag = "" Then
                Text1.Tag = Text1.SelStart
                Text1.Text = StrConv(Text1.Text,        vbProperCase)
                Text1.SelStart = Text1.Tag
                Text1.Tag = ""
        End If
End Sub
 

Назад к СОДЕРЖАНИЮ

31. ОТСЛЕЖИВАНИЕ DOUBLE CLICK ДЛЯ КНОПОК НА ТУЛБАРЕ

VB4 32, VB5
Level: Intermediate
VB4 поддерживает встроенный в Win95 контрол Toolbar, позволяющий юзерам добавлять кнопки на Тулбар. У этих кнопок есть событие ButtonClick, но если Вы хотите отлавливать double-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

Назад к СОДЕРЖАНИЮ

32. ОБЪЕМ КАТАЛОГА В БАЙТАХ

 VB3, VB4 16/32, VB5
Level: Intermediate

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

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

Назад к СОДЕРЖАНИЮ

33. ПОЛЕЗНАЯ ДИСКОВАЯ ИНФОРМАЦИЯ

VB4 32, VB5
Level: Advanced

Эта функция возвращает количество свободного пространства на диске, общий объем диска, долю свободного пространства н адиске, и использванное пространство. Перед вызовом функции, присвойте первому полю структуры DISKSPACEINFO ("RootPath") имя диска:

Dim dsi As DISKSPACEINFO
dsi.RootPath = "C:\"
GetDiskSpace dsi

Функция возвращает все результаты в других полях записи(структуры):

' *** Declaratiosn Section ******
Declare Function GetDiskFreeSpace Lib _
        "kernel32" Alias _
        "GetDiskFreeSpaceA" _
        (ByVal lpRootPathName As String, _
        lpSectorsPerCluster As Long, _
        lpBytesPerSector As Long, _
        lpNumberOfFreeClusters As Long, _
        lpTotalNumberOfClusters As Long) _
        As Long

Type DISKSPACEINFO
        RootPath As String * 3
        FreeBytes As Long
        TotalBytes As Long
        FreePcnt As Single
        UsedPcnt As Single
End Type

' ****** МОДУЛЬ КОДА ******
Function GetDiskSpace(CurDisk As _
        DISKSPACEINFO)
        Dim X As Long
        Dim SxC As Long, BxS As Long
        Dim NOFC As Long, TNOC As Long

        X& = GetDiskFreeSpace_
                (CurDisk.RootPath, SxC, BxS, _
                NOFC, TNOC)
        GetDiskSpace = X&

        If X& Then
                CurDisk.FreeBytes = BxS * _
                        SxC * NOFC
                CurDisk.TotalBytes = BxS * _
                        SxC * TNOC
                CurDisk.FreePcnt = ((CurDisk._
                        TotalBytes CurDisk._
                        FreeBytes) / CurDisk._
                        TotalBytes) * 100
                CurDisk.UsedPcnt = _
                        (CurDisk.FreeBytes / _
                        CurDisk.TotalBytes) * 100
        Else
                CurDisk.FreeBytes = 0
                CurDisk.TotalBytes = 0
                CurDisk.FreePcnt = 0
                CurDisk.UsedPcnt = 0
        End If
End Function

В таком виде, функция работает с драйвами размера где-то до 2Гб, для больших дисков надо использовать переменные типа Single.
 

Назад к СОДЕРЖАНИЮ

34. КАК СЫМИТИРОВАТЬ НАЖАТИЕ КЛАВИШИ CTRL ДЛЯ ВЫДЕЛЕНИЯ НЕСВЯЗАННЫХ КУСКОВ В LIST BOX

 VB4 32, VB5
Level: Advanced

Когда свойство 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)

Назад к СОДЕРЖАНИЮ

35. ВЫБРАТЬ ВСЕ ФАЙЛЫ ПО МАСКЕ В ПОДДЕРЕВЕ КАТАЛОГОВ

VB3, VB4 16/32, VB5
Level: Intermediate

Поскольку этот код не использует API, Вы можете легко перенести его с 16- на 32-разрядную платформу и обратно. Процедура DirWalk позводит Вам просмотреть все поддерево, начиная с заданнного места:

ReDim sArray(0) As String
Call DirWalk("OLE*.DLL", "C:\", sArray)

Эта процедура принимает * и ? в первом аргументе, который задает маску поиска. Вы можете задать несколько масок, разделяя их символом «;», например, "OLE*.DLL; *.TLB". Второй аргумент - место старта, третий аргумент - массив строк.
Эта процедура рекурсивно проходит по всем каталогам и кладет все файлы, удовлетворяющие условию, в массив sArray с указанием полного пути. Этот массив меняет свои размеры в зависимости от количества файлов, удовлетворяющих условиям поиска.
Для использовния DirWalk, пихните два контрола, FileListBox и DirListBox, на форму. Эта процедура подразумевает, что она работает с контролами на текущей форме: : FileListBox по имени File1, и DirListBox по имени Dir1. Для увеличения скорости работы сделайте эти контролы невидимыми. Использование этих контролов не требует приобретения дополнительных тулзов, так как они (контролы) содержатся в базовой библиотеке контролов VB.

Sub DirWalk(ByVal sPattern As String, _
        ByVal CurrDir As String, sFound() _
        As String)
Dim i As Integer
Dim sCurrPath As String
Dim sFile As String
Dim ii As Integer
Dim iFiles As Integer
Dim iLen As Integer

If Right$(CurrDir, 1) <> "\" Then
        Dir1.Path = CurrDir & "\"
Else
        Dir1.Path = CurrDir
End If
For i = 0 To Dir1.ListCount
        If Dir1.List(i) <> "" Then
                DoEvents
                Call DirWalk(sPattern, _
                        Dir1.List(i), sFound())
        Else
                If Right$(Dir1.Path, 1) = "\" _
                        Then
                        sCurrPath = Left(Dir1.Path, _
                                Len(Dir1.Path) - 1)
                Else
                        sCurrPath = Dir1.Path
                End If
                File1.Path = sCurrPath
                File1.Pattern = sPattern
                If File1.ListCount > 0 Then
                        ' нужные файлы найдены в каталоге
                        For ii = 0 To File1._
                                ListCount - 1
                                ReDim Preserve _
                                        sFound(UBound(sFound) _
                                        + 1)
                                sFound(UBound(sFound) - _
                                        1) = sCurrPath & _
                                        "\" & File1.List(ii)
                        Next ii
                End If
                iLen = Len(Dir1.Path)
                Do While Mid(Dir1.Path, iLen, _
                        1) <> "\"
                        iLen = iLen - 1
                Loop
                Dir1.Path = Mid(Dir1.Path, 1, _
                        iLen)
        End If
Next i
End Sub

Назад к СОДЕРЖАНИ

36. ИМЯ ТЕКУЩЕГО КОМПЬЮТЕРА В WINDOWS 95/NT

VB4 32, VB5
Level: Advanced

Часто Вам надо знать имя текущего компа под WINDOWS 95/NT из Вашей 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
 

Назад к СОДЕРЖАНИЮ

37. КАК ПОКАЗАТЬ ШРИФТЫ, КОГДА ВЫ ВЫБИРАЕТЕ ИХ

VB3, VB4 16/32, VB5
Level: Intermediate
Чтобы юзер мог изменить имя шрифта, загрузите все шрифты в комбобокс:

Private Sub Form_Load()
        ' определить количество экранных шрифтов.
        For I = 0 To Screen.FontCount - 1
                ' засунуть все шрифты в листбокс.
                cboFont.AddItem Screen.Fonts(I)
        Next I
End Sub

Украсьте процедуру, позволив юзеру сразу видеть результат своего выбора, без необходимости печатать «что-нибудь» в качестве теста:

Private Sub cboFont_Click()
        ' сделать выбранный FontName шрифтом combobox
        cboFont.FontName = cboFont.Text
End Sub
 

Назад к СОДЕРЖАНИЮ

38. ПЕРЕХВАТ ПРАВЫХ КЛИКОВ НА УЗЛАХ TREEVIEW

 
VB4 32, VB5
Level: Intermediate

Контрол TreeView придает Вашей аппликухе законченный вид Windows 95. Однако, в учебниках по VB не сказано, как перехватывать правый мышиный клик на узле (node) дерева. Событие 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
 

Назад к СОДЕРЖАНИЮ

39. ЗАПУСК VB ПРИ ПОМОЩИ МЕНЮ 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. НОВЫЕ “ГОРЯЧИЕ КНОПКИ” ДЛЯ 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 ВЫВОД ПЕСОЧНЫХ ЧАСОВ ВО ВРЕМЯ ОБРАБОТКИ ДАННЫХ

VB4 32, VB5
Level: Advanced

Нижеуказанная методика упрощает переключение 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. ОЦЕНКА ПРОМЕЖУТКА ВРЕМЕНИ(в минутах)  МЕЖДУ ДВУМЯ ДАТАМИ

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

Наконец, вставьте проверку флага внутри цикла печати:

'... какой-то код...
' печать recordset из database
Do While Not MyRecordSet.EOF
        Printer.Print MyRecordSet!SomeRecord
        MyRecordSet.MoveNext
        DoEvents
        ' остановка, если был нажат Cancel
        If CancelNow then Exit Do
Loop
Printer.EndDoc
'... код далее...

Назад к СОДЕРЖАНИЮ

45. ПОМЕНЯТЬ ЗНАЧЕНИЯ ДВУХ ПЕРЕМЕННЫХ

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

 
Назад к СОДЕРЖАНИ

46. БЫСТРЫЙ ОБСЧЕТ МНОГОЧЛЕНОВ

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. ФОРМАТИРОВАНИЕ И КОПИРОВАНИЕ ДИСКЕТ ЧЕРЕЗ ФУНКЦИИ 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. ПОСЛЕДОВАТЕЛЬНЫЕ НОМЕРА ВЕРСИЙ

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. ВЫРАВНИВАНИЕ КОНТРОЛОВ ПО ПРАВОМУ КРАЮ

VB3, VB4 16/32, VB5
Level: Beginning

При создании форм с нефиксированными размерами, я предпочитаю помещать все контролы в правый нижний и правый верхний углы. Например, на формах, где вводятся данные, я ставлю кнопки навигации по записям в левую нижнюю часть формы вместе с кнопками 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( ) НЕ РАБОТАЕТ НА ФОРМАТИРОВАННЫХ ЧИСЛАХ

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МЫШЛЕНЫЙ ГЕНЕРАТОР 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. ИЗМЕНЕНИЕ РАЗМЕРА ВЫПАДАЮЩЕЙ ОБЛАСТИ НА 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. КОЛИЧЕСТВО СВОБОДНОЙ ПАМЯТИ С ПОМОЩЬЮ WIN32

 VB4 32, VB5
Level: Advanced

Если Вам надо показать юзерам, сколько свободной памяти доступно на машине, и Вы перешли с 16бит на 32 бит платформу, то Вы заметите, что функция API GetFreeSystemResources исяезла. Но это не беда. Вам надо всего лишь объявить 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. УЗЕЛОК, О КОТОРОМ НЕВОЗМОЖНО ЗАБЫТЬ

VB3, VB4 16/32, VB5
Level: Intermediate

Я часто работаю над несколькими проектами одновременно. Прыгая с одного проекта на другой и обратно, иногда я теряю след, в какой программе в каком месте я остановился. Для решения этой проблемы, возьмите да и напечатайте какую-нибудь фразу без кавычек комментария.
В следующий раз, когда Вы запустите проект, выберите пункт "Start With Full Compile". Если эта фраза будет первой ошибкой в проекте, Вы сразу увидите ее подсвеченной и Ваша память освежится.

Назад к СОДЕРЖАНИ

56. СОЗДАТЬ НА ЛЕТУ МАССИВ ПРИ ПОМОЩИ ФУНКЦИИ 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. НАЙТИ ВЫБРАННЫЙ КОНТРОЛ В МАССИВЕ 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. УПАКОВКА ЗНАЧЕНИЙ CHECK-BOX В ОДНУ ПЕРЕМЕННУЮ ТИПА 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. Ниже приведена «двойственная» процедура, устанавливающая все чекбоксы согласно переменной, в которой хранятся их двоичные представления.

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. УСЛОВНАЯ КОМПИЛЯЦИЯ КОДА

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. УМЕНЬШИТЬ МЕРЦАНИЕ ВО ВРЕМЯ ЗАГРУЗКИ ФОРМЫ

 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
        ' здесь код, относящийся к загрузка формы и т.п.
 
        ' Никогда не забывайте разрешить обратно обновление окна
        LockWindowUpdate 0
End Sub

Назад к СОДЕРЖАНИЮ

61. СПРЯТАТЬ УКАЗАТЕЛЬ НА ТЕКУЩУЮ ЗАПИСЬ в 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

Назад к СОДЕРЖАНИЮ

62. USE POPUP MENUS IN WINDOWS WITHOUT TITLE BAR

 VB4 16/32
Level: Intermediate

Когда Вы устанавливаете свойство ControlBox в False и BorderStyle в fixed window, то можете получить окно(форму) без titlebar (поля заголовка). Если же вы добавите меню на эту форму - титул-бар появится снова. Чтобы измежать этой проблемму вы можете разместить меню на другой форме.
 

Private Sub Command1_Click()
        Dim frm As New frmMenu
        Load frm
        frm.PopupMenu frm.mnutest
        'select specific code
        Unload frm
End Sub

Такое поведение исправлено в VB5
 
 
 

Назад к СОДЕРЖАНИЮ

63. КАК УЗНАТЬ РАЗДЕЛИТЕЛИ ДАТЫ И ВРЕМЕНИ БЕЗ ФУНКЦИЙ API

VB3, VB4 16/32, VB5
Level: Intermediate

Вот простой алгоритм как узнать разделители даты, времени и десятичной точки в 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)
 
 

Назад к СОДЕРЖАНИЮ

64. ПРЕДОТВРАЩЕНИЕ ОШИБОК ПРИ ИСПОЛЬЗОВАНИИ GETSETTING

VB4 16/32, VB5
Level: Intermediate

Использование функции GetSetting может породить ошибки, особенно в некоторых ситуациях при 16-разрядной ОС при работе с INI файлами. Если искомого параметра нет в INI файле, то Вы можете увидеть сообщение об ошибке "Invalid procedure call.". Используйте нижеприведенную процедуру, которая подменяет обработчик ошибок:

Public Function GetRegSetting(AppName _
        As Variant, Section As Variant, _
        Key As Variant, Optional Default _
        As Variant) As Variant

' дефолтовое значение не имеет не-объектный тип , иначе придется
' использовать слово Set
Dim tmpValue As Variant

' установка величины по умолчанию
' если величина передана не была,
' получаем пустую переменную типа Variant
If Not IsMissing(Default) Then _
        tmpValue = Default

' это отлавливает возможные ошибки
On Error Resume Next

' теперь можно использовать функцию из VB
tmpValue = GetSetting(AppName, _
        Section, Key, tmpValue)

' после возможных ошибок вызов повторяется здесь
' с уже определенным значением tmpValue
GetRegSetting = tmpValue

End Function
 

Назад к СОДЕРЖАНИЮ

65. ДУБЛИРОВАНИЕ СТРОК КОДА БЕЗ СИНТАКСИЧЕСКИХ ОШИБОК

VB3, VB4 16/32, VB5
Level: Beginning
Часто мне приходится переписывать сходный по смыслу код с небольшими изменениями в каждой строке; для облегчения проблемы я делаю шаблон того, что надо копировать, быстро вставляю копию в нужное место, и делаю добавления. Однако часто шаблонный текст вызывает ошибки со стороны VB редактора. Одолеть эту проблему можно, закомментировав шаблон перед использованием. Когда Вы закончите редактирование вставленного фрагмента, раскомментируйте его и он готов. Это особенно просто под VB5, в котором есть команда 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 раз, вернитесь к началу и впечатайте имена свойств и полей, и уберите символ комментария. Символ комментария позволяет Вам свободно бегать по всему фрагменту, не заботясь о синтаксических ошибках.
 

Назад к СОДЕРЖАНИ

66. ЯРЛЫК ДЛЯ ЗАГРУЗКИ ПОСЛЕДНЕГО РАБОЧЕГО ПРОЕКТА В VB

VB4 32
Level: Intermediate
Часто я старутю VB и возобновляю работу с последним проектом, но мне не хочется загромождать 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 _
                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
 

Назад к СОДЕРЖАНИЮ

67. КАК ВЫВЕСТИ СИМВОЛ "&" В LABEL

VB4 16/32, VB5
Level: Beginning

Если Вы хотите выывести символ «&» на экран, установите свойство "UseMnemonic" в False. Это свойство бывает полезно, когда, например, Labelы используются для вывода данных из баз данных. Также Вы можете вывести символ "&" в свойстве Caption, написав &&.

Назад к СОДЕРЖАНИЮ

68. СОЗДАНИЕ ВРЕМЕННЫХ ФАЙЛОВ

 
VB3, VB4 16/32, VB5
Level: Beginning

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

Назад к СОДЕРЖАНИЮ

69. МЫШИНЫЕ СОБЫТИЯ НЕ СЛУЧАЮТСЯ ЕСЛИ ENABLE УСТАНОВЛЕНО В FALSE

VB3, VB4 16/32, VB5
Level: Beginning
События MouseMove не происходят, если свойство Enabled контрола установлено в False. Мой метод лечит эту проблему и он может быть полезен, если Вы хотите вывести Tooltips или Notes на статусбаре, вне зависимости от того, enabled контрол или disabled.
Если свойство Enabled контрола установлено в False, то контрол, помещенный за данным, тем не менее быдет отзываться на движения мыши. Скопируйте код из Command1_MoseMove в Label1_MouseMove. Теперь Ваш МаусМув работает даже если Command1 недоступна.

  Command1(0), Command1(1)-Command1 - массив контролов.
  Label1(0), Label1(1)- массив лабелов за контролами.
  SSPanel1-Работает статусбаром.

Private Sub Form_Load()
Dim i As Integer
For i = 0 To 1
        Label1(i).Left = Command1(i).Left
        Label1(i).Top = Command1(i).Top
        Label1(i).Width = Command1(i).Width
        Label1(i).Height = _
                Command1(i).Height
Next i
Command1(0).enabled = false
Command1(0).Tag = "Button to Add"
Command1(1).Tag = "Button to Modify"
Command1(0).Caption = "&Add"
Command1(1).Caption = "&Modify"

End Sub

Private Sub Label1_MouseMove(Index As _
        Integer, Button As Integer, Shift _
        As Integer, X As Single, Y As _
        Single)
        SSPanel1.Caption =    Command1(Index).Tag
End Sub

Private Sub Command1_MouseMove(Index _
        As Integer, Button As Integer, _
        Shift As Integer, X As Single, Y _
        As Single)
        SSPanel1.Caption = Command!(Index).tag
End Sub
 

Назад к СОДЕРЖАНИЮ

70. КАК ВЫВЕСТИ СВОЕ POPUP MENU НА TEXT BOXES

 VB4 16/32, VB5
Level: Intermediate

Некоторые контролы в VB4 и VB5 как, например, TextBox имеют по дефолту контекстное меню, выползающее при правом клике на указанном контроле. Если Вы хотите, чтобы выезжало другое котекстное меню, то стандартных методов или пропертей для этого не существует. Выход состоит в отлавливании события Mouse_Down, код которого будет делать контрол недоступным. Затем высвечивайте Ваше контекстное меню, энаблите контрол обратно. Процедура PopContextMenu описывает указанный метод

Sub PopContextMenu(argoControl As _
        Control, argoMenu As Control)
                argoControl.Enabled = False
                PopupMenu argoMenu
                argoControl.Enabled = True
End Sub

Пример вызова в событии MouseDown для текстбтокса по имени Text1 и меню MyMenu:

Private Sub Text1_MouseDown(Button As _
        Integer, Shift As Integer, X As _
        Single, Y As Single)
                If Button = vbRightButton Then
                        PopContextMenu Text1, MyMenu
                End If
End Sub

Назад к СОДЕРЖАНИЮ

71. ЦЕНТРИРОВАТЬ ФОРМУ С УЧЕТОМ ТАСКБАРА

VB3, VB4 16/32, VB5
Level: Intermediate
Для центрирования формы Вам надо лишь вызвать API процедуру, и завести две константы. Это решение основано на том факте, что GetSystemMetrics возвращает истинное значение параметров экрана, который может быть на самом деле занят таскбаром и Microsoft Office shortcut barом:

Public Const SM_CXFULLSCREEN = 16
Public Const SM_CYFULLSCREEN = 17

#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

Назад к СОДЕРЖАНИЮ

72. ОЧИСТКА СТРОКИ ОТ НЕНУЖНЫХ СИМВОЛОВ

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

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
 
 
 
 
 

Назад к СОДЕРЖАНИЮ

73. ПРОВЕРКА ОБЪЕКТОВ ПРИ ПОМОЩИ TYPENAME

VB4 16/32, VB5
Level: Beginning
 

Вы можете определить класс, к которому принадлежит объект, при помощи функции TypeName вместо использования блока If TypeOf. Используйте выражение TypeOf для определения типа объекта:

If TypeOf myObject is myType then
        ... делаем то-то
End If

Вы можете сделать то же савмое при помощи следующего кода:

if TypeName(myObject) = "myType" Then
        .... делаем то-то....
End If

Выгода моего решения в том, что Вам вовсе не обязательно включать в Ваш проект все классы (или OCXs), с которыми Вы работаете. Это неплохой прием для написания общих процедур (универсальных, общего назначения) и , более того, Вы можете использовать TypeName в сложных проверках и блоках Select Case.
 

Назад к СОДЕРЖАНИЮ

74. ДОБАВЛЕНИЕ СТРОКИ В TEXT BOX

VB4 16/32, VB5
Level: Intermediate

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

' Переход к концу текста
MyTextBox.SelStart = Len(MyTextBox.Text)
' Новый текст будет стоять здесь
MyTextBox.SelText = NewText$
 

Назад к СОДЕРЖАНИЮ

75. ПРОВЕРКА АРГУМЕНТОВ В ФУНКЦИИ VAL

VB3, VB4 16/32, VB5
Level: Beginning

При использовании функции Val, VB капризничает, порождая ошибку несоответствия типов. Например, Val("25%") правильно возвращает 25, тогда как Val("2.5%") неправильно интерпретирует входной параметр и возвращает ошибку несоответствия типов. Это случается только тогда, когда в строке присутствует десятичная точка и символ "%" или "&". Чтобы исправить это, уберите эти символы из строки перед ее передачей в Val.

Назад к СОДЕРЖАНИЮ

76. ЯРЛЫКИ ДЛЯ INTERNET

VB4 32, VB5
Level: Advanced

VB5 App Wizard умеет создавать Web Browser-форму, но она работает только с Microsoft Internet Explorer и Вам приходится таскать за собой SHDOCVW.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

Назад к СОДЕРЖАНИЮ

 77. ПРОСМОТР СОДЕРЖАНИЯ HELP-ФАЙЛА

 
VB4 32, VB5
Level: Intermediate

Многие программеры любят добавлять к свои приложениям и хелп-файлы. Как открыть содержание хелп-файла 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

Назад к СОДЕРЖАНИЮ

78. ЗАДАНИЕ ГРАНИЦ MDI ФОРМЫ ТОЧНО КАК В DESIGN-TIME

 VB3, VB4 16/32, VB5
Level: Beginning

Поскольку MDI-формы ни имеют свойства border, юзер может раздвигать их границы и менять размер MDI-форм. Если юзер пытается изменить размеры формы, а я этого не хочу (пусть остается такой как была создана мной), то процедура для события MDIForm_Resize() спасет (кого - по вкусу):

Private Sub MDIForm_Resize()
        ' Запрет resizingа MDI-формы (растягивания границ и перемещения ее мышой).
        ‘ Годитсятолько для тех MDI форм, которые выводятся как Normal Window
        If WindowState = 0 Then
                ' заданная высота MDI формы
                Me.Height = 6900
                ' заданная ширина MDI формы
                Me.Width = 10128
                ' заданный левый край MDI формы
                Me.Left = 1020
                ' заданный правый край MDI формы
                Me.Top = 1176
                ' С таким же успехом можно использовать метод Move, чтобы объединить
                ‘ восстановление координат формы в одной команде
End If
End Sub

Назад к СОДЕРЖАНИЮ

79. БЫСТРЫЙ ПОИСК В БАЗЕ ДАННЫХ

 VB3, VB4 16/32, VB5
Level: Beginning
В VB нет встроенной процедуры типа DLookUp из Аксесса. Вы можете использовать нижеприведенный код для получения 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
 

Назад к СОДЕРЖАНИЮ

80. ЛЕГКОЕ ОТСЛЕЖИВАНИЕ ПОЛОЖЕНИЯ ФОКУСА

VB3, VB4 16/32, VB5
Level: Intermediate

Lost_Focus and 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 statement используйте вызов процедуры проверки.
Используйте  strActive in a Select Case structure
К моменту , когда случается команда  Print , strActive равен контролу, имеющему фокус, и  strControlName содержит имя контрола, который потерял фокус.
Не размещайте эту процедуру где-либо кроме таймера.

Назад к СОДЕРЖАНИЮ

81. НЕЗАКРЫВАЮЩАЯСЯ ФОРМА

VB3, VB4 16/32, VB5
Level: Beginning

Если выставить свойство 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
 
 

Назад к СОДЕРЖАНИЮ

82. ПОМЕНЯТЬ СВОЙСТВО ЦЕЛОЙ ГРУППЕ КОНТРОЛОВ

VB3, VB4 16/32, VB5
Level: Beginning

Вы можете легко сделать видимой/невидимой целую группу контролов. В режиме разработки, выделите все контролы, с которыми Вы будете производить данную операцию при выполнении программы. Нажмите F4, и присвойте свойству Tag имя группы, например Group1. Теперь при совершении групповой операции Вам поможет следующий код:

For ind = 0 To Formname.Controls.Count _
        - 1
        If Formname.Controls(ind).Tag = _
                "Group1" Then
                Formname.Controls(ind).Visible _
                        = True
        End If
Next
 

Назад к СОДЕРЖАНИЮ

83. КАК ПРОСТО ОТФОРМАТИРОВАТЬ И ОКРУГЛИТЬ ЧИСЛО

VB3, VB4 16/32, VB5
Level: Intermediate

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

n = 12.345
Format(n, "0.00\0")
' возвращает   "12.350"
Format(n, "0.\0\0")
' возвращает "12.00"
Format(0.55, "#.0\0") ' возвращает ".60"
 

Назад к СОДЕРЖАНИЮ

84. БУДЬТЕ ОСТОРОЖНЫ, ЗДЕСЬ ВАМ НЕ С!

VB3, VB4 16/32, VB5
Level: Intermediate

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

Dim x As Integer
Dim y As Integer
Dim z As Integer
 
x = 10
y = 20
z = 0
 
' пусть функция max возвращает большее из двух чисел
if  (z = max(x, y)) > 0 then
        Msgbox CStr(z)
Else
        Msgbox "How Come?"
End if

Вы ожидаете, что высветится 20, как должно бы было произойти в С? Однако, VB сравнит z с RHS (right-hand side)-правой стороной, даже перед присвоением, независимо от скобок. Будьте внимательны.

Назад к СОДЕРЖАНИЮ

8.5 ИСПОЛЬЗОВАТЬ BACKQUOTES ВМЕСТО АПОСТРОФОВ

 VB3, VB4 16/32, VB5
Level: Intermediate
Часто при использовании Transact-SQL мне надо перехватывать комментарии юзера из текстбокса и пересылать их в базу данных. Однако, если юзер нажимает апостроф в текстбоксе, происходит ошибка времени выполнения, поскольку SQL Server использует апостроф как признак конца строки. Чтобы обойти эту проблему, перехватите ввод юзера в событии KeyPress и замените апостроф на вот такую кавычку «‘»(ASCII(145)):

Private Sub Text1_Keypress_
        (KeyAscii as Integer)
        If KeyAscii = 39 Then
                KeyAscii = 145
        End If
End Sub

Также можно заменить все одинарные кавычки на «‘» перед отсылкой в SQL Server.
 

Назад к СОДЕРЖАНИ

86. РАСПРОСТРАНЕНИЕ НОВЫХ ВЕРСИЙ ПРОГРАММЫ ПО СЕТИ

VB4 16/32, VB5
Level: Intermediate

Я пишу VB проги для сети с примерно 300 юзерами. Довольно трудно своевременно уследить за распространением каждой новой версии проги на всех машинах, поэтому я использую такую фичу VB автоинкрементирующаяся нумерация версий для проверки, требуется ли апгрейд проги на конкретной машине. При компиляции проги установите автоинкремент версий в On. Сохраните Ваши setup/upgrade файлы на сетевом диске (настоятельно рекомендую использовать UNC-пути (\\имя_машины\имя_диска) нежели просто имена дисков), и положите INI-файл проги, в котором указан номер новейшей версии. Затем вставьте следующий код в прогу, событие Form_Load:

Open IniFile$ For Input As #1
Line Input #1, sUpgradeVersion$
Close #1

If sUpgradeVersion > (Format(App.Major, "00") & "." & _
        Format(App.Minor, "00") & "." & _
        Format(App.Revision, "0000")) Then
                ' запуск апгрейда с сетевого диска
End
End If

Если версия в INI-файле выше, чем версия, записанная в .exe, то прога автоматом запустит программу апгрейда по сети и закончит свое выполнение, то есть все нужные файлы смогут быть заменены. Это особенно полезно, когда Вы только начинаете писать прогу, то есть апгрейды и фиксы появляются чуть ли не раз в несколько дней.
 
 
 

Назад к СОДЕРЖАНИЮ

87. ЗАКРЫТЬ ОКНО ПРОГРАММЫ, КАК ЭТО ДЕЛАЕТ WINDOWS 95

VB3, VB4 16/32, VB5
Level: Intermediate

Разместите этот код в declaration section модуля:

Public Sub Win95Shrivel(xForm As Form)
        ' минимизирует окно
        xForm.WindowState = 1
End Sub

Вызывайте ее из процедуры Unload формы

Private Sub Form_Unload(Cancel As _
        Integer)
        Win95Shrivel Me
End Sub

Каждый раз при unloade формы она сначала быренько сворачивается к таскбару, а затем исчезает. Это работает и в Windows 3.1x тоже.
 
 
Назад к СОДЕРЖАНИЮ

                                                                   ОБСУДИТЬ СТАТЬЮ НА ФОРУМЕ