| Russian LinkExchange Member |
87 Хитростей и трюков для Visual Basica.
Две проблемы могут приключиться, когда смущенный юзер ползает по комбобоксу при помощи мышки вверх и вниз, а затем нажатием на 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 комбика.
VB5
Level: Beginning
VB 5.0 позволяет Вам разом
закомментировать целый блок кода, а затем также
быстро раскомментировать его. Это очень полезно
при отладке, когда Вам не нужно исполнять целый
ряд операторов, и в то же время Вы не можете их
удалить вот так вот просто за здорово живешь.
Между тем, пара кнопарей Comment/Uncomment присутствует
только в тулбаре Edit, который надо специально
вызывать :-(. Чтобы быстро вызвать тулбар Edit,
кликните правой кнопкой мыши на любом тулбаре в
VB, и выберите затем команду Edit.
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
VB5
Level: Beginning
Никогда не передавайтe
глобальную переменную в качестве аргумента в
процедуру, которая также напрямую обращается к
этой переменной из себя (зачем??). Если Вы на 100%
уверены, что следуете этому правилу в Ваших
программах, то зачеркните опцию Assume No Aliasing в
диалоговом окне Advanced Optimizations, которое вызывается
из пункта Compile диалога Project Properties (уф, надеюсь,
понятно). Если компилятор native code знает, что этих
самых alias-ных переменных нет, то он спокойно
копирует значения переменных в шустрые регистры
ЦПУ, и переписывает их значения обратно в RAM
только при выходе из процедуры. Это увеличивает
скорость исполнения скомпилированных программ.
VB5
Level: Beginning
Все знают о маленьком кодике, позволяющем Вам центрировать форму на экране вне зависимости от графического разрешения. Теперь Вы можете достичь того же результата, всего лишь присвоив значение vbStartUpScreen (=2) новому свойству StartUpPosition формы (появилось в версии 5). Вы даже можете отцентрировать форму относительно ее родительского окна, присвоив значение vbStartUpOwner (=1). Присвоение можно сделать в окне Property соответствующей формы. Когда Вы центрируете форму внутри родительского окна, не забудьте добавить второй аргумент в методе Show.
Form2.Show vbModal, Me
VB5
Level: Beginning
Если взглянуть на опции native code
оптимизации, то сперва так и подмывает щелкнуть
на "Optimize for Fast Code". Однако, как ни странно это
может прозвучать, данное действие далеко не
всегда гарантирует ожидаемый эффект. Аппликухи,
оптимизированные на скоростное исполнение, как
правило, не оптимизируются (пардон за каламбур), а
лишь получают большее количество памяти при
загрузке. Это обращается для них более медленной
загрузкой, что особенно заметно на машинах с
недостаточным количеством RAM, и в итоге создает
впечатление, что Ваша аппликуха работает
медленнее, нежели оптимизированная под
компактный код. По той же самой причине,
советуется компилить аппликухи в P-code. В случае
объемных, UI- и базоданских аппликух, выигрыш от
компиляции в native-code отнюдь не перевесит
увеличения размера аппликухи. Вообще, чтобы
точно знать, какая компиляция нужна Вам, юзайте VB
Application Performance Explorer (APE), который лежит на VB CD.
VBA5
Level: Beginning
В отличие от других продуктов
Office 97, шаблоны Word 97 содержат business-application engine,
который хранится отдельно от документов,
использюущих этот engine. Основанные на шаблонах
книги Excel и презентации PowerPoint хранят в себе
шаблоны, на основе которых они созданы. На
практике, все документы Word состоят из 2х VBA
проектов: первый проект создан на базе
основного(оригинального, хранящегося в Word)
шаблона (все документы Word основаны на шаблонах), а
второй проект принадлежит самому документу Word. С
другой стороны, книги Excel и презентации PowerPoint,
созданные на шаблонах, содержат только один VBA
проект. Каждый файл содержит свою собственную
копию проекта оригинального шаблона. Изменения,
производимые в этом шаблоне, не затрагивают
основной шаблон, хранящийся в приложении.
VB5
Level: Beginning
Вот несколько предложений по
настройке IDE в VB5:
Добавить закладки в тулбокс можно, кликнув
правой кнопкой мыши на кнопке General (что на
тулбоксе), и выбрав Add Tab. Вы можете также
перемещать и удалять закладки, и перемещать
иконы контролов с одной закладки на другую,
используя обычный метод drag-and-drop.
Вытащить кнопку любого пункта меню на тулбар
можно, кликнув правой кнопкой на любом тулбаре и
выбрав пункт Customize. Перейдите на закладку Commands,
выберите нужный пункт меню в правом окошке, и
перетащите его на тулбар. Первыми кандидатами на
добавление являются пункты Project-References,Project-Properties,
и Tools-Add Procedure.
Как создать совершенно новый тулбар на вкладке
Toolbars диалогового окна Customize. После того, как Вы
определили содержимое будущего тулбара, для
добавления кнопок на этот тулбар используйте
описанную абзацем выше процедуру. Когда у Вас на
экране активизировано диалоговое окно Customize,
кликните правой кнопкой на любой кнопке тулбара
и Вы сможете поменять рисунок кнопки, создать
разделитель, спрятать/показать текст и т.д.
VB5
Level: Beginning
Когда Вы работаете с
несколькими пректами сразу, можно запутаться в
нагромождении туевой хучи окошек из разных
проектов. Однако, Вы можете временно спрятать все
окошки, относящиеся к данному проекту, щелкнув по
пиктограмме проекта в окошке Project Explorer так, чтобы
все ветви, торчащие из него, исчезли. Тогда же
свернутся и все окна, относящиеся к данному
проекту. Эту возможность можно отменить, щелкнув
на сответствующем квадратике на закладке General в
меню Tools-Options.
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.
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.
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, и в этом типе какое-либо из
полей является адресом другой переменной или
записи.
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$
для округления результата до целого.
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.
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
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, так как три условия являются
взаимно исключающими и избыточными.
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
VB5
Level: Intermediate
Поскольку использование GoSubs
относится к неструктурированному стилю
программирования, то многие программисты
стараются избегать его. Если Вы компилируете
Вашу VB5 аппликуху в native code, у Вас появится еще одна
причина избегать этот оператор, поскольку вызовы
через GoSubs могут происходить в пять раз медленнее,
чем вызовы обычной процедуры или функции.
VB5
Level: Intermediate
Если Вы, как и я, часто
используете имя "array" для переменных, Вам
придется пересмотреть Ваш код при переносе его
под VB5. Это слово является теперь
зарезервированным (reserved keyword) и не может быть
использовано в качестве имени переменной. Вы
можете легко переделать Ваш код при помощи
команды Replace в IDE VB5, не забудьте при этом черкнуть
"Find whole words only".
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.
VB4 16/32, VB5
Level: Advanced
Если Вы используете
всплывающие меню (popup menus) в Ваших прогах, то
опасайтесь бага, имеющегося в VB4 16/32 и VB5. Если у
Вас есть две формы и одна из них вызывает вторую
модальную через всплывающее меню, то из этой
второй модальной Вы не сможете вызвать ни одного
всплывающего меню, сколько бы их на ней ни было.
Чтобы пофиксить это дело, используйте таймер на
первой форме. Вместо показа фторой формы из
всплывающего меню по событию Click, активизируйте
таймер так, чтобы он показал эту вторую форму
через несколько миллисекунд. Для более полной
инфы, см. Статью Q167839 in the Microsoft Knowledge Base.
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
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-свойства и методы
формы.
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
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)
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
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
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
Теперь Вы можете скроллить картинку мышой. Не забудьте проверить границы картинки.
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
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
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
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")
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.
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)
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
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
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
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
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 или любой другой
программы, допускающей использование входного
файла в качестве параметра запуска.
VB4 16/32, VB5
Level: Intermediate
1) В VB5, нажмите Ctrl-F3 когда курсор находится над каким-либо словом. При этом автоматически будет найдено следующее вхождение этого слова в тексте, минуя диалог поиска. Курсор должен стоять как минимум за первой буквой слова, чтобы эта фича работала правильно.
2) В VB4/5 нажатием Ctrl-Tab можно
перемещаться между всеми открытыми окнами в IDE,
это часто оказывается быстрее, чем идти в меню
Window.
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
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
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
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
'... код далее...
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
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.
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
Будьте осторожны: так недолго и
винт запороть.
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
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
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
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
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
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
Вы можете даже написать класс, в
котором инкапсулировать все вышеизложенное.
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
VB3, VB4 16/32, VB5
Level: Intermediate
Я часто работаю над несколькими
проектами одновременно. Прыгая с одного проекта
на другой и обратно, иногда я теряю след, в какой
программе в каком месте я остановился. Для
решения этой проблемы, возьмите да и напечатайте
какую-нибудь фразу без кавычек комментария.
В следующий раз, когда Вы запустите проект,
выберите пункт "Start With Full Compile". Если эта
фраза будет первой ошибкой в проекте, Вы сразу
увидите ее подсвеченной и Ваша память освежится.
VB4 16/32, VB5
Level: Intermediate
Метод GetRows копирует строки Recordsetа (JET) или rdoResultsetа (RDO) в массив. Я часто использую эту фичу для передачи данных между OLE Serverом и клиентскими аппликухами. Этот метод использует переменную типа Variant в качестве параметра для хранения возвращаемых данных. Это двумерный массив (по внутреннему представлению VB)
Dim A As Variant
A = Array(10,2)
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.
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- переменная, хранящая двоичное представление состояния чекбоксов.
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
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
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
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
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)
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
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
раз, вернитесь к началу и впечатайте имена
свойств и полей, и уберите символ комментария.
Символ комментария позволяет Вам свободно
бегать по всему фрагменту, не заботясь о
синтаксических ошибках.
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
VB4 16/32, VB5
Level: Beginning
Если Вы хотите выывести символ «&» на экран, установите свойство "UseMnemonic" в False. Это свойство бывает полезно, когда, например, Labelы используются для вывода данных из баз данных. Также Вы можете вывести символ "&" в свойстве Caption, написав &&.
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," соответственно.
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
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
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
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
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.
VB4 16/32, VB5
Level: Intermediate
Используйте данный код, чтобы заставить скроллер TextBoxа автоматически передвинуться, когда Вы добавляете новый текст:
' Переход к концу текста
MyTextBox.SelStart = Len(MyTextBox.Text)
' Новый текст будет стоять здесь
MyTextBox.SelText = NewText$
VB3, VB4 16/32, VB5
Level: Beginning
При использовании функции Val, VB капризничает, порождая ошибку несоответствия типов. Например, Val("25%") правильно возвращает 25, тогда как Val("2.5%") неправильно интерпретирует входной параметр и возвращает ошибку несоответствия типов. Это случается только тогда, когда в строке присутствует десятичная точка и символ "%" или "&". Чтобы исправить это, уберите эти символы из строки перед ее передачей в Val.
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
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
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
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
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
содержит имя контрола, который потерял фокус.
Не размещайте эту процедуру где-либо кроме
таймера.
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
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"
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)-правой стороной, даже перед присвоением, независимо от скобок. Будьте внимательны.
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.
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, то прога автоматом
запустит программу апгрейда по сети и закончит
свое выполнение, то есть все нужные файлы смогут
быть заменены. Это особенно полезно, когда Вы
только начинаете писать прогу, то есть апгрейды и
фиксы появляются чуть ли не раз в несколько дней.
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 тоже.
Назад к СОДЕРЖАНИЮ