Visual2000 · Архив статей А.Колесова & О.Павловой

Советы тем, кто программирует на VB & VBA

Андрей Колесов, Ольга Павлова

© 199x, Андрей Колесов, Ольга Павлова
Авторский вариант. Статья была опубликована c незначительной литературной правкой в журнале "КомпьютерПресс" N 10/99, компакт-диск.


Совет 204. Как нарисовать рамку на форме без помощи элемента управления Frame

Функция DrawEdge, входящая в состав Win32 API, позволяет достичь очень интересных эффектов. Используя константы EDGE_ вы можете задать различные типы границ рамки, благодаря чему она будет выглядеть утопленной или приподнятой над формой. А константы BF_ определяют границы рамки, которые следует рисовать (например, с помощью BF_BOTTOM вы можете нарисовать только нижнюю границу рамки):

Private Declare Function DrawEdge Lib "user32" _
  (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, _
  ByVal grfFlags As Long) As Long
Private Declare Function GetClientRect Lib "user32" _
  (ByVal hWnd As Long, lpRect As RECT) As Long
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
Const BDR_INNER = &HC
Const BDR_OUTER = &H3
Const BDR_RAISED = &H5
Const BDR_RAISEDINNER = &H4
Const BDR_RAISEDOUTER = &H1
Const BDR_SUNKEN = &HA
Const BDR_SUNKENINNER = &H8
Const BDR_SUNKENOUTER = &H2
Const BF_RIGHT = &H4
Const BF_LEFT = &H1
Const BF_TOP = &H2
Const BF_BOTTOM = &H8
Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
Const BF_RECT = (BF_LEFT Or BF_RIGHT Or BF_TOP Or BF_BOTTOM)

В событии Form_Paint введите следующий код, который говорит о том, что вы хотите нарисовать прямоугольник, который приподнят над формой:

Private Sub Form_Paint()
  Static Tmp As RECT
  Static TmpL As Long
  TmpL = GetClientRect(hWnd, Tmp)
  TmpL = DrawEdge(hDC, Tmp, EDGE_RAISED, BF_RECT)
End Sub

В начало статьи

Совет 205. Как организовать просмотр каталогов

Здесь приводится простой программный код, с помощью которого вы можете вывести на экран окно просмотра каталогов. Благодаря этому пользователь имеет возможность выбрать необходимый ему каталог:

Private Type BrowseInfo
  hWndOwner As Long
  pIDLRoot As Long
  pszDisplayName As Long
  lpszTitle As Long
  ulFlags As Long
  lpfnCallback As Long
  lParam As Long
  iImage As Long
End Type
'
' просмотр каталогов
'
' для выбора каталога,
' чтобы начать поиск документа
Private Const BIF_RETURNONLYFSDIRS = &H1 
' для запуска команды Find
Private Const BIF_DONTGOBELOWDOMAIN = &H2 
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
' просмотр компьютеров
Private Const BIF_BROWSEFORCOMPUTER = &H1000 
' просмотр принтеров
Private Const BIF_BROWSEFORPRINTER = &H2000 
' просмотр всего
Private Const BIF_BROWSEINCLUDEFILES = &H4000 
'
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
  (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
  (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" _
  (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
  (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hWndOwner As Long, _
  sPrompt As String) As String
  '==================================================
  ' Открывает системное диалоговое окно для просмотра каталогов
  '==================================================
  Dim iNull As Integer
  Dim lpIDList As Long
  Dim lResult As Long
  Dim sPath As String
  Dim udtBI As BrowseInfo
  '
  With udtBI .hWndOwner = hWndOwner
    .lpszTitle = lstrcat(sPrompt, "")
    .ulFlags = BIF_RETURNONLYFSDIRS
  End With
  lpIDList = SHBrowseForFolder(udtBI)
  If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    lResult = SHGetPathFromIDList(lpIDList, sPath)
    Call CoTaskMemFree(lpIDList)
    iNull = InStr(sPath, vbNullChar)
    If iNull Then sPath = Left$(sPath, iNull - 1)
    End If
  End If
  BrowseForFolder = sPath
End Function

Private Sub Form_Click()
  Dim MyStr As String
  MyStr = BrowseForFolder(hWnd, "Привет всем!")
End Sub

В начало статьи

Совет 206. Удаление всех выделенных элементов в списке

Если у вас есть необходимость удалить сразу несколько элементов из списка, поддерживающего режим MultiSelect, воспользуйтесь следующей простой программой. Предположим, у нас есть окно списка, состоящее из пяти элементов: Элемент1, Элемент2, Элемент3, Элемент4 и Элемент5. Установим свойство MultiSelect элемента управления ListBox как Extended или Simple, а затем введем такой код:

Private Sub cmdDeleteListItems_Click()
  Dim i As Integer
  For i = List1.ListCount - 1 To 0 Step -1
    If List1.Selected(i) Then List1.RemoveItem i
  Next i
End Sub

Поместим на форму командную кнопку с именем "Удалить" и напишем для нее следующее:

Private Sub Command1_Click()
  Call cmdDeleteListItems_Click
End Sub

Теперь запустим нашу программу, выделим три элемента (Элемент1, Элемент3 и Элемент5), а затем щелкнем кнопку "Удалить". И это все!

В начало статьи

Совет 207. Как сделать горизонтальную линейку прокрутки в элементе управления RichTextBox

По умолчанию, когда вы помещаете элемент управления RichTextBox на форму, VB устанавливает свойство RightMargin как 0. Это означает, что вводимый пользователем текст целиком располагается внутри текстового окна. Для вывода горизонтальной линейки прокрутки необходимо, чтобы значение свойства RightMargin было больше, чем ширина текстового окна. Иначе, даже если установить свойство ScrollBars как 1- rtfHorizontal, RichTextBox не выведет линейку прокрутки.

Например, поместите на форму элемент управления RichTextBox, имеющий ширину 3200. Затем установите свойство RightMargin как 3300, а свойство ScrollBars — как 1- rtfHorizontal. Запустите проект на выполнение и начните вводить текст. Когда вы достигнете границы текстового окна, VB выведет горизонтальную линейку прокрутки.

В начало статьи

Совет 208. Добавление новой строки к тексту в элементе управления TextBox

Иногда вам может понадобиться добавить дополнительную информацию к уже существующему тексту в многострочном элементе управления TextBox (свойство MultiLine установлено как True). Предположим, что вы хотите добавить строку такого вида: "Обновление:" плюс текущая дата. Для этого можно воспользоваться свойствами SelStart и SelText. Как вы уже, вероятно, знаете, свойство SelStart возвращает или устанавливает начало выделения, свойство SelText — фактически выделенный текст. Если текст не содержит никакого выделения, оба свойства возвращают точку вставки (insertion point). Поэтому, чтобы вставить новую строку текста в многострочное текстовое окно, используйте подобный код:

Dim strNewText As String
With Text1
  strNewText = "Обновление: " & Date
  .SelStart = Len(.Text)
  .SelText = vbNewLine & strNewText
End With

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

В начало статьи

Совет 209. Как заставить VB 6.0 открывать окно кода в "развернутом" режиме

VB 5.0 всегда сохранял установки интегрированной среды разработки (IDE), заданные вами во время последней сессии. Так, он помнил, с какими окнами вы предпочитаете работать — с нормальными или "развернутыми". К сожалению, VB 6.0 этого не делает — он всегда открывает окна Code и Object в нормальном режиме. Эту проблему можно решить, проведя небольшие изменения в Windows Registry, так что IDE будет открывать эти окна в "развернутом" режиме. Однако они будут ВСЕГДА расширены до размера экрана — VB 6.0 по-прежнему не сможет хранить установки для IDE между сессиями.

При работе с Регистром требуется соблюдать особую осторожность, поэтому, прежде чем приступить к внесению в него изменений, сделайте резервную копию, так чтобы можно было восстановить Регистр в случае каких-либо сбоев.

Итак, чтобы заставить VB 6.0 открывать окно Code или Object в "развернутом" режиме, вы должны добавить новую величину MDIMaximized к следующему ключу Registry: HKEY_CURRENT_USER/Software/Microsoft/Visual Basic/6.0/MDIMaximized = "1" Для этого в Windows щелкните кнопку Start и выберите команду Run. Введите RegEdit в диалоговом окне Run, затем щелкните OK. Тогда Windows выведет на экран системный Регистр, в котором найдите папку VB 6.0. После этого щелкните правой кнопкой мыши в любом месте на правой панели и выберите New|String Value из контекстного меню. Введите MDIMaximized в качестве имени и нажмите клавишу Enter. Теперь щелкните правой кнопкой мыши элемент MDIMaximized и выберите Modify из контекстного меню. И наконец, в диалоговом окне Edit String введите 1 в качестве новой величины и щелкните OK. Когда вы это сделаете, Windows присвоит введенную вами величину элементу MDIMaximized. Вот и все! Теперь закройте Регистр и откройте окно Code или Object в любом из проектов VB 6.0. IDE выведет эти окна в "развернутом" режиме.

В начало статьи

Совет 210. Специальные символы для объявления типа переменной

Помимо того, что вы можете объявлять тип переменной в явном виде, VB позволяет делать это с помощью специальных символов. Например, вместо использования:

Dim MyString As String

вы можете просто написать:

Dim MyString$

Вот полный перечень типов данных и соответствующих им символов:

String   — $
Integer  — %
Long     — &
Single   — !
Double   — #
Currency — @

Однако следует соблюдать осторожность при использовании этих символов, поскольку они снижают читаемость вашего кода.

В начало статьи

Совет 211. Создание объекта Excel в VB

В совете 197 (КомпьютерПресс 6'99, компакт-диск) мы рассказали о том, как создать объект Word в VB. Теперь мы покажем, как выполнить ту же самую процедуру для Excel.

В первую очередь добавьте к VB-приложению ссылку к Microsoft Excel 8.0 Object Library (команда Project|References).

Затем введите следующий код для создания экземпляра Excel:

Dim objExcel As New Excel.Application

' Выводит Microsoft Excel
objExcel.Visible = True

' Открывает новую рабочую книгу
objExcel.Workbooks.Add

' Вводит текст в ячейки таблицы
objExcel.ActiveCell(1, 1) = "Столбец 1"
objExcel.ActiveCell(1, 3) = "Столбец 3"

' Освобождает объектную переменную
Set objExcel = Nothing

И наконец, внимательно изучите Object Browser в VB для получения информации о других свойствах и методах объекта Excel.

В начало статьи

Совет 212. Пусть функция DateDiff разбирается с датами

Если вам требуется определить, находятся ли две даты в одном и том же месяце, то первое, что может прийти на ум — это использовать функцию Month для каждой даты, а затем сравнить два полученных числа. Однако в таком случае вы получите, что даты 1/1/2000 и 1/1/1999 равны. Поэтому следует использовать функцию DateDiff, которая может выглядеть примерно так:

DateDiff("m", Date1, Date2)

Здесь функция DateDiff вычисляет разницу в календарных месяцах между двумя датами (аргумент "m"). Если она возвращает 0, то обе даты находятся в одном и том же месяце. Для того, чтобы использовать эту функцию в своем приложении, вы можете использовать подобную программную конструкцию:

If DateDiff("m", Date1, Date2) Then
  ' Месяца отличаются
Else
  ' Один и тот же месяц
End If

В начало статьи

Совет 213. Для аварийного прерывания программы используйте Ctrl+Pause

При отладке программы в среде VB для ее прерывания или аварийного завершения можно применять соответственно команды Break или End из меню Run. Однако они срабатывают только в момент ожидания какого-либо внешнего события на диалоговой форме. Если же программа выполняет какой-то программный код (например, обработку данных в цикле) или ожидает реакции пользователя после вывода окна сообщения (Message Box), то аварийно прервать или завершить ее с помощью этих команд не удастся.

Однако решить такую проблему просто — для аварийного прерывания программы нажмите комбинацию клавиш Ctrl+Pause, которая сразу переведет ваше приложение в режим Break, а уже потом используйте команды среды Continue (продолжить выполнение) или End (завершить).

В начало статьи

Совет 214. Как увидеть начало выделенного текста

Большинство профессиональных коммерческих приложений обрабатывают диалоговые окна, содержащие поля текста, следующим образом. Когда пользователь переходит к полю ввода текста с помощью клавиши Tab или быстрой клавиши (комбинации Alt с какой-либо другой клавишей), он полностью выделяет весь текст, содержащийся в этом поле. Затем он вводит новый текст, который заменяет собой содержимое всего поле. В то же время, если он просто щелкнет мышью текст, содержащийся в поле ввода, то никакого выделения не произойдет — туда только перейдет фокус.

В документации VB Knowledge Base рассказывается, как это можно сделать с помощью API-функции GetKeyState. Однако данная техника имеет некоторое неудобство в тех случаях, когда длина текста превышает ширину поля. Пользователь тогда видит только конец выделенного текста, что не очень удобно, т.к. не всегда можно определить, о чем там идет речь.

Использование функции GetKeyState вместе с оператором SendKeys и методом TextWidth позволяет создать комбинированное решение, когда клавиша Tab или быстрая клавиша выделяет весь текст, содержащийся в поле ввода, но при этом пользователь видит начало текста, а не его конец.

Вначале опишите API-функцию GetKeyState и создайте подпрограмму SelectWholeText:

Option Explicit
 #If Win16 Then
   Private Declare Function GetKeyState _
     Lib "User" (ByVal iVirtKey As Integer) As Integer
 #Else
   Private Declare Function GetKeyState _
     Lib "User32" (ByVal iVirtKey As Long) As Integer
 #End If
' vbTab ' то же, что и Chr$(&H9) — символьная константа
' vbKeyTab ' то же, что и десятичная 9 — числовая константа
' vbKeyMenu ' то же, что и десятичная 18 (клавиша Alt) —
' числовая константа

Private Sub SelectWholeText(Ctl As Control)
  ' Обратите внимание на разницу в использовании
  ' vbTab (символ) и vbKeyTab(число). В первом случае
  ' необходимо добавить Asc(), чтобы получить число в
  ' качестве аргумента.
  ' Использование ключевого слова With позволяет
  ' упростить  дальнейшую модификацию программы —
  ' например, если будем менять имя параметра.
  With Ctl
    If (GetKeyState(vbKeyTab) < 0) Or _
      (GetKeyState(vbKeyMenu) < 0) Then
      ' Для выделения всего текста используется
      ' клавиша Tab или быстрая клавиша. В случае
      ' если длина строки превышает ширину поля,
      ' использование оператора SendKeys
      ' позволяет увидеть начало выделенного текста.
      ' Метод TextWidth определяет, какую длину
      ' будет иметь строка, если ее выводить на форме.
      If TextWidth(.Text) > .Width Then
        SendKeys "{End}", True
        SendKeys "+{Home}", True
      Else
        .SelStart = 0
        .SelLength = Len(.Text)
      End If
    Else
      .SelLength = 0
    End If
  End With
End Sub

Затем вызовите созданную подпрограмму из события GotFocus любого поля текста:

Private Sub Text1_GotFocus()
  SelectWholeText Text1
End Sub

В начало статьи

Совет 215. Как прочитать серийный номер диска

Новая библиотека Microsoft Scripting Runtime содержит иерархию FileSystemObject, состоящую из нескольких объектов, которые позволяют получать информацию о дисках, папках и файлах. Например, вы можете получить серийный номер диска с помощью такого кода:

' получаем серийный номер диска c:
Dim fso As New Scripting.FileSystemObject
Dim dr As Scripting.Drive
' получаем ссылку к объекту Drive
Set dr = fso.GetDrive("c")
Print Hex$(dr.SerialNumber)

А используя свойство FreeSpace объекта Drive можно также проверить, достаточно ли у вас свободного места на диске:

Print "На диске C есть " & dr.FreeSpace & " свободных байт"

Более подробно об этом можно прочитать в Справке VB в разделах Dictionary и FileSystemObject.

В начало статьи

Совет 216. Применение элемента управления Label в качестве разделителя

Для создания приложения в стиле Windows Explorer можно использовать элемент управления Label в качестве разделителя между двумя другими элементами управления, такими как ListView и TreeView.

Вначале разместим на форме эти три компонента, а затем введем следующий код:

Option Explicit
Private mbResizing As Boolean
' нажата ли левая кнопка мыши

Private Sub Form_Load()
  TreeView1.Move 0, 0, Me.ScaleWidth / 3, Me.ScaleHeight
  ListView1.Move (Me.ScaleWidth / 3) + 50, 0, _
    (Me.ScaleWidth * 2 / 3) - 50, Me.ScaleHeight
  Label1.Move Me.ScaleWidth / 3, 0, 100, Me.ScaleHeight
  Label1.MousePointer = vbSizeWE
End Sub

Private Sub Label1_MouseDown(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then mbResizing = True
End Sub

Private Sub Label1_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
  ' изменение размеров элементов управления
  ' при нажатой левой кнопке мыши
  If mbResizing Then
    Dim nX As Single
    nX = Label1.Left + X
    If nX < 500 Then Exit Sub
    If nX > Me.ScaleWidth - 500 Then Exit Sub
    TreeView1.Width = nX
    ListView1.Left = nX + 50
    ListView1.Width = Me.ScaleWidth - nX - 50
    Label1.Left = nX
  End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
  mbResizing = False
End Sub

В начало статьи