Difference between revisions of "LCL Internals/ru"

From Lazarus wiki
Jump to navigationJump to search
Line 479: Line 479:
 
</pre>
 
</pre>
  
−
=== Implementing TLabel ===
+
=== Внедрение TLabel ===
  
−
Implementing TLabel is particularly hard, despite it being such a basic component, because it requires that almost all painting be implemented. TLabel is not a windowed control, instead it depends on paint messages to be drawn directly into the form canvas.
+
Внедрить TLabel особенно сложно, несмотря на то, что он является этаким базовым компонентом, потому что это требует, чтобы была реализована почти вся отрисовка. TLabel не является оконным элементом управления, вместо этого он зависит от сообщений отрисовки, рисующих [компонент] непосредственно на холсте формы.
  
−
Before trying to get TLabel working it is recomended to test if drawing functions such as Rectangle work inside a form's OnPaint event.
+
Прежде чем пытаться заставить работать TLabel, рекомендуется проверить, работают ли функции рисования, такие как Rectangle, внутри события OnPaint формы.
  
−
Several WinAPI methods need to be implemented, particularly:
+
Необходимо реализовать несколько методов WinAPI, в частности:
  
−
'''Device Context Methods'''
+
'''Методы контекста устройства'''
  
 
BeginPaint, GetDC, EndPaint, ReleaseDC, CreateCompatibleDC
 
BeginPaint, GetDC, EndPaint, ReleaseDC, CreateCompatibleDC
  
−
see [[Device Contexts and GDI objects in the LCL interfaces]]
+
см. [[Device_Contexts_and_GDI_objects_in_the_LCL_interfaces|Контексты устройств и объекты GDI в интерфейсах LCL]]
  
−
'''GDI Objects Methods'''
+
'''Методы объектов GDI'''
  
 
SelectObject, DeleteObject, CreateFontIndirect, CreateFontIndirectEx
 
SelectObject, DeleteObject, CreateFontIndirect, CreateFontIndirectEx
  
−
'''Miscelaneous functions'''
+
'''Разные функции'''
  
 
InvalidateRect, GetClientBounds, SetWindowOrgEx
 
InvalidateRect, GetClientBounds, SetWindowOrgEx
  
−
'''Text drawing Methods'''
+
'''Методы рисования текста'''
  
−
DrawText. Instead of implementing DrawText one can also use the default TWidgetSet.DrawText, like the Carbon and Cocoa widgetsets do. But in this case it is necessary that one implements at least GetTextMetrics, GetTextExtentPoint and ExtTextOut. Without GetTextMetrics a form with a label will crash because the autosize will not be able to calculate the appropriate size for the label.
+
DrawText.</br>Вместо реализации DrawText можно также использовать стандартный TWidgetSet.DrawText, как это делают наборы виджетов Carbon и Cocoa. Но в этом случае необходимо, чтобы каждый реализовывал хотя бы GetTextMetrics, GetTextExtentPoint и ExtTextOut. Без GetTextMetrics форма с TLabel рухнет, потому что авторазмер не сможет рассчитать подходящий размер для TLabel.
  
−
'''Region functions to determine if the control is behind another'''
+
'''Функции Region для определения, что элемент управления находится за другим'''
  
 
CombineRgn, CreateRectRgn, GetClipRGN, RectVisible
 
CombineRgn, CreateRectRgn, GetClipRGN, RectVisible
  
  
−
Below is the order in which paint procedures are called on a form with only one TLabel, to better understand the painting sequence:
+
Ниже приведен порядок вызова процедур рисования в форме с одним TLabel, чтобы лучше понять последовательность рисования:
−
 
+
<pre>
−
1 - GetDC is called once on software startup with hWnd = 0
+
1 - GetDC вызывается один раз при запуске программного обеспечения с hWnd = 0
−
 
+
2 - Показывается форма
−
2 - The form is shown
+
3 - GetDC вызывается снова (это не произошло бы без TLabel). Вызывается несколько функций, связанных со шрифтами, а также DrawText с CalcRect, установленным в True, чтобы вычислить размер TLabel.
−
 
+
4 - InvalidateRect вызывается на холсте формы
−
3 - GetDC is called again (this wouldn't happen without the label). A
+
5 - Управление возвращается к операционной системе до тех пор, пока из набора виджетов не придет сообщение отрисовки
−
few font related functions are called, as well as DrawText with
+
6 - Вызывается BeginPaint, и в этот момент будет выполнен код в событии OnPaint формы
−
CalcRect set to True to calculate the size of the label.
+
7 - DrawText вызывается снова с CalcRect установленным в false
−
 
+
8 - Отрисовка закончена</pre>
−
4 - InvalidateRect is called on the form canvas
 
−
 
 
−
5 - Control goes back to the operating system until a paint message comes from the widgetset
 
−
 
 
−
6 - BeginPaint is called, and at this point code on OnPaint event of the form will be executed
 
−
 
 
−
7 - DrawText is called again with CalcRect set to false
 
−
 
 
−
8 - The Painting ends.
 
  
 
=== Implementing visibility for forms and controls and window state===
 
=== Implementing visibility for forms and controls and window state===

Revision as of 20:17, 1 July 2019

│ English (en) │ español (es) │ 日本語 (ja) │ русский (ru) │

Другие интерфейсы

  • Lazarus known issues (things that will never be fixed) - Список проблем совместимости интерфейса
  • Win32/64 Interface - Интерфейс winapi для Windows 95/98/Me/2K/XP/Vista, но не для CE
  • Windows CE Interface - Для карманных ПК и смартфонов
  • Carbon Interface - Интерфейс Carbon для Mac OS X
  • Cocoa Interface - Интерфейс Cocoa для Mac OS X
  • Qt Interface - Интерфейс Qt4 для Unix, Mac OS X, Windows и КПК на базе Linux
  • Qt5 Interface - Интерфейс Qt5 для Unix, Mac OS X, Windows и КПК на базе Linux
  • GTK1 Interface - Интерфейс gtk1 для Unix, Mac OS X (X11), Windows
  • GTK2 Interface - Интерфейс gtk2 для Unix, Mac OS X (X11), Windows
  • GTK3 Interface - Интерфейс gtk3 для Unix, Mac OS X (X11), Windows
  • fpGUI Interface - Основан на библиотеке fpGUI, которая представляет собой кроссплатформенный инструментарий, полностью написанный на Object Pascal
  • Custom Drawn Interface - Кроссплатформенный бэкэнд LCL, написанный полностью на Object Pascal внутри Lazarus. Интерфейс Lazarus для Android.

Советы для конкретных платформ

  • Windows Programming Tips - Cоветы по программированию на desktop-Windows.
  • Linux Programming Tips - Как выполнять определенные задачи программирования в Linux
  • OS X Programming Tips - Советы по Lazarus, полезные инструменты, команды Unix и многое другое ...
  • WinCE Programming Tips - Использование телефонного API, отправка SMS-сообщений и многое другое ...
  • Android Programming - Для Android смартфонов и планшетов
  • iPhone/iPod development - Об использовании Objective Pascal для разработки приложений для iOS

Статьи по разработке интерфейсов

  • Carbon interface internals - Если вы хотите помочь улучшить интерфейс Carbon
  • Windows CE Development Notes - Для карманных ПК и смартфонов
  • Adding a new interface - Как добавить новый интерфейс набора виджетов
  • LCL Defines - Выбор правильных опций для перекомпиляции LCL
  • LCL Internals - Некоторая информация о внутренней работе LCL
  • Cocoa Internals - Некоторая информация о внутренней работе виджета Cocoa

Минимальные версии Toolkit

Lazarus version Мин. FPC Мин. Gtk 2 Мин. Qt 4 Мин. Windows Мин. Windows CE Мин. Mac OS X (Carbon) Мин. Mac OS X (Cocoa) Мин. треб. LCL-CustomDrawn
0.9.24 2.2.0 2.6+ 4.2+ Windows 98+ Рекомендуется 4.0+ 10.4 N/A N/A
0.9.26 2.2.2 2.6+ 4.3+ Windows 98+ Рекомендуется 4.0+ 10.4 N/A N/A
0.9.28 2.2.4 2.8+ 4.5+ Windows 98+ Рекомендуется 4.0+ 10.4 N/A N/A
0.9.30 2.4.0 2.8+ 4.5+ Windows 98+ Рекомендуется 5.0+ 10.4 N/A N/A
0.9.31 2.4.4 2.8+ 4.5+ Windows 98+ Рекомендуется 5.0+ 10.4 10.6 Android 2.2+, Windows 2000+, X11, Mac OS X 10.6+
1.2.6 2.6.4 2.8+ 4.5+* Windows 98+ Рекомендуется 5.0+ 10.4 10.6 Android 2.2+, Windows 2000+, X11, Mac OS X 10.6+
  • - На самом деле 4.5.0 ... 4.8.4 с предварительно собранным Qt4Pas.dll, 4.8.5+ требует другого Qt4Pas.dll

См.также: совместимость

Внутренности LCL

Есть LCL и есть «интерфейс». LCL - это часть, которая не зависит от платформы и находится в каталоге lazarus/lcl/. Этот каталог содержит в основном определения классов. Многие различные элементы управления фактически реализованы в каталоге lazarus/lcl/include/ в различных файлах .inc. Это делается для того, чтобы быстрее найти реализацию определенного элемента управления, например TCustomMemo (который находится в custommemo.inc). Каждый .inc начинается со строки {% MainUnit ...}, чтобы определить, где он включен.

Также есть «интерфейс», который находится в подкаталоге каталога lazarus/lcl/interfaces/. Интерфейс gtk находится в gtk/, win32 в win32/ и т.д. Все они имеют модуль Interfaces, который используется lcl и создает основной объект интерфейса. Обычно основной интерфейсный объект определяется в XXint.pp (win32int.pp) и реализуется в различных inc-файлах, XXobject.inc - для методов, специфичных для интерфейса, XXwinapi.inc - для методов реализации winapi, XXlistsl.inc - для реализации списка строк, использующихся TComboBox, TListBox и другими подобными элементами управления, XXcallback.inc - для обработки событий виджета и принятия соответствующих действий для уведомления LCL.

Каждый элемент управления имеет свойство WidgetSetClass, принадлежащее "зеркальному" классу в каталоге интерфейсов, например: "зеркало" для TCustomEdit - это TWSCustomEdit, методы которого реализуются TWin32WSCustomEdit в win32wsstdctrls. Это способ, которым LCL взаимодействует с интерфейсом, и то, как он позволяет интерфейсу делать свое дело.

Передача интерфейса обратно в LCL в основном осуществляется путем отправки сообщений, обычно 'DeliverMessage', который вызывает TControl.Perform (<message_id>, wparam, lparam), где wparam и lparam являются дополнительной информацией для сообщения.

Pie и RadialPie

Модуль LCLIntf содержит две функции для рисования округлых фигур: 

function Pie(DC: HDC; x1, y1, x2, y2, sx, sy, ex, ey: Integer): Boolean;
function RadialPie(DC: HDC; x1, y1, x2, y2, Angle1, Angle2: Integer): Boolean;

Функция Pie использует две точки (sx,sy) и (ex,ey) для указания начала и конца дуги. RadialPie использует углы, чтобы указать начало и конец дуги.

Pie вызывает TWidgetSet.Pie, а RadialPie вызывает TWidgetSet.RadialPie. Реализация TWidgetSet.Pie по умолчанию заключается в преобразовании параметров в углы и вызове TWidgetSet.RadialPie. TWidgetSet.RadialPie создает массив точек для дуги и вызывает TWidgetSet.Polygon.

Набор виджетов win32 переопределяет TWidgetSet.Pie для непосредственного вызова функции Windows Pie.

Light bulb  Примечание: в более старых версиях Lazarus существовал RadialPie с углами, которые делали то же, что и нынешние RadialPie и RadialPie, которые делают то же самое, что и наша [функция] Pie. Эти функции были удалены в Lazarus 0.9.21.

Интерфейсы

См. другие интерфейсы

Добавление нового модуля в LCL

Сначала добавьте новое имя модуля в allclunits.pp.

Чтобы убедиться, что модуль зарегистрирован в палитре компонентов, смотрите файлы RegisterLCL.pas и pkgfileslcl.inc, они расположены в lazarus/packager.

Как создать новый Widgetset

Это пошаговое руководство по разработке нового widgetset. Он основан на моем опыте создания основ нового интерфейса qt4.

Для начала, почему кто-то хочет добавить Widgetset? Ответ заключается в том, чтобы иметь возможность портировать существующее программное обеспечение Lazarus на большее количество платформ без изменения их кода.

Итак, давайте напишем набор виджетов. Прежде всего, вам нужно иметь паскаль привязки для виджета и знать, как его использовать. Обычно это не сложно. Несколько часов работы с основными учебными пособиями, доступными в Интернете, должны быть достаточными для начала. Если привязки еще не существуют, их нужно создать. Если учебные пособия написаны на другом языке, переведите их на паскаль и заставьте их работать.

Теперь для Qt я использовал привязки Den Jean qt4 для паскаля и создал очень простую программу Qt, используя их: 

program qttest;

uses qt4;

var
  App: QApplicationH;
  MainWindow: QMainWindowH;
begin
  App := QApplication_Create(@argc,argv);

  MainWindow := QMainWindow_Create;

  QWidget_show(MainWindow);

  QApplication_Exec;
end.

Вышеуказанный проект компилируется и создает программу qt4. Теперь мы будем использовать его код для написания нового набора виджетов. После того, как мы закончим, приведенная ниже программа lazarus прекрасно скомпилируется в программу qt4: 

program qttest;

{$mode objfpc}{$H+}

uses
  Interfaces, Classes, Forms,
  { Add your units here }
  qtform;

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

где форма поддерживается Lazarus IDE и разрабатывается визуально.

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

Просматривая файлы на многих виджетах, вы можете увидеть первый файл, который будет вызван lcl: Interfaces.pas. Этот файл просто вызывает другой файл с именем QtInt.pas или аналогичный. QtInt.pas содержит код для класса TWidgetSet, который мы должны реализовать. На пустом скелете вы можете видеть, что у класса есть различные функции, которые он должен реализовать: 

  TQtWidgetSet = Class(TWidgetSet)
  private
    App: QApplicationH;
  public
    {$I qtwinapih.inc}
    {$I qtlclintfh.inc}
  public
    // Application
    procedure AppInit(var ScreenInfo: TScreenInfo); override;
    procedure AppRun(const ALoop: TApplicationMainLoop); override;
    procedure AppWaitMessage; override;
    procedure AppProcessMessages; override;
    procedure AppTerminate; override;
    procedure AppMinimize; override;
    procedure AppBringToFront; override;
  public
    constructor Create;
    destructor Destroy; override;
    function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
    procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
    procedure DCRedraw(CanvasHandle: HDC); override;
    procedure SetDesigning(AComponent: TComponent); override;

    function  InitHintFont(HintFont: TObject): Boolean; override;

    // create and destroy
    function CreateComponent(Sender : TObject): THandle; override; // deprecated
    function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): integer; override;
    function DestroyTimer(TimerHandle: integer): boolean; override;
  end;

Как реализовать новый оконный компонент

Все оконные компоненты являются потомками TWinControl. Эти элементы управления имеют дескриптор и поэтому должны создаваться набором виджетов. Добавлять новые оконные компоненты в набор виджетов [довольно] легко.

Допустим, вы хотите добавить TQtWSCustomEdit в Qt Widgetset. [Нужно] начать с TCustomEdit, [который] является потомком TWinControl и находится в модуле StdCtrls.

Теперь перейдите к модулю QtWSStrCtrls и найдите объявление TQtWSCustomEdit. 

  TQtWSCustomEdit = class(TWSCustomEdit)
  private
  protected
  public
  end;

Добавьте статические методы, объявленные в TWSCustomEdit, и переопределите их. Код должен теперь выглядеть так: 

  TQtWSCustomEdit = class(TWSCustomEdit)
  private
  protected
  public
    class function CreateHandle(const AWinControl: TWinControl;
          const AParams: TCreateParams): HWND; override;
    class procedure DestroyHandle(const AWinControl: TWinControl); override;
{    class function  GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
    class function  GetSelLength(const ACustomEdit: TCustomEdit): integer; override;

    class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
    class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
    class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
    class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
    class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
    class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
    class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;

    class procedure GetPreferredSize(const AWinControl: TWinControl;
                        var PreferredWidth, PreferredHeight: integer); override;}
  end;

Закомментированная часть кода - это процедуры, которые необходимо реализовать, чтобы TCustomEdit был полностью функциональным, но достаточно просто [наличия] CreateHandle и DestroyHandle, чтобы он отображался в форме и был редактируемым, поэтому он соответствует нашим потребностям в этой статье.

Нажмите Ctrl+⇧ Shift+C, чтобы завершить код и реализовать CreateHandle и DestroyHandle. В случае Qt4 код будет таким: 

{ TQtWSCustomEdit }

class function TQtWSCustomEdit.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): HWND;
var
  Widget: QWidgetH;
  Str: WideString;
begin
  // Создаем виджет
  WriteLn('Calling QTextDocument_create');
  Str := WideString((AWinControl as TCustomMemo).Lines.Text);
  Widget := QTextEdit_create(@Str, QWidgetH(AWinControl.Parent.Handle));

  //Задаем его начальные свойства
  QWidget_setGeometry(Widget, AWinControl.Left, AWinControl.Top,
   AWinControl.Width, AWinControl.Height);

  QWidget_show(Widget);

  Result := THandle(Widget);
end;

class procedure TQtWSCustomEdit.DestroyHandle(const AWinControl: TWinControl);
begin
  QTextEdit_destroy(QTextEditH(AWinControl.Handle));
end;

Теперь раскомментируйте строку "RegisterWSComponent (TCustomEdit, TQtWSCustomEdit);" в конце модуля и ... все!

Теперь вы можете поместить TCustomEdit внизу формы и ожидать, что он будет работать. :^)

Реализация TBitmap

Для реализации TBitmap необходимо понимать TRawImage и TLazIntfImage, как описано здесь: Developing with Graphics#Working with TLazIntfImage.2C TRawImage and TLazCanvas

Итак, допустим, вы хотите скомпилировать следующий код: 

procedure TMyForm.HandleOnPaint(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.LoadFromFile('myfile.bmp');
    Canvas.Draw(0, 0, Bitmap);
  finally
    Bitmap.Free;
  end;
end;

Ниже приведен порядок вызова функций из интерфейса widgetset при выполнении этого кода: 

 1 - BeginPaint

Это будет вызвано только, если событие OnPaint отправляет ноль в качестве DC для события рисования 


 2 - GetDC(0);

Просто создает контекст устройства. 


 3 - TCDWidgetSet.RawImage_QueryDescription

Реализация этой процедуры по умолчанию подходит для большинства наборов виджетов. 


 4 - TCDWidgetSet.RawImage_CreateBitmaps

Здесь вам нужно создать собственный объект изображения и загрузить его из RawData.Data, где хранится информация на основе вашего описания формата пикселя в пункте 2. 


 5 - CreateCompatibleDC(0)

Это создает временный DC только для хранения изображения, но на данный момент нет информации об изображении, поэтому в этот момент этот DC действительно фиктивный 


 6 - SelectObject

С изображением в качестве объекта, который будет выбран, и DC, созданный выше, в качестве целевого DC. 


 7 - StretchMaskBlt

Наконец, функция рисования! DestDC - это DC, размещенный на BeginPaint. 


 8 - EndPaint

Опять же, не всегда используется.

TBitmap.LoadFromDevice для снятия скриншота

Рекомендуется сначала реализовать Bitmap, прежде чем делать этот шаг.

В LCL вы можете использовать следующий код, делающий скриншот со всего экрана и рисующий его на холсте: 

var
  ScreenDC: HDC;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    ScreenDC := GetDC(0);
    Bitmap.LoadFromDevice(ScreenDC);
    ReleaseDC(0, ScreenDC);
    Canvas.Draw(0, 0, Bitmap);
  finally
    Bitmap.Free;
  end;
end;

Если вы уже внедрили TBitmap, для LoadFromDevice нужно реализовать только 2 новые функции: GetDeviceSize и GetRawImageFromDevice

Ниже приведен большой трейс, охватывающий все функции набора виджетов, вызываемые для события OnPaint, которое делает снимок экрана и рисует его на экране. Эта трассировка была сделана с помощью набора виджетов Qt и может иметь некоторые недостатки. Номера дескрипторов должны использоваться для проверки того, какой объект используется в функциях. 

[WinAPI BeginPaint] Result=-1220713544
[WinAPI GetClientBounds]
[WinAPI SetWindowOrgEx] DC: -1220713544 NewX: 0 NewY: 0
//Входим в событие OnPaint
Bitmap := TBitmap.Create;
try
  ScreenDC := GetDC(0);

[WinAPI GetDC] hWnd: 0 Result: -1220712920
    Bitmap.LoadFromDevice(ScreenDC);
[WinAPI GetDeviceSize]
[WinAPI GetRawImageFromDevice] SrcDC: -1220712920 SrcWidth: 0 SrcHeight: 0
[WinAPI CreateBitmapFromRawImage] Width:1024 Height:768 DataSize: 3145728 CreateMask: False Bitmap:-1220746696
[WinAPI GetObject] GDIObj: -1220746696 Result=84 ObjectType=Image
  ReleaseDC(0, ScreenDC);

[WinAPI ReleaseDC] hWnd: 0 DC: -1220712920
Canvas.Draw(0, 0, Bitmap);

[WinAPI CreateCompatibleDC] DC: 0
[WinAPI GetDC] hWnd: 0 Result: -1220712920
[WinAPI SelectObject] DC=-1220712920 GDIObj=-1220746696 Result=0 ObjectType=Image
[WinAPI StretchMaskBlt] DestDC:-1220713544 SrcDC:-1220712920 Image:137185120 X:0 Y:0 W:1024 H:768 XSrc:0 YSrc:0 WSrc:1024 HSrc:768
finally
  Bitmap.Free;
end;

[WinAPI SelectObject] DC=-1220712920 GDIObj=0 Invalid GDI Object
[WinAPI DeleteObject] GDIObject: -1220746696 Result=False ObjectType=Image
//Здесь мы вышли из события OnPaint

[WinAPI DeleteObject] GDIObject: 0
[WinAPI DeleteObject] GDIObject: 0
[WinAPI DeleteObject] GDIObject: 0
[WinAPI DeleteObject] GDIObject: 0
[WinAPI SetWindowOrgEx] DC: -1220713544 NewX: -152 NewY: -246
[WinAPI DeleteObject] GDIObject: 0
[WinAPI DeleteObject] GDIObject: 0
[WinAPI DeleteObject] GDIObject: 0
[WinAPI DeleteObject] GDIObject: 0
TWidgetSet.InitializeCriticalSection
TWidgetSet.EnterCriticalSection
[WinAPI SelectObject] DC=-1220713544 GDIObj=0 Invalid GDI Object
[WinAPI MoveToEx] DC:-1220713544 X:0 Y:0
[WinAPI SelectObject] DC=-1220713544 GDIObj=-1220746760 Result=-1220746856 ObjectType=Brush
[WinAPI SelectObject] DC=-1220713544 GDIObj=-1220746856 Result=-1220746856 ObjectType=Brush
TWidgetSet.LeaveCriticalSection
[WinAPI SetWindowOrgEx] DC: -1220713544 NewX: 0 NewY: 0
[WinAPI EndPaint] Handle: -1220611768 PS.HDC: -1220713544

Реализация рисования в событии OnPaint формы или другого элемента управления

Для рисования в событии OnPaint формы само событие приходит из библиотеки лежащих в основе виджетов. Интерфейс LCL должен обработать это событие и создать соответствующий объект DC в обработчике событий, а затем вызвать LCLSendPaintMsg. Кроме того, следует также реализовать соответствующие методы рисования, такие как Rectangle или ExtTextOut. Также могут быть полезны процедуры, связанные с Pen(перо), Brush(кисть) и Font(шрифт).

Вот обработчик события OnPaint из набора виджетов Cocoa, который показывает, как он вызывает LCLSentPaintMsg: 

procedure TLCLCommonCallback.Draw(ControlContext: NSGraphicsContext;
  const bounds, dirty:NSRect);
var
  struct : TPaintStruct;
begin
  if not Assigned(Context) then Context:=TCocoaContext.Create;

  Context.ctx:=ControlContext;
  if Context.InitDraw(Round(bounds.size.width), Round(bounds.size.height)) then
  begin
    FillChar(struct, SizeOf(TPaintStruct), 0);
    struct.hdc := HDC(Context);
    {$IFDEF VerboseWinAPI}
      DebugLn(Format('[TLCLCommonCallback.Draw] OnPaint event started context: %x', [HDC(context)]));
    {$ENDIF}
    LCLSendPaintMsg(Target, HDC(Context), @struct);
    {$IFDEF VerboseWinAPI}
      DebugLn('[TLCLCommonCallback.Draw] OnPaint event ended');
    {$ENDIF}
  end;
end;

И список подпрограмм WinAPI, которые были вызваны при запуске этого события: 

[TCocoaWidgetSet.GetDC] hWnd: 0 Result: 12400C0
[TLCLCommonCallback.Draw] OnPaint event started context: 1240340
TCocoaWidgetSet.CreatePenIndirect
TCocoaWidgetSet.SelectObject DC: 1240340 GDIObj: 10EC460
TCocoaWidgetSet.SelectObject Result: 0
TCocoaWidgetSet.SelectObject DC: 1240340 GDIObj: 10EBF00
TCocoaWidgetSet.SelectObject Result: 0
[TCocoaWidgetSet.Rectangle] DC: 1240340 X1: 100 Y1: 100 X2: 200 Y2: 200
TCocoaWidgetSet.SelectObject DC: 1240340 GDIObj: 10EC4A0
TCocoaWidgetSet.SelectObject Result: 0
[TCocoaWidgetSet.GetTextExtentPoint] DC: 1240340 Str: Some text Count: 9
[TCocoaWidgetSet.GetTextExtentPoint] Size: 65,17
[TLCLCommonCallback.Draw] OnPaint event ended

Внедрение TLabel

Внедрить TLabel особенно сложно, несмотря на то, что он является этаким базовым компонентом, потому что это требует, чтобы была реализована почти вся отрисовка. TLabel не является оконным элементом управления, вместо этого он зависит от сообщений отрисовки, рисующих [компонент] непосредственно на холсте формы.

Прежде чем пытаться заставить работать TLabel, рекомендуется проверить, работают ли функции рисования, такие как Rectangle, внутри события OnPaint формы.

Необходимо реализовать несколько методов WinAPI, в частности:

Методы контекста устройства

BeginPaint, GetDC, EndPaint, ReleaseDC, CreateCompatibleDC

см. Контексты устройств и объекты GDI в интерфейсах LCL

Методы объектов GDI

SelectObject, DeleteObject, CreateFontIndirect, CreateFontIndirectEx

Разные функции

InvalidateRect, GetClientBounds, SetWindowOrgEx

Методы рисования текста

DrawText.
Вместо реализации DrawText можно также использовать стандартный TWidgetSet.DrawText, как это делают наборы виджетов Carbon и Cocoa. Но в этом случае необходимо, чтобы каждый реализовывал хотя бы GetTextMetrics, GetTextExtentPoint и ExtTextOut. Без GetTextMetrics форма с TLabel рухнет, потому что авторазмер не сможет рассчитать подходящий размер для TLabel.

Функции Region для определения, что элемент управления находится за другим

CombineRgn, CreateRectRgn, GetClipRGN, RectVisible


Ниже приведен порядок вызова процедур рисования в форме с одним TLabel, чтобы лучше понять последовательность рисования: 

1 - GetDC вызывается один раз при запуске программного обеспечения с hWnd = 0
2 - Показывается форма
3 - GetDC вызывается снова (это не произошло бы без TLabel). Вызывается несколько функций, связанных со шрифтами, а также DrawText с CalcRect, установленным в True, чтобы вычислить размер TLabel.
4 - InvalidateRect вызывается на холсте формы
5 - Управление возвращается к операционной системе до тех пор, пока из набора виджетов не придет сообщение отрисовки
6 - Вызывается BeginPaint, и в этот момент будет выполнен код в событии OnPaint формы
7 - DrawText вызывается снова с CalcRect установленным в false
8 - Отрисовка закончена

Implementing visibility for forms and controls and window state

The code that controls visibility is split between visibility for forms, and for controls

Visibility for forms and window state

This part also controls the state of the window (minimized, maximized or normal). It is implemented as a copy of the Windows API function ShowWindow, so you must implemente the TMyWidgetset.ShowWindow on the file mywinapi.inc Don´t forget to also add a header to the file mywinapih.inc

Below is code that implements this function on the Qt widgetset. It should be very easy to understand, copy and implement on your own widgetset. You can also take a look how Gtk implements this. On Windows, the Windows API is called directly, of course, so there is no code to look at. 

{------------------------------------------------------------------------------
  function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;

  nCmdShow:
    SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
------------------------------------------------------------------------------}
function TQtWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
var
  Widget: QWidgetH;
begin
  {$ifdef VerboseQtWinAPI}
    WriteLn('WinAPI ShowWindow');
  {$endif}

  Result := False;
  
  Widget := QWidgetH(hWnd);

//  if Widget = nil then RaiseException('TQtWidgetSet.ShowWindow  hWnd is nil');

  case nCmdShow of

    SW_SHOW: QWidget_setVisible(Widget, True);

    SW_SHOWNORMAL: QWidget_showNormal(Widget);

    SW_MINIMIZE: QWidget_setWindowState(Widget, QtWindowMinimized);

    SW_SHOWMINIMIZED: QWidget_showMinimized(Widget);

    SW_SHOWMAXIMIZED: QWidget_showMaximized(Widget);

    SW_HIDE: QWidget_setVisible(Widget, False);
    
  end;

  Result := True;
end;

Visibility for controls

For controls inside a form you need to implement TMyWSWinControl.ShowHide class function that resides on the TMyWSWinControl class on the file mywscontrols.pp

Remember that most controls are descendent from TWinControl, so implementing this function there will guarantee that the Visible property is implemented for all standard controls that have it. Below is a sample code for Qt widgetset. 

{------------------------------------------------------------------------------
  Method: TQtWSWinControl.ShowHide
  Params:  AWinControl     - the calling object

  Returns: Nothing

  Shows or hides a widget.
 ------------------------------------------------------------------------------}
class procedure TQtWSWinControl.ShowHide(const AWinControl: TWinControl);
begin
  if AWinControl = nil then exit;

  if not AWinControl.HandleAllocated then exit;

  if AWinControl.HandleObjectShouldBeVisible then
   QWidget_setVisible(TQtWidget(AWinControl.Handle).Widget, True)
  else QWidget_setVisible(TQtWidget(AWinControl.Handle).Widget, False);
end;

Implementing TStrings based Components

Some components use a TStrings to store the information they display, such as: TCustomMemo, TCustomListBox and TCustomComboBox.

To implement those it is not enougth to only implement their functions on the TQtCustomMemo class for example. One of the functions to implement will be called GetStrings, which looks like this: 

class function TQtWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
  ListWidgetH: QListWidgetH;
begin
  ListWidgetH := QListWidgetH((TQtWidget(ACustomListBox.Handle).Widget));
  Result := TQtListStrings.Create(ListWidgetH, ACustomListBox);
end;

This function must return a TStrings descendent designed to detect when strings are added to or removed from the string list and to send this information to the widgetset to update the control. For example, the following declaration shows what TQtListStrings looks like: 

  TQtListStrings = class(TStrings)
  private
    FListChanged: Boolean; // StringList and QtListWidget out of sync
    FStringList: TStringList; // Holds the items to show
    FQtListWidget: QListWidgetH;  // Qt Widget
    FOwner: TWinControl;      // Lazarus Control Owning ListStrings
    FUpdating: Boolean;       // We're changing Qt Widget
    procedure InternalUpdate;
    procedure ExternalUpdate(var Astr: TStringList; Clear: Boolean = True);
    procedure IsChanged; // OnChange triggered by program action
  protected
    function GetTextStr: string; override;
    function GetCount: integer; override;
    function Get(Index : Integer) : string; override;
    //procedure SetSorted(Val : boolean); virtual;
  public
    constructor Create(ListWidgetH : QListWidgetH; TheOwner: TWinControl);
    destructor Destroy; override;
    procedure Assign(Source : TPersistent); override;
    procedure Clear; override;
    procedure Delete(Index : integer); override;
    procedure Insert(Index : integer; const S: string); override;
    procedure SetText(TheText: PChar); override;
    //procedure Sort; virtual;
  public
    //property Sorted: boolean read FSorted write SetSorted;
    property Owner: TWinControl read FOwner;
    function ListChangedHandler(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
  end;

You can see its implementation in the qtobjects.pas unit of the qt interface

Implementing Menus

Menus are available on the LCL to create main menus or popup menus. A TMenu is the owner of a larger menu structure with many items. Items can have subitems, and don't need extra TMenus.

Also remember that on LCL the handle is only created when needed and at that time all properties of the controls are already initialized. This helps a lot on widgetsets where depending on the properties of a menu item it can be of one class or another, like Qt.

The following things need to be implemented in order for the menus to work:

1) All methods on the QtWSMenus unit, which will implement menu creation and modification

2) function TWinCEWidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean; from the wincewinapi.inc file, which will implement support for a main menu associated with a window.

Menu Creation Order

One important thing to understand when implementing menus, is in which order they are created. For example, we want to create the following menu structure:

Menu creation order.png

And when our application is executed, there will be a 'Creating MenuItem' message with the caption of the menu each time TQtWSMenuItem.CreateHandle is called, and a 'Creating Menu' message with the name of the menu (TMenu descendents don't have a caption), each time TQtWSMenu.CreateHandle is called.

Here is the resulting output of such software: 

Creating Menu. Name: MainMenu1
Creating MenuItem: Item1           Parent=Menu.Items : TMenuItem
Creating MenuItem: SubItem11       Parent=Item1      : TMenuItem
Creating MenuItem: SubItem12       Parent=Item1      : TMenuItem
Creating MenuItem: SubItem13       Parent=Item1      : TMenuItem
Creating MenuItem: SubItem14       Parent=Item1      : TMenuItem
Creating MenuItem: SubSubItem141   Parent=SubItem14  : TMenuItem
Creating MenuItem: SubSubItem142   Parent=SubItem14  : TMenuItem
Creating MenuItem: SubSubItem143   Parent=SubItem14  : TMenuItem
Creating MenuItem: SubSubItem144   Parent=SubItem14  : TMenuItem
Creating MenuItem: Item2           Parent=Menu.Items : TMenuItem
Creating MenuItem: SubItem21       Parent=Item2      : TMenuItem
Creating MenuItem: SubItem22       Parent=Item2      : TMenuItem
Creating MenuItem: SubItem23       Parent=Item2      : TMenuItem
Creating MenuItem: Item3           Parent=Menu.Items : TMenuItem
Creating MenuItem: Item4           Parent=Menu.Items : TMenuItem

For all MenuItems one can use GetParentMenu to get their parent owner: Menu (TMainMenu).

Control enabling/disabling

The current way to set control enabling/disabling is by implementing the winapi EnableWindow. This API should work generically on any control. It should enable/disable mouse and keyboard input for the specified window or control, but also mark it as uneditable by the user, by making it greyed for example. 

{------------------------------------------------------------------------------
  Method:  EnableWindow
  Params: HWnd    - handle to window
          BEnable -  whether to enable the window
  Returns: If the window was previously disabled

  Enables or disables mouse and keyboard input to the specified window or
  control.
 ------------------------------------------------------------------------------}
function TWin32WidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;

Shaped Windows

Windows can be shaped based on a TBitmap or on a TRegion. The region is the visible part.

To implement shaped windows based on a TBitmap, implement TWSWinControl.setShape

To implement shaped windows based on a TRegion implement LCLIntf.SetWindowRgn

See also: LCL Tips#Creating a non-rectangular window or control

System colors

Some color constants are actually system colors, like clBtnFace, clForm, clWindow, etc, etc.

To implement support for system colors the WinAPI routine GetSysColor should be implemented: 

function GetSysColor(nIndex: Integer): DWORD; override;

And here is a snip of the color constants which should be supported. Check LCLType for the latest values: 

//==============================================
// API system Color constants  pbd
// note these are usually shown ORed with
// $80000000 as these would have interfered with
// other MS color enumerations
// GetSysColor and SetSysColor expects the values
// below
//==============================================

type
  COLORREF = LongInt;
  TColorRef = COLORREF;

const
  CLR_INVALID = TColorRef($FFFFFFFF);

  COLOR_SCROLLBAR = 0;
  COLOR_BACKGROUND = 1;
  COLOR_ACTIVECAPTION = 2;
  COLOR_INACTIVECAPTION = 3;
  COLOR_MENU = 4;
  COLOR_WINDOW = 5;
  COLOR_WINDOWFRAME = 6;
  COLOR_MENUTEXT = 7;
  COLOR_WINDOWTEXT = 8;
  COLOR_CAPTIONTEXT = 9;
  COLOR_ACTIVEBORDER = 10;
  COLOR_INACTIVEBORDER = 11;
  COLOR_APPWORKSPACE = 12;
  COLOR_HIGHLIGHT = 13;
  COLOR_HIGHLIGHTTEXT = 14;
  COLOR_BTNFACE = 15;
  COLOR_BTNSHADOW = 16;
  COLOR_GRAYTEXT = 17;
  COLOR_BTNTEXT = 18;
  COLOR_INACTIVECAPTIONTEXT = 19;
  COLOR_BTNHIGHLIGHT = 20;
  COLOR_3DDKSHADOW = 21;
  COLOR_3DLIGHT = 22;
  COLOR_INFOTEXT = 23;
  COLOR_INFOBK = 24;
  // PBD: 25 is unassigned in all the docs I can find
  //      if someone finds what this is supposed to be then fill it in
  //      note defaults below, and cl[ColorConst] in graphics
  COLOR_HOTLIGHT = 26;
  COLOR_GRADIENTACTIVECAPTION = 27;
  COLOR_GRADIENTINACTIVECAPTION = 28;
  COLOR_MENUHILIGHT = 29;
  COLOR_MENUBAR = 30;

  COLOR_FORM = 31;

  COLOR_ENDCOLORS = COLOR_FORM;

  COLOR_DESKTOP = COLOR_BACKGROUND;
  COLOR_3DFACE = COLOR_BTNFACE;
  COLOR_3DSHADOW = COLOR_BTNSHADOW;
  COLOR_3DHIGHLIGHT = COLOR_BTNHIGHLIGHT;
  COLOR_3DHILIGHT = COLOR_BTNHIGHLIGHT;
  COLOR_BTNHILIGHT = COLOR_BTNHIGHLIGHT;

  MAX_SYS_COLORS = COLOR_ENDCOLORS;
  SYS_COLOR_BASE = TColorRef($80000000);

ShowMessage

These standard dialogs are implemented purely in the LCL in the following places:

  • Class TPromptDialog file lcl/include/promptdialog.inc

SpinEdit

Both TFloatSpinEdit and TSpinEdit are implemented in the class TWSFloatSpinEdit.

Clipboard

Clipboard support is implemented in lclintf by implementing Windows API routines. The routines are: 

function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardGetData(ClipboardType: TClipboardType;
  FormatID: TClipboardFormat; Stream: TStream): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
// ! ClipboardGetFormats: List will be created. You must free it yourself with FreeMem(List) !
function ClipboardGetFormats(ClipboardType: TClipboardType;
  var Count: integer; var List: PClipboardFormat): boolean;  {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
  OnRequestProc: TClipboardRequestEvent;  FormatCount: integer;
  Formats: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

Sequence of calls during program startup: 

TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/bmp Result=51027040
TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/delphi.bitmap Result=0
TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/xpm Result=0
TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/png Result=0
TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/jpeg Result=0

Sequence of calls during "Caption := Clipboard.AsText": 

TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=text/plain Result=51026976
TCocoaWidgetSet.ClipboardGetData ClipboardType=clipboard FormatID: 51026976

TSpeedButton

This control is a TGraphicControl descendent, so it has no handle and paints itself. To retain native look, it uses the function ThemeServices.DrawElement(Details.Element=teButton) to paint itself, so implement this function to have this control working. Naturally, lot's of other DC, WindowOrg, Text Drawing and Painting routines will have to be working, as explained for TLabel.

TRadioButton and TCheckButton

Messages:

Basically the Widgetset must do:

  • Send LM_CHANGE when a radio button is unchecked/checked (LCL will take care if OnClick will be called or not)
  • Dont send LM_CHANGE when TWSCustomCheckBox.SetState is called (SetChecked)

See also this bug report: http://bugs.freepascal.org/view.php?id=13939

FullScreen support

FullScreen is implemented as a Windows state wsFullScreen, and as such is implemented in LCLIntf.ShowWindow where the constant SW_SHOWFULLSCREEN should be handled.

An example of how the LCL interfaces work

Below is a simple example. Suppose you have developed a trayicon component. How would you implement it in the LCL to work correctly on the various different supported platforms?

You would need to generate the following files:

\trayicon.pas

\wstrayicon.pas

\gtk\gtkwstrayicon.pas

\gtk\trayintf.pas

\win32\win32wstrayicon.pas

\win32\trayintf.pas


Providing separate wsXXX.pas and \$(LCLWidgetType)\XXXintf.pas files avoids the need for ifdefs altogether. You will need to add as a unit path $(LCLWidgetType) to the XXXintf.pas file in order initialize the correct trayintf.pas file, which in turn initializes the correct WS Tray class.

Inside trayicon.pas you include wstrayicon. Derive your main class from an LCL class, and only use wstrayicon in its implementation. All LCL classes that communicate with a widgetset, must be derived from TLCLComponent declared in the LCLClasses unit. 

unit TrayIcon;

interface

type
  TTrayIcon = class(TLCLComponent)
  public
    procedure DoTray;
  end;

implementation

uses wstrayicon;

procedure TTrayIcon.DoTray;
begin
  // Call wstrayicon
end;

end.

in trayintf you use gtkwstrayicon or win32trayicon depending on which trayintf file it is.

in wstrayicon you create a class like so: 

unit WSTrayIcon;

uses WSLCLClasses, Controls, TrayIcon; // and other things as well

TWSTrayIconClass = class of TWSTrayIcon;
TWSTrayIcon = class(TWSWinControl);
public
 class procedure EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon);
virtual; // these must all be virtual and class procedures!!
 class procedure RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon); virtual;
 ....
end;
...

implementation

procedure TWSTrayIcon.EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon);
begin
 //do nothing
end;

procedure TWSTrayIcon.RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon);
begin
 //do nothing
end;

now in gtkwstrayicon.pas do this: 

uses WSTrayIcon, WSLCLClasses, Controls, TrayIcon, gtk, gdk;


TGtkWSTrayIcon = class(TWSTrayIcon);
private
 class function FindSystemTray(const ATrayIcon: TCustomTrayIcon):
TWindow; virtual;
public
 class procedure EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon); override;
 class procedure RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon);
override;
 class function  CreateHandle(const AWinControl: TWinControl; const
AParams: TCreateParams): HWND; override;
 ....
end;
...

implementation

procedure TGtkWSTrayIcon.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
WidgetInfo: PWidgetInfo;
begin

 Result := gtk_plug_new;
 WidgetInfo := CreateWidgetInfo(AWinControl, Result); // it's something
like this anyway
 TGtkWSWincontrolClass(WidgetSetClass).SetCallbacks(AWinControl);
 // and more stuff
end;

function TGtkWSTrayIcon.FindSystemTray(const ATrayIcon:
TCustomTrayIcon): TWindow;
begin
 // do something
end;


procedure TGtkWSTrayIcon.EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon);
var
SystemTray: TWindow;
begin
 SystemTray := FindSystemTray(ATrayIcon);
 //do something
end;

procedure TGtkWSTrayIcon.RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon);
begin
 //do something
end;

......

initialization

RegisterWSComponent(TCustomTrayIcon, TGtkWSTrayIcon); //this is very
important!!!

end.

then finally in trayicon.pas you go as normal 

uses WSTrayIcon; //etc. you DON'T include GtkWSTrayIcon here!

TCustomTrayIcon = class(TWinControl)
public
 procedure EmbedControl;
....
end;

...
procedure TTrayIcon.EmbedControl;
begin
 TWSTrayIconClass(WidgetSetClass).EmbedControl(Self);

end;

This document is work in progress. You can help by writing sections of this document. If you cannot find the information you are looking for in this document, please add your question to the discussion page. This will help us to write documentation at a level that is neither too simple nor too complicated, and fully cover the areas that people want to know about.

Retrieved from "http://wiki.freepascal.org/index.php?title=LCL_Internals/ru&oldid=125456"