Статьи

Как ActiveX Control'ы нам жизнь облегчают.

Вы, наверное, заметили, что я достаточно много места уделяю ActiveX Control'ам. До этого момента основное направление статей было направлено на создание самих элементов управления. Однако это не самоцель. Для чего они создаются? Для того, чтобы в любой момент можно было бы, не задумываясь над кодами просто установить их в программе. Возможно, придется их немного подкорректировать, но это же совсем другое дело! Итак, у меня имеется  ряд моих контролов, с помощью которых, за минимальный промежуток времени я собираю готовую программу. Читатели этой статьи возможно не имеют их и поэтому я буду достаточно подробно останавливаться на их создании.

Вас удовлетворяла стандартная программа "Таблица символов"? Меня не всегда. Иногда требовалось просмотреть сразу, как будет выглядеть тот или иной шрифт (конкретного размера, жирный, подчеркнутый и т.п.), а данная программа этого не может :-(

Что делать? Собираем программу сами.

Вступление. Создадим новый проект StandardEXE (Name=FontPreview). Готовую форму изменим согласно нижеприведенных данных:

Расположим на нем элемент управления ComboFont (с перечнем всех шрифтов на Вашем компьютере). Стоп! У Вас же нет его :-)
Ну что ж придется создать (гарантирую, пригодится в будущем).

Шаг 1. Создаем ComboFont.

Для тех, кто раньше не создавал ActiveX Control'ы скажу, что элементы управления могут быть как отдельно подключаемые, так и встроенные в программу. В нашей ситуации мы будем использовать второй вариант. Добавим к проекту UserControl (Name=ComboFont) и расположим на нем ComboBox:

* NB! Установка высоты возможна только после установки Style=1

Теперь займемся заполнением. Конечно, можно использовать стандартный метод перебора всех шрифтов
Dim i%
For I = 0 To Screen.FontCount -1
    cboFonts.AddItem Screen.Fonts (i)
Next

Но данный метод, очень медленный при большом количестве шрифтов (у меня их, например, более 150). Что же делать? - Воспользоваться API-функциями и методом AddressOff. Добавим к проекту модуль. В разделе деклараций объявим 2 типа (LOGFONT и NEWTEXTMETRIC), а так же следующие API-функции:
Public Declare Function EnumFontFamilies Lib "gdi32" _
Alias "EnumFontFamiliesA" _
    (ByVal hDC As Long, _
    ByVal lpszFamily As String, _
    ByVal lpEnumFontFamProc As Long, _
    lParam As Any) _
    As Long
Public Declare Function GetDC Lib "user32" _
    (ByVal hwnd As Long) _
    As Long
Public Declare Function ReleaseDC Lib "user32" _
    (ByVal hwnd As Long, _
    ByVal hDC As Long) _
    As Long

А теперь напишем функцию и процедуру, отвечающих за вывод всей информации:
Public Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, _
    ByVal FontType As Long, lParam As ComboBox) As Long
Dim FaceName$,FullName$
    FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
    lParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
    EnumFontFamProc = 1
End Function

Public Sub FillComboWithFonts(CB As ComboBox)
Dim hDC&
    CB.Clear
    hDC = GetDC(CB.hwnd)
    EnumFontFamilies hDC, vbNullString, AddressOf EnumFontFamProc, CB
    ReleaseDC CB.hwnd, hDC
End Sub

В процедуре мы вначале устанавливаем девайс к нашему ComboBox, а затем с помощью AddressOf - вызываем нашу функцию. Получение имени очередного шрифта системы и добавление его в ComboBox происходит в функции EnumFontFamProc.

Теперь переходим в UserControl и в событии Show запустим заполнение нашего cboFonts, а чтобы текстовое поле при заполнении не пустовало - выведем в него первый элемент.
Private Sub UserControl_Show()
    FillComboWithFonts cboFonts
    cboFonts.ListIndex = 0
End Sub

Вот теперь-то мы сможем расположить наш новый элемент управления на форме. Скорость заполнения нашего ЭУ перечнем шрифтов системы на порядок выше стандартного последовательного метода заполнения.

Чего не хватает нашему контролу? - Ответной реакции. Т.е. выбрать-то имя шрифта мы можем, но передать куда-либо это значение пока нет. С помощью ActiveX Control Interface Wizard (меню Add-Ins/Add-In Menager) добавим к нашему контролу свойство Text и событие Click и привяжем их к аналогичным cboFonts. Теперь событие Click может передавать содержимое выбранной записи куда-либо.

Ну что ж, осталось совсем немного (для данного контрола). Хотелось бы получить быстрый поиск по первым, вводимым в текстовую часть, буквам. Для этого так же существует API-функция, которую и объявим в модуле:
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long
Public Const CB_FINDSTRING As Long = &H14C

Далее, в самом UserControl'е для cboFonts в событии KeyPress отловим нажатие клавиши Backspace и присвоим переменной уровня UserControl значение False
Private Sub cboFonts_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 8
        bASCII = False
    Case Else
        bASCII = True
    End Select
End Sub

А в событии Change, с помощью вышеуказанной API-функции будем производить поиск по вводимым буквам, а оставшуюся часть выделять.
Private Sub cboFonts_Change()
Dim lPos&, n%
    If bASCII Then
        cboFonts.SelStart = Len(cboFonts.Text) - cboFonts.SelLength + 1
        n = cboFonts.SelStart
        lPos = SendMessage(cboFonts.hwnd, CB_FINDSTRING, 0, ByVal cboFonts.Text)
        If lPos >= 0 Then
            cboFonts.ListIndex = lPos
            RaiseEvent Click
        End If
        cboFonts.SelStart = n
        cboFonts.SelLength = Len(cboFonts.Text) - n
    End If
End Sub

С данным контролом закончили. Закроем его модуль и откроем форму. Расположим на форме наш элемент управления (Name=cbFonts, Left=180, Top=60, Height=1155, Width=2655). Там же на форме расположим Frame(Left=4920, Top=60, Height=1155, Width=4995), а внутри него Label (Name=lblSample, Caption="Sample", AutoSize=True, Font.Size=24, Left=2110, Top=180). В событии cbFonts_Click будем менять шрифт данного лейбла на выбранный. Поэтому в форме запишем
Private Sub cbFonts_Click()
    lblSample.Font.Name = cbFonts.Text
End Sub

Позже эту процедуру мы дополним. На этом шаг первый закончим. Пример (отдельный, без программы) элемента управления ComdoFont, можно скачать ниже.