Стандартные диалоговые окна без ActiveX

Стандартные диалоговые окна без ActiveX - часть 2

Вот, наконец, вышла вторая часть статьи про стандартные диалоговые окна. В первой части я рассказывал про то, как вызываются диалоги открытия и сохранения файла. Посмотреть статью можно здесь:
http://prs.narod.ru/programming/vb/arts/comdlg.html

Сейчас же я расскажу как вызываются диалоги для выбора каталога и цвета.

Диалог выбора каталога
Как обычно, для начала создайте проект типа Standart EXE и разместите на новой форме кнопку Command1 и надпись Label1 как на рисунке:

Теперь создайте новый модуль и в декларациях пишем:

Option Explicit

Declare Function SHBrowseForFolder Lib _
"shell32.dll" (BInfo As BrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib _
"shell32.dll" (ByVal List As Long, ByVal Buffer _
As String) As Long

Declare Function lstrcat Lib "kernel32.dll" Alias _
"lstrcatA" (ByVal String1 As String, ByVal _
String2 As String) As Long

Private Type BrowseInfo
Owner As Long
ListRoot As Long
DisplayName As Long
Title As Long
Flags As Long
CallBack As Long
Param As Long
Image As Long
End Type

Здесь Option Explicit означает, что все переменные необходимо объявлять заранее до начала их использования, а далее идёт объявление трёх АПИ функций и структуры BrowseInfo, которые будут нужны для вызова диалога.

Теперь создаём функцию SelectDir:

Function SelectDir(SelectDirProgramHWND As Long, Caption As String, _
SelectDirFlags As Long) As String
On Error Resume Next
Dim DList As Long
Dim Buffer As String
Dim BI As BrowseInfo

With BI
.Owner = SelectDirProgramHWND
.Title = lstrcat(Caption, "")
.Flags = SelectDirFlags
End With

DList = SHBrowseForFolder(BI)

If (DList) Then
Buffer = Space(260)
SHGetPathFromIDList DList, Buffer
Buffer = Left(Buffer, InStr(Buffer, vbNullChar) - 1)
If Len(Buffer) > 0 Then
If Right(Buffer, 1) = "\" Then
SelectDir = Buffer
Else
SelectDir = Buffer + "\"
End If
End If
End If
End Function

В этой функции мы сначала объявляем три переменные: DList - номер полученного каталога, Buffer - для обработки каталога и BI - для передачи параметров диалогу. Затем мы назначаем значения параметров переменной BI (номер вызвавшего диалог окна, заголовок диалога и флажки). После этого мы вызываем диалог и результат передаём переменной DList. Далее, если DList не 0, с помощью функции SHGetPathFromIDList определяем каталог, который скрывается под значением DList, и кладём его в Buffer. Затем удаляем нулевые символы и добавляем "\" если нужно.

Теперь нужно добавить код в форму.

Option Explicit

Private Sub Command1_Click()
Dim Buffer As String
Buffer = SelectDir(Me.hWnd, "Выберете каталог", 0)

If Buffer = "" Then
Label1 = "<ничего не выбрано>"
Else
Label1 = Buffer
End If
End Sub

Здесь всё просто: объявляем переменную Buffer и задаём ей возвращаемое значение функции. Если оно пустое, то пишем, что ничего не выбрано или, если не пустое, выбранный каталог. Для этого диалога на этом всё. Вот как всё это выгладит:

Диалог выбора цвета
Теперь приступим к следующему диалогу - диалогу выбора цвета. Для начала добавьте на форму Picture1 и Command2. Должно получиться примерно так:

Теперь в модуле нужно написать объявление необходимых АПИ функций и функцию для выбора цвета. Я рекомендую писать код диалогов не в один, а в разные модули, т.к. в Вашей программе могут некоторые диалоги не понадобиться, и лишний код соответственно не нужен. Итак, создаём новый модуль и пишем:

'Все переменные необходимо объявлять заранее
Option Explicit

'API
Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" (pChoosecolor As _
ChooseColor) As Long

'Всего пользовательских цветов
Global Const TOTAL_CUSTOM_COLORS = 16

'Пользовательские цвета
Global CustomColors(TOTAL_CUSTOM_COLORS * 4 - 1) As Byte

'Тип данных для функции
Type ChooseColor
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Здесь всё аналогично предыдущему диалогу: объявляем АПИ и тип данных для неё. Теперь функция:

Function ShowColorDialog(hWnd As Long, Flags As Long) As Long
'Переменные
Dim CClr As ChooseColor
Dim I As Integer

'Устанавливаем размер всей переменной
CClr.lStructSize = Len(CClr)
'Откуда запустили
CClr.hwndOwner = hWnd
'Устанавливаем instance приложения
CClr.hInstance = App.hInstance
'Устанавливаем собственные цвета (сконвертированные в Unicode)
CClr.lpCustColors = StrConv(CustomColors, vbUnicode)
'Флаги
CClr.Flags = Flags

'Показываем диалог
If ChooseColor(CClr) <> 0 Then
'Если нет ошибок, то возвращаем цвет
ShowColorDialog = CClr.rgbResult
'Пользовательские цвета
For I = 0 To TOTAL_CUSTOM_COLORS * 4 - 1
CustomColors(I) = Asc(Mid(CClr.lpCustColors, I + 1, 1))
Next I
Else
'Или возвращаем -1
ShowColorDialog = -1
End If
End Function

Теперь нужно изменить код формы.

Private Sub Command2_Click()
Dim Buffer As Long
Buffer = ShowColorDialog(Me.hWnd, 0)

If Buffer <> -1 Then
Picture1.BackColor = Buffer
End If
End Sub

На этом, пожалуй всё. В следующий раз я постараюсь рассказать про диалог выбора шрифта, а также про диалоги в Windows (диалог завершения работы, перезагрузки компьютера и т.д.).

Исходники готового проекта можно скачать с этой страницы.

Автор: Павел Николаевич
E-mail: pasha_nik@mail.ru