API и FreeBasic. (Шрифты)

Везде , где есть текст в контролах или просто при рисовании, часто требуется менять шрифт.

Для того, чтобы изменить шрифт, его надо создать с помощью функции CreateFont или заполнить структуру LOGFONT и вызвать функцию CreateFontIndirect. По своей сути нет никакой разницы. В первом случае все настройки шрифта передаются в параметрах функции, во втором в поля структуры. 

Функция CreateFont определена так:

CreateFont(
  As Integer nHeight,             ' высота шрифта в логических единицах измерения
  As Integer nWidth,              ' средняя ширина символа в логических единицах измерения
  As Integer nEscapement,         ' угол в десятых градуса между вектором наклона и осью X устройства
  As Integer nOrientation,        ' угол в десятых градуса между основной линией каждого символа и осью X устройства
  As Integer fnWeight,            ' толщина шрифта
  As Integer fdwItalic,           ' флаг использования курсивного шрифта
  As Integer fdwUnderline,        ' флаг использования подчеркивания
  As Integer fdwStrikeOut,        ' флаг использования зачеркивания
  As Integer fdwCharSet,          ' набор символов
  As Integer fdwOutputPrecision,  ' точность вывода
  As Integer fdwClipPrecision,    ' точность отсечения
  As Integer fdwQuality,          ' качество вывода
  As Integer fdwPitchAndFamily,   ' шаг между символами шрифта и семейство
  As LPCTSTR lpszFace           ' имя гарнитуры шрифта
) As HFONT

Полное описание на русском каждого параметра можно найти ЗДЕСЬ (советую прочесть)

Параметров у функции много, но не так страшен черт...

Так например параметры 2 и 4 можно попросту обнулить. По большей части они требуются крайне редко (если вообще их кто-то использует...).

Что касается 3 параметра, то нам привычнее угол поворота в градусах, поэтому в большинстве случаев для определения этого параметра , будет использоваться формула: УГОЛ*10.

Параметр 5 может определять толщину шрифта. Констант для определения больше десятка, но в большинстве случаев ограничиваются значениями: 400 - шрифт нормальный или 700 - полужирный

Параметры 6,7,8 - это флаги (TRUE или FALSE) для определения стиля шрифта(курсивный,подчеркнутый,зачеркнутый)

Параметр 9 имеет несколько констант, но чаще всего используют DEFAULT_CHARSET ( то есть набор символов по умолчанию для своей страны)

Параметры 10 и 11 так же имеют множество констант, но в большинстве берут по умолчанию OUT_DEFAULT_PRECIS и CLIP_DEFAULT_PRECIS соответственно.

Параметр 12 конечно зависит от задачи. Так например значения ANTIALIASED_QUALITY и PROOF_QUALITY дают более сглаженный текст, но накладывают некоторые ограничения. Для повседневных задач обычно используют значение по умолчанию DEFAULT_QUALITY

Параметр 13 установит шаг между символами и семейство. Для большинства задач складывают константы DEFAULT_PITCH Or FF_DONTCARE. Но опять же все зависит от поставленной задачи

Параметр 14 - это имя шрифта имеющегося в системе, например Arial, Courier New и пр. 

И лишь 1 параметр (высота шрифта) требует кое-каких вычислений. Для простоты это значение вычисляется так:

nHeight = -MulDiv(PointSize, GetDeviceCaps(hDC, LOGPIXELSY), 72)

Здесь функция GetDeviceCaps помогает получить число пикселей на логический дюйм по высоте экрана. А функция MulDiv производит калькуляцию (умножает первые два параметра и делит на третье, а потом округляет).

После создания шрифта (функция CreateFont вернет хендл шрифта) , можно установить его для любого контрола , имеющего текстовые данные. Делается это с помощью сообщения WM_SETFONT , при том в параметре WPARAM следует передать хендл созданного шрифта.

Когда шрифт более не требуется, его можно удалить с помощью функции DeleteObject, передав в ее параметре хендл шрифта.

Пример:

#INCLUDE "windows.bi"
Dim msg As MSG 'структурированная переменная MSG
Dim As WNDCLASSEX wc 'структурированная переменная WNDCLASSEX
Dim As String NameClass="MyClass" ' переменная имени класса
Dim As HINSTANCE Hinst=GetModuleHandle(0) ' хендл модуля
' функция класса
Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_CREATE
            ' Создаем контекст устройства
            Dim As HDC hdc = CreateDC("DISPLAY",0,0,0)
            ' Производим калькуляцию
            Dim As Integer size = -MulDiv(14, GetDeviceCaps(hdc, LOGPIXELSY), 72)
            ' Удаляем контекст устройства
            DeleteDC(hdc)
            ' Создаем курсивный шрифт Courier 14
            Dim As HFONT font  = CreateFont(size,0,15*10,0,400,1,0,0, _
            DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,_
            DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE,"Courier")
            ' Создаем контрол BUTTON
            Dim Button As HWND = CreateWindowEx(0,"button","Простая кнопка",_
            WS_VISIBLE Or WS_CHILD,30,20,140,20,hwnd,Cast(HMENU,1),0,0)
            ' устанавливаем для кнопки созданный шрифт
            SendMessage(Button,WM_SETFONT,Cast(WPARAM,font),0)
        Case WM_DESTROY
            PostQuitMessage(0)
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function
' Заполнение структуры WNDCLASSEX
With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_WINLOGO)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(NameClass)
    .hIconSm=.hIcon
End With
' Регистрация класса окна
If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif
'Создание окна
CreateWindowEx(0,NameClass,"Замена шрифта",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,10,10,200,100,0,0,Hinst,0)
' Цикл сообщений
While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend

font1.png

В своих программах часто используют диалоги , для того чтобы пользователь сам мог выбрать шрифт из имеющихся в системе. Вызвать такой диалог можно с помощью функции ChooseFont, у которой всего один параметр: указатель на структуру CHOOSEFONT. Сама структура выглядит так:

Type CHOOSEFONT field=1
    lStructSize As DWORD ' Размер структуры
    hwndOwner As HWND ' Окно, за которым будет закреплен диалог
    hDC As HDC ' Контект устройства
    lpLogFont As LPLOGFONTA 'Указатель на структуру LOGFONT
    iPointSize As INT_ 'Размер выбранного шрифта, в единицах 1/10 пункта.
    Flags As DWORD ' Флаги диалога
    rgbColors As DWORD 'Начальный цвет текста
    lCustData As LPARAM 'Определяемые программой данные
    lpfnHook As LPCFHOOKPROC 'Указатель на фильтр (hook) - процедуру CFHookProc
    lpTemplateName As LPCSTR 'Указатель на строку, которая именует ресурс шаблона диалогового окна в модуле
    hInstance As HINSTANCE 'Дескриптор объекта памяти или модуля
    lpszStyle As LPSTR 'Указатель на буфер, который содержит данные о стиле
    nFontType As WORD 'Тип выбранного шрифта
    nSizeMin As INT_ 'Минимальный размер шрифта в пунктах
    nSizeMax As INT_ 'Максимальный размер шрифта в пунктах
End Type


Полное описание структуры на русском можно найти ЗДЕСЬ

Как много полей :)  И все же для рядовых случаев хватит заполнить всего два поля:

lStructSize - для указания размера структуры
lpLogFont  - для установки\получения характеристик логического шрифта

После того, как пользователь закроет диалогое окно, в параметре lpLogFont будет указатель на структуру LOGFONT , из которой можно получить любые характеристики шрифта или дополнить\изменить какие-либо поля структуры, до создания шрифта. Почитать о параметрах структуры LOGFONT можно ЗДЕСЬ

Шрифт создается с помощью функции CreateFontIndirect, которой нужно передать указатель на структуру LOGFONT. Функция вернет хендл шрифта.

И пример:

#INCLUDE "windows.bi"
#INCLUDE "win/commdlg.bi"
Dim msg As MSG 'структурированная переменная MSG
Dim As WNDCLASSEX wc 'структурированная переменная WNDCLASSEX
Dim As String NameClass="MyClass" ' переменная имени класса
Dim As HINSTANCE Hinst=GetModuleHandle(0) ' хендл модуля
' функция класса
Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_CREATE
            Dim cf As CHOOSEFONT
            Dim lf As LOGFONT
            Dim As HFONT font

            cf.lStructSize = Sizeof (cf)
            cf.lpLogFont = @lf

            If (ChooseFont(Cast(LPCHOOSEFONT,@cf))=TRUE) Then
                font = CreateFontIndirect(Cast(LOGFONT Ptr,cf.lpLogFont))
            Endif
            ' Создаем контрол BUTTON
            Dim Button As HWND = CreateWindowEx(0,"button","Простая кнопка",_
            WS_VISIBLE Or WS_CHILD,30,20,140,20,hwnd,Cast(HMENU,1),0,0)
            ' устанавливаем для кнопки созданный шрифт
            SendMessage(Button,WM_SETFONT,Cast(WPARAM,font),0)
        Case WM_DESTROY
            PostQuitMessage(0)
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function
' Заполнение структуры WNDCLASSEX
With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_WINLOGO)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(NameClass)
    .hIconSm=.hIcon
End With
' Регистрация класса окна
If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif
'Создание окна
CreateWindowEx(0,NameClass,"Замена шрифта",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,10,10,200,100,0,0,Hinst,0)
' Цикл сообщений
While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend

font2.png 

 

содержание | назад | вперед