Visual2000 · Архив статей А.Колесова & О.Павловой
Андрей Колесов, Ольга Павлова
© 199x, Андрей Колесов, Ольга ПавловаФункция 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
Здесь приводится простой программный код, с помощью которого вы можете вывести на экран окно просмотра каталогов. Благодаря этому пользователь имеет возможность выбрать необходимый ему каталог:
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
Если у вас есть необходимость удалить сразу несколько элементов из списка, поддерживающего режим 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), а затем щелкнем кнопку "Удалить". И это все!
По умолчанию, когда вы помещаете элемент управления RichTextBox на форму, VB устанавливает свойство RightMargin как 0. Это означает, что вводимый пользователем текст целиком располагается внутри текстового окна. Для вывода горизонтальной линейки прокрутки необходимо, чтобы значение свойства RightMargin было больше, чем ширина текстового окна. Иначе, даже если установить свойство ScrollBars как 1- rtfHorizontal, RichTextBox не выведет линейку прокрутки.
Например, поместите на форму элемент управления RichTextBox, имеющий ширину 3200. Затем установите свойство RightMargin как 3300, а свойство ScrollBars — как 1- rtfHorizontal. Запустите проект на выполнение и начните вводить текст. Когда вы достигнете границы текстового окна, VB выведет горизонтальную линейку прокрутки.
Иногда вам может понадобиться добавить дополнительную информацию к уже существующему тексту в многострочном элементе управления 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, а затем вставляет новую строку, содержащую дополнительную информацию.
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 выведет эти окна в "развернутом" режиме.
Помимо того, что вы можете объявлять тип переменной в явном виде, VB позволяет делать это с помощью специальных символов. Например, вместо использования:
Dim MyString As String
вы можете просто написать:
Dim MyString$
Вот полный перечень типов данных и соответствующих им символов:
String — $ Integer — % Long — & Single — ! Double — # Currency — @
Однако следует соблюдать осторожность при использовании этих символов, поскольку они снижают читаемость вашего кода.
В совете 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.
Если вам требуется определить, находятся ли две даты в одном и том же месяце, то первое, что может прийти на ум — это использовать функцию Month для каждой даты, а затем сравнить два полученных числа. Однако в таком случае вы получите, что даты 1/1/2000 и 1/1/1999 равны. Поэтому следует использовать функцию DateDiff, которая может выглядеть примерно так:
DateDiff("m", Date1, Date2)
Здесь функция DateDiff вычисляет разницу в календарных месяцах между двумя датами (аргумент "m"). Если она возвращает 0, то обе даты находятся в одном и том же месяце. Для того, чтобы использовать эту функцию в своем приложении, вы можете использовать подобную программную конструкцию:
If DateDiff("m", Date1, Date2) Then ' Месяца отличаются Else ' Один и тот же месяц End If
При отладке программы в среде VB для ее прерывания или аварийного завершения можно применять соответственно команды Break или End из меню Run. Однако они срабатывают только в момент ожидания какого-либо внешнего события на диалоговой форме. Если же программа выполняет какой-то программный код (например, обработку данных в цикле) или ожидает реакции пользователя после вывода окна сообщения (Message Box), то аварийно прервать или завершить ее с помощью этих команд не удастся.
Однако решить такую проблему просто — для аварийного прерывания программы нажмите комбинацию клавиш Ctrl+Pause, которая сразу переведет ваше приложение в режим Break, а уже потом используйте команды среды Continue (продолжить выполнение) или End (завершить).
Большинство профессиональных коммерческих приложений обрабатывают диалоговые окна, содержащие поля текста, следующим образом. Когда пользователь переходит к полю ввода текста с помощью клавиши 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
Новая библиотека 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.
Для создания приложения в стиле 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