Sign in Join
Wiki copytemporary

LCL Internals/ru: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
11## Другие интерфейсы
22
33- [[Lazarus known issues (things that will never be fixed)]] - Список проблем совместимости интерфейса
44- [[Win32/64 Interface]] - Интерфейс winapi для Windows 95/98/Me/2K/XP/Vista, но не для CE
55- [[Windows CE Interface]] - Для карманных ПК и смартфонов
66- [[Carbon Interface]] - Интерфейс Carbon для macOS
77- [[Cocoa Interface]] - Интерфейс Cocoa для macOS
88- [[Qt Interface]] - Интерфейс Qt4 для Unix, macOS, Windows и КПК на базе Linux
99- [[Qt5 Interface]] - Интерфейс Qt5 для Unix, macOS, Windows и КПК на базе Linux
1010- [[GTK1 Interface]] - Интерфейс gtk1 для Unix, macOS (X11), Windows
1111- [[GTK2 Interface]] - Интерфейс gtk2 для Unix, macOS (X11), Windows
1212- [[GTK3 Interface]] - Интерфейс gtk3 для Unix, macOS (X11), Windows
1313- [[fpGUI Interface]] - Основан на библиотеке fpGUI, которая представляет собой кроссплатформенный инструментарий, полностью написанный на Object Pascal
1414- [[Custom Drawn Interface]] - Кроссплатформенный бэкэнд LCL, написанный полностью на Object Pascal внутри Lazarus. Интерфейс Lazarus для Android.
1515
1616### Советы для конкретных платформ
1717
1818- [[Windows Programming Tips]] - Cоветы по программированию на desktop-Windows.
1919- [[Linux Programming Tips]] - Как выполнять определенные задачи программирования в Linux
2020- [[macOS Programming Tips]] - Советы по Lazarus, полезные инструменты, команды Unix и многое другое ...
2121- [[WinCE Programming Tips]] - Использование телефонного API, отправка SMS-сообщений и многое другое ...
2222- [[Android Programming]] - Для Android смартфонов и планшетов
2323- [[iPhone/iPod development]] - Об использовании Objective Pascal для разработки приложений для iOS
2424
2525### Статьи по разработке интерфейсов
2626
2727- [[Carbon interface internals]] - Если вы хотите помочь улучшить интерфейс Carbon
2828- [[Windows CE Development Notes]] - Для карманных ПК и смартфонов
2929- [[Adding a new interface]] - Как добавить новый интерфейс набора виджетов
3030- [[LCL Defines]] - Выбор правильных опций для перекомпиляции LCL
3131- [[LCL Internals]] - Некоторая информация о внутренней работе LCL
3232- [[Cocoa Internals]] - Некоторая информация о внутренней работе виджета Cocoa
3333
3434## Минимальные версии Toolkit
3535
3636| Lazarus version | Мин. FPC | Мин. Gtk 2 | Мин. Qt 4 | Мин. Windows | Мин. Windows CE | Мин. macOS (Carbon) | Мин. macOS (Cocoa) | Мин. треб. LCL-CustomDrawn |
3737|----|----|----|----|----|----|----|----|----|
3838| 0.9.24 | 2.2.0 | 2.6+ | 4.2+ | Windows 98+ | Рекомендуется 4.0+ | 10.4 | N/A | N/A |
3939| 0.9.26 | 2.2.2 | 2.6+ | 4.3+ | Windows 98+ | Рекомендуется 4.0+ | 10.4 | N/A | N/A |
4040| 0.9.28 | 2.2.4 | 2.8+ | 4.5+ | Windows 98+ | Рекомендуется 4.0+ | 10.4 | N/A | N/A |
4141| 0.9.30 | 2.4.0 | 2.8+ | 4.5+ | Windows 98+ | Рекомендуется 5.0+ | 10.4 | N/A | N/A |
4242| 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 10.6+ |
4343| 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 10.6+ |
4444
4545- \- На самом деле 4.5.0 ... 4.8.4 с предварительно собранным Qt4Pas.dll, 4.8.5+ требует другого Qt4Pas.dll
4646
4747См.также: [[Installing Lazarus on MacOS X/ru|совместимость]]
4848
4949## Внутренности LCL
5050
5151Есть LCL и есть «интерфейс». LCL - это часть, которая не зависит от платформы и находится в каталоге lazarus/lcl/. Этот каталог содержит в основном определения классов. Многие различные элементы управления фактически реализованы в каталоге lazarus/lcl/include/ в различных файлах .inc. Это делается для того, чтобы быстрее найти реализацию определенного элемента управления, например TCustomMemo (который находится в custommemo.inc). Каждый .inc начинается со строки {% MainUnit ...}, чтобы определить, где он включен.
5252
5353Также есть «интерфейс», который находится в подкаталоге каталога 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.
5454
5555Каждый элемент управления имеет свойство WidgetSetClass, принадлежащее "зеркальному" классу в каталоге интерфейсов, например: "зеркало" для TCustomEdit - это TWSCustomEdit, методы которого реализуются TWin32WSCustomEdit в win32wsstdctrls. Это способ, которым LCL взаимодействует с интерфейсом, и то, как он позволяет интерфейсу делать свое дело.
5656
5757Передача интерфейса обратно в LCL в основном осуществляется путем отправки сообщений, обычно 'DeliverMessage', который вызывает TControl.Perform (\<message_id\>, wparam, lparam), где wparam и lparam являются дополнительной информацией для сообщения.
5858
5959### Pie и RadialPie
6060
6161Модуль LCLIntf содержит две функции для рисования округлых фигур:
6262
6363`function `[[doc:lcl/lclintf/pie.html|Pie]]`(DC: HDC; x1, y1, x2, y2, sx, sy, ex, ey: Integer): Boolean;`\
6464`function `[[doc:lcl/lclintf/radialpie.html|RadialPie]]`(DC: HDC; x1, y1, x2, y2, Angle1, Angle2: Integer): Boolean; `
6565
6666Функция Pie использует две точки (sx,sy) и (ex,ey) для указания начала и конца дуги. RadialPie использует углы, чтобы указать начало и конец дуги.
6767
6868Pie вызывает TWidgetSet.Pie, а RadialPie вызывает TWidgetSet.RadialPie. Реализация TWidgetSet.Pie по умолчанию заключается в преобразовании параметров в углы и вызове TWidgetSet.RadialPie. TWidgetSet.RadialPie создает массив точек для дуги и вызывает TWidgetSet.Polygon.
6969
7070Набор виджетов win32 переопределяет TWidgetSet.Pie для непосредственного вызова функции Windows Pie.
7171
7272> **Note:** в более старых версиях Lazarus существовал RadialPie с углами, которые делали то же, что и нынешние RadialPie и RadialPie, которые делают то же самое, что и наша \[функция\] Pie. Эти функции были удалены в Lazarus 0.9.21.
7373
7474### Интерфейсы
7575
7676См. [[LCL Internals/ru|другие интерфейсы]]
7777
7878### Добавление нового модуля в LCL
7979
8080Сначала добавьте новое имя модуля в allclunits.pp.
8181
8282Чтобы убедиться, что модуль зарегистрирован в палитре компонентов, смотрите файлы RegisterLCL.pas и pkgfileslcl.inc, они расположены в lazarus/packager.
8383
8484## Как создать новый Widgetset
8585
8686Это пошаговое руководство по разработке нового [[Widgetset|widgetset]]. Он основан на моем опыте создания основ нового интерфейса qt4.
8787
8888Для начала, почему кто-то хочет добавить Widgetset? Ответ заключается в том, чтобы иметь возможность портировать существующее программное обеспечение Lazarus на большее количество платформ без изменения их кода.
8989
9090Итак, давайте напишем набор виджетов. Прежде всего, вам нужно иметь паскаль привязки для виджета и знать, как его использовать. Обычно это не сложно. Несколько часов работы с основными учебными пособиями, доступными в Интернете, должны быть достаточными для начала. Если привязки еще не существуют, их нужно создать. Если учебные пособия написаны на другом языке, переведите их на паскаль и заставьте их работать.
9191
9292Теперь для Qt я использовал привязки Den Jean qt4 для паскаля и создал очень простую программу Qt, используя их:
9393
9494``` pascal
9595program qttest;
9696
9797uses qt4;
9898
9999var
100100 App: QApplicationH;
101101 MainWindow: QMainWindowH;
102102begin
103103 App := QApplication_Create(@argc,argv);
104104
105105 MainWindow := QMainWindow_Create;
106106
107107 QWidget_show(MainWindow);
108108
109109 QApplication_Exec;
110110end.
111111```
112112
113113Вышеуказанный проект компилируется и создает программу qt4. Теперь мы будем использовать его код для написания нового набора виджетов. После того, как мы закончим, приведенная ниже программа lazarus прекрасно скомпилируется в программу qt4:
114114
115115``` pascal
116116program qttest;
117117
118118{$mode objfpc}{$H+}
119119
120120uses
121121 Interfaces, Classes, Forms,
122122 { Add your units here }
123123 qtform;
124124
125125begin
126126 Application.Initialize;
127127 Application.CreateForm(TForm1, Form1);
128128 Application.Run;
129129end.
130130```
131131
132132где форма поддерживается Lazarus IDE и разрабатывается визуально.
133133
134134Первое, что нужно сделать с новым набором виджетов, это добавить пустой скелет для него. Очень ранние наборы виджетов разработки, такие как qt и carbon, могут служить скелетом.
135135
136136Просматривая файлы на многих виджетах, вы можете увидеть первый файл, который будет вызван lcl: Interfaces.pas. Этот файл просто вызывает другой файл с именем QtInt.pas или аналогичный. QtInt.pas содержит код для класса TWidgetSet, который мы должны реализовать. На пустом скелете вы можете видеть, что у класса есть различные функции, которые он должен реализовать:
137137
138138``` pascal
139139 TQtWidgetSet = Class(TWidgetSet)
140140 private
141141 App: QApplicationH;
142142 public
143143 {$I qtwinapih.inc}
144144 {$I qtlclintfh.inc}
145145 public
146146 // Application
147147 procedure AppInit(var ScreenInfo: TScreenInfo); override;
148148 procedure AppRun(const ALoop: TApplicationMainLoop); override;
149149 procedure AppWaitMessage; override;
150150 procedure AppProcessMessages; override;
151151 procedure AppTerminate; override;
152152 procedure AppMinimize; override;
153153 procedure AppBringToFront; override;
154154 public
155155 constructor Create;
156156 destructor Destroy; override;
157157 function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
158158 procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
159159 procedure DCRedraw(CanvasHandle: HDC); override;
160160 procedure SetDesigning(AComponent: TComponent); override;
161161
162162 function InitHintFont(HintFont: TObject): Boolean; override;
163163
164164 // create and destroy
165165 function CreateComponent(Sender : TObject): THandle; override; // deprecated
166166 function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): integer; override;
167167 function DestroyTimer(TimerHandle: integer): boolean; override;
168168 end;
169169```
170170
171171### Как реализовать новый оконный компонент
172172
173173Все оконные компоненты являются потомками TWinControl. Эти элементы управления имеют дескриптор и поэтому должны создаваться набором виджетов. Добавлять новые оконные компоненты в набор виджетов \[довольно\] легко.
174174
175175Допустим, вы хотите добавить TQtWSCustomEdit в Qt Widgetset. \[Нужно\] начать с TCustomEdit, \[который\] является потомком TWinControl и находится в модуле StdCtrls.
176176
177177Теперь перейдите к модулю QtWSStrCtrls и найдите объявление TQtWSCustomEdit.
178178
179179``` pascal
180180 TQtWSCustomEdit = class(TWSCustomEdit)
181181 private
182182 protected
183183 public
184184 end;
185185```
186186
187187Добавьте статические методы, объявленные в TWSCustomEdit, и переопределите их. Код должен теперь выглядеть так:
188188
189189``` pascal
190190 TQtWSCustomEdit = class(TWSCustomEdit)
191191 private
192192 protected
193193 public
194194 class function CreateHandle(const AWinControl: TWinControl;
195195 const AParams: TCreateParams): HWND; override;
196196 class procedure DestroyHandle(const AWinControl: TWinControl); override;
197197{ class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
198198 class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
199199
200200 class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
201201 class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
202202 class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
203203 class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
204204 class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
205205 class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
206206 class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
207207
208208 class procedure GetPreferredSize(const AWinControl: TWinControl;
209209 var PreferredWidth, PreferredHeight: integer); override;}
210210 end;
211211```
212212
213213Закомментированная часть кода - это процедуры, которые необходимо реализовать, чтобы TCustomEdit был полностью функциональным, но достаточно просто \[наличия\] CreateHandle и DestroyHandle, чтобы он отображался в форме и был редактируемым, поэтому он соответствует нашим потребностям в этой статье.
214214
215-Нажмите <span class="kbd">Ctrl</span>+<span class="kbd">Shift</span>+<span class="kbd">C</span>, чтобы завершить код и реализовать CreateHandle и DestroyHandle. В случае Qt4 код будет таким:
215+Нажмите `Ctrl`+`Shift`+`C`, чтобы завершить код и реализовать CreateHandle и DestroyHandle. В случае Qt4 код будет таким:
216216
217217``` pascal
218218{ TQtWSCustomEdit }
219219
220220class function TQtWSCustomEdit.CreateHandle(const AWinControl: TWinControl;
221221 const AParams: TCreateParams): HWND;
222222var
223223 Widget: QWidgetH;
224224 Str: WideString;
225225begin
226226 // Создаем виджет
227227 WriteLn('Calling QTextDocument_create');
228228 Str := WideString((AWinControl as TCustomMemo).Lines.Text);
229229 Widget := QTextEdit_create(@Str, QWidgetH(AWinControl.Parent.Handle));
230230
231231 //Задаем его начальные свойства
232232 QWidget_setGeometry(Widget, AWinControl.Left, AWinControl.Top,
233233 AWinControl.Width, AWinControl.Height);
234234
235235 QWidget_show(Widget);
236236
237237 Result := THandle(Widget);
238238end;
239239
240240class procedure TQtWSCustomEdit.DestroyHandle(const AWinControl: TWinControl);
241241begin
242242 QTextEdit_destroy(QTextEditH(AWinControl.Handle));
243243end;
244244```
245245
246246Теперь раскомментируйте строку "RegisterWSComponent (TCustomEdit, TQtWSCustomEdit);" в конце модуля и ... все!
247247
248248Теперь вы можете поместить TCustomEdit внизу формы и ожидать, что он будет работать. :^)
249249
250250### Реализация TBitmap
251251
252252Для реализации TBitmap необходимо понимать TRawImage и TLazIntfImage, как описано здесь: [[Developing with Graphics|Developing with Graphics#Working with TLazIntfImage.2C TRawImage and TLazCanvas]]
253253
254254Итак, допустим, вы хотите скомпилировать следующий код:
255255
256256``` pascal
257257procedure TMyForm.HandleOnPaint(Sender: TObject);
258258var
259259 Bitmap: TBitmap;
260260begin
261261 Bitmap := TBitmap.Create;
262262 try
263263 Bitmap.LoadFromFile('myfile.bmp');
264264 Canvas.Draw(0, 0, Bitmap);
265265 finally
266266 Bitmap.Free;
267267 end;
268268end;
269269```
270270
271271Ниже приведен порядок вызова функций из интерфейса widgetset при выполнении этого кода:
272272
273273` 1 - BeginPaint`
274274
275275Это будет вызвано только, если событие OnPaint отправляет ноль в качестве DC для события рисования
276276
277277` 2 - GetDC(0);`
278278
279279Просто создает контекст устройства.
280280
281281` 3 - TCDWidgetSet.RawImage_QueryDescription `
282282
283283Реализация этой процедуры по умолчанию подходит для большинства наборов виджетов.
284284
285285` 4 - TCDWidgetSet.RawImage_CreateBitmaps`
286286
287287Здесь вам нужно создать собственный объект изображения и загрузить его из RawData.Data, где хранится информация на основе вашего описания формата пикселя в пункте 2.
288288
289289` 5 - CreateCompatibleDC(0)`
290290
291291Это создает временный DC только для хранения изображения, но на данный момент нет информации об изображении, поэтому в этот момент этот DC действительно фиктивный
292292
293293` 6 - SelectObject`
294294
295295С изображением в качестве объекта, который будет выбран, и DC, созданный выше, в качестве целевого DC.
296296
297297` 7 - StretchMaskBlt`
298298
299299Наконец, функция рисования! DestDC - это DC, размещенный на BeginPaint.
300300
301301` 8 - EndPaint`
302302
303303Опять же, не всегда используется.
304304
305305### TBitmap.LoadFromDevice для снятия скриншота
306306
307307Рекомендуется сначала реализовать Bitmap, прежде чем делать этот шаг.
308308
309309В LCL вы можете использовать следующий код, делающий скриншот со всего экрана и рисующий его на холсте:
310310
311311``` pascal
312312var
313313 ScreenDC: HDC;
314314 Bitmap: TBitmap;
315315begin
316316 Bitmap := TBitmap.Create;
317317 try
318318 ScreenDC := GetDC(0);
319319 Bitmap.LoadFromDevice(ScreenDC);
320320 ReleaseDC(0, ScreenDC);
321321 Canvas.Draw(0, 0, Bitmap);
322322 finally
323323 Bitmap.Free;
324324 end;
325325end;
326326```
327327
328328Если вы уже внедрили TBitmap, для LoadFromDevice нужно реализовать только 2 новые функции: GetDeviceSize и GetRawImageFromDevice
329329
330330Ниже приведен большой трейс, охватывающий все функции набора виджетов, вызываемые для события OnPaint, которое делает снимок экрана и рисует его на экране. Эта трассировка была сделана с помощью набора виджетов Qt и может иметь некоторые недостатки. Номера дескрипторов должны использоваться для проверки того, какой объект используется в функциях.
331331
332332 [WinAPI BeginPaint] Result=-1220713544
333333 [WinAPI GetClientBounds]
334334 [WinAPI SetWindowOrgEx] DC: -1220713544 NewX: 0 NewY: 0
335335
336336``` pascal
337337//Входим в событие OnPaint
338338Bitmap := TBitmap.Create;
339339try
340340 ScreenDC := GetDC(0);
341341```
342342
343343 [WinAPI GetDC] hWnd: 0 Result: -1220712920
344344
345345``` pascal
346346Bitmap.LoadFromDevice(ScreenDC);
347347```
348348
349349` [WinAPI GetDeviceSize]`\
350350` [WinAPI GetRawImageFromDevice] SrcDC: -1220712920 SrcWidth: 0 SrcHeight: 0`\
351351` [WinAPI CreateBitmapFromRawImage] Width:1024 Height:768 DataSize: 3145728 CreateMask: False Bitmap:-1220746696`\
352352` [WinAPI GetObject] GDIObj: -1220746696 Result=84 ObjectType=Image`
353353
354354``` pascal
355355 ReleaseDC(0, ScreenDC);
356356```
357357
358358 [WinAPI ReleaseDC] hWnd: 0 DC: -1220712920
359359
360360``` pascal
361361Canvas.Draw(0, 0, Bitmap);
362362```
363363
364364` [WinAPI CreateCompatibleDC] DC: 0`\
365365` [WinAPI GetDC] hWnd: 0 Result: -1220712920`\
366366` [WinAPI SelectObject] DC=-1220712920 GDIObj=-1220746696 Result=0 ObjectType=Image`\
367367` [WinAPI StretchMaskBlt] DestDC:-1220713544 SrcDC:-1220712920 Image:137185120 X:0 Y:0 W:1024 H:768 XSrc:0 YSrc:0 WSrc:1024 HSrc:768`
368368
369369``` pascal
370370finally
371371 Bitmap.Free;
372372end;
373373```
374374
375375` [WinAPI SelectObject] DC=-1220712920 GDIObj=0 Invalid GDI Object`\
376376` [WinAPI DeleteObject] GDIObject: -1220746696 Result=False ObjectType=Image`
377377
378378``` pascal
379379//Здесь мы вышли из события OnPaint
380380```
381381
382382` [WinAPI DeleteObject] GDIObject: 0`\
383383` [WinAPI DeleteObject] GDIObject: 0`\
384384` [WinAPI DeleteObject] GDIObject: 0`\
385385` [WinAPI DeleteObject] GDIObject: 0`\
386386` [WinAPI SetWindowOrgEx] DC: -1220713544 NewX: -152 NewY: -246`\
387387` [WinAPI DeleteObject] GDIObject: 0`\
388388` [WinAPI DeleteObject] GDIObject: 0`\
389389` [WinAPI DeleteObject] GDIObject: 0`\
390390` [WinAPI DeleteObject] GDIObject: 0`\
391391` TWidgetSet.InitializeCriticalSection`\
392392` TWidgetSet.EnterCriticalSection`\
393393` [WinAPI SelectObject] DC=-1220713544 GDIObj=0 Invalid GDI Object`\
394394` [WinAPI MoveToEx] DC:-1220713544 X:0 Y:0`\
395395` [WinAPI SelectObject] DC=-1220713544 GDIObj=-1220746760 Result=-1220746856 ObjectType=Brush`\
396396` [WinAPI SelectObject] DC=-1220713544 GDIObj=-1220746856 Result=-1220746856 ObjectType=Brush`\
397397` TWidgetSet.LeaveCriticalSection`\
398398` [WinAPI SetWindowOrgEx] DC: -1220713544 NewX: 0 NewY: 0`\
399399` [WinAPI EndPaint] Handle: -1220611768 PS.HDC: -1220713544`
400400
401401### Реализация рисования в событии OnPaint формы или другого элемента управления
402402
403403Для рисования в событии OnPaint формы само событие приходит из библиотеки лежащих в основе виджетов. Интерфейс LCL должен обработать это событие и создать соответствующий объект DC в обработчике событий, а затем вызвать LCLSendPaintMsg. Кроме того, следует также реализовать соответствующие методы рисования, такие как Rectangle или ExtTextOut. Также могут быть полезны процедуры, связанные с Pen(перо), Brush(кисть) и Font(шрифт).
404404
405405Вот обработчик события OnPaint из набора виджетов Cocoa, который показывает, как он вызывает LCLSentPaintMsg:
406406
407407``` pascal
408408procedure TLCLCommonCallback.Draw(ControlContext: NSGraphicsContext;
409409 const bounds, dirty:NSRect);
410410var
411411 struct : TPaintStruct;
412412begin
413413 if not Assigned(Context) then Context:=TCocoaContext.Create;
414414
415415 Context.ctx:=ControlContext;
416416 if Context.InitDraw(Round(bounds.size.width), Round(bounds.size.height)) then
417417 begin
418418 FillChar(struct, SizeOf(TPaintStruct), 0);
419419 struct.hdc := HDC(Context);
420420 {$IFDEF VerboseWinAPI}
421421 DebugLn(Format('[TLCLCommonCallback.Draw] OnPaint event started context: %x', [HDC(context)]));
422422 {$ENDIF}
423423 LCLSendPaintMsg(Target, HDC(Context), @struct);
424424 {$IFDEF VerboseWinAPI}
425425 DebugLn('[TLCLCommonCallback.Draw] OnPaint event ended');
426426 {$ENDIF}
427427 end;
428428end;
429429```
430430
431431И список подпрограмм WinAPI, которые были вызваны при запуске этого события:
432432
433433` [TCocoaWidgetSet.GetDC] hWnd: 0 Result: 12400C0`\
434434` [TLCLCommonCallback.Draw] OnPaint event started context: 1240340`\
435435` TCocoaWidgetSet.CreatePenIndirect`\
436436` TCocoaWidgetSet.SelectObject DC: 1240340 GDIObj: 10EC460`\
437437` TCocoaWidgetSet.SelectObject Result: 0`\
438438` TCocoaWidgetSet.SelectObject DC: 1240340 GDIObj: 10EBF00`\
439439` TCocoaWidgetSet.SelectObject Result: 0`\
440440` [TCocoaWidgetSet.Rectangle] DC: 1240340 X1: 100 Y1: 100 X2: 200 Y2: 200`\
441441` TCocoaWidgetSet.SelectObject DC: 1240340 GDIObj: 10EC4A0`\
442442` TCocoaWidgetSet.SelectObject Result: 0`\
443443` [TCocoaWidgetSet.GetTextExtentPoint] DC: 1240340 Str: Some text Count: 9`\
444444` [TCocoaWidgetSet.GetTextExtentPoint] Size: 65,17`\
445445` [TLCLCommonCallback.Draw] OnPaint event ended`
446446
447447### Внедрение TLabel
448448
449449Внедрить TLabel особенно сложно, несмотря на то, что он является этаким базовым компонентом, потому что это требует, чтобы была реализована почти вся отрисовка. TLabel не является оконным элементом управления, вместо этого он зависит от сообщений отрисовки, рисующих \[компонент\] непосредственно на холсте формы.
450450
451451Прежде чем пытаться заставить работать TLabel, рекомендуется проверить, работают ли функции рисования, такие как Rectangle, внутри события OnPaint формы.
452452
453453Необходимо реализовать несколько методов WinAPI, в частности:
454454
455455**Методы контекста устройства**
456456
457457BeginPaint, GetDC, EndPaint, ReleaseDC, CreateCompatibleDC
458458
459459см. [[Device Contexts and GDI objects in the LCL interfaces|Контексты устройств и объекты GDI в интерфейсах LCL]]
460460
461461**Методы объектов GDI**
462462
463463SelectObject, DeleteObject, CreateFontIndirect, CreateFontIndirectEx
464464
465465**Разные функции**
466466
467467InvalidateRect, GetClientBounds, SetWindowOrgEx
468468
469469**Методы рисования текста**
470470
471-DrawText.</br>Вместо реализации DrawText можно также использовать стандартный TWidgetSet.DrawText, как это делают наборы виджетов Carbon и Cocoa. Но в этом случае необходимо, чтобы каждый реализовывал хотя бы GetTextMetrics, GetTextExtentPoint и ExtTextOut. Без GetTextMetrics форма с TLabel рухнет, потому что авторазмер не сможет рассчитать подходящий размер для TLabel.
471+DrawText.Вместо реализации DrawText можно также использовать стандартный TWidgetSet.DrawText, как это делают наборы виджетов Carbon и Cocoa. Но в этом случае необходимо, чтобы каждый реализовывал хотя бы GetTextMetrics, GetTextExtentPoint и ExtTextOut. Без GetTextMetrics форма с TLabel рухнет, потому что авторазмер не сможет рассчитать подходящий размер для TLabel.
472472
473473**Функции Region для определения, что элемент управления находится за другим**
474474
475475CombineRgn, CreateRectRgn, GetClipRGN, RectVisible
476476
477477Ниже приведен порядок вызова процедур рисования в форме с одним TLabel, чтобы лучше понять последовательность рисования:
478478
479479 1 - GetDC вызывается один раз при запуске программного обеспечения с hWnd = 0
480480 2 - Показывается форма
481481 3 - GetDC вызывается снова (это не произошло бы без TLabel). Вызывается несколько функций, связанных со шрифтами, а также DrawText с CalcRect, установленным в True, чтобы вычислить размер TLabel.
482482 4 - InvalidateRect вызывается на холсте формы
483483 5 - Управление возвращается к операционной системе до тех пор, пока из набора виджетов не придет сообщение отрисовки
484484 6 - Вызывается BeginPaint, и в этот момент будет выполнен код в событии OnPaint формы
485485 7 - DrawText вызывается снова с CalcRect установленным в false
486486 8 - Отрисовка закончена
487487
488488### Реализация видимости для форм и элементов управления и состояния окна
489489
490490Код, который управляет видимостью, разделен между видимостью для форм и для элементов управления.
491491
492492#### Видимость для форм и состояния окна
493493
494494Эта часть также управляет состоянием окна (свернуто, развернуто или нормально). Это реализовано как копия функции Windows API ShowWindow, поэтому вы должны реализовать TMyWidgetset.ShowWindow в файле mywinapi.inc. Не забудьте также добавить заголовок в файл mywinapih.inc.
495495
496496Ниже приведен код, который реализует эту функцию в наборе виджетов Qt. Это должно \[помочь\] очень легко понять, скопировать и реализовать его на вашем собственном виджете. Вы также можете посмотреть, как это реализует Gtk. В Windows, конечно, API Windows вызывается напрямую, поэтому нет кода, на котором его можно \[продемонстрировать\].
497497
498498``` pascal
499499{------------------------------------------------------------------------------
500500 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
501501
502502 nCmdShow:
503503 SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
504504------------------------------------------------------------------------------}
505505function TQtWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
506506var
507507 Widget: QWidgetH;
508508begin
509509 {$ifdef VerboseQtWinAPI}
510510 WriteLn('WinAPI ShowWindow');
511511 {$endif}
512512
513513 Result := False;
514514
515515 Widget := QWidgetH(hWnd);
516516
517517// if Widget = nil then RaiseException('TQtWidgetSet.ShowWindow hWnd is nil');
518518
519519 case nCmdShow of
520520 SW_SHOW: QWidget_setVisible(Widget, True);
521521 SW_SHOWNORMAL: QWidget_showNormal(Widget);
522522 SW_MINIMIZE: QWidget_setWindowState(Widget, QtWindowMinimized);
523523 SW_SHOWMINIMIZED: QWidget_showMinimized(Widget);
524524 SW_SHOWMAXIMIZED: QWidget_showMaximized(Widget);
525525 SW_HIDE: QWidget_setVisible(Widget, False);
526526 end;
527527
528528 Result := True;
529529end;
530530```
531531
532532#### Видимость для элементов управления
533533
534534Для элементов управления внутри формы вам необходимо реализовать функцию класса TMyWSWinControl.ShowHide, которая находится в классе TMyWSWinControl в файле mywscontrols.pp
535535
536536Помните, что большинство элементов управления наследуются от TWinControl, поэтому реализация этой функции гарантирует, что свойство Visible реализовано для всех стандартных элементов управления, которые его имеют. Ниже приведен пример кода для набора виджетов Qt.
537537
538538``` pascal
539539{------------------------------------------------------------------------------
540540 Method: TQtWSWinControl.ShowHide
541541 Params: AWinControl - the calling object
542542
543543 Returns: Nothing
544544
545545 Shows or hides a widget.
546546 ------------------------------------------------------------------------------}
547547class procedure TQtWSWinControl.ShowHide(const AWinControl: TWinControl);
548548begin
549549 if AWinControl = nil then exit;
550550
551551 if not AWinControl.HandleAllocated then exit;
552552
553553 if AWinControl.HandleObjectShouldBeVisible then
554554 QWidget_setVisible(TQtWidget(AWinControl.Handle).Widget, True)
555555 else QWidget_setVisible(TQtWidget(AWinControl.Handle).Widget, False);
556556end;
557557```
558558
559559### Реализация компонентов на основе TStrings
560560
561561Некоторые компоненты используют TStrings для хранения отображаемой информации, например: TCustomMemo, TCustomListBox и TCustomComboBox.
562562
563563Для их реализации недостаточно просто реализовать их функции, например, в классе TQtCustomMemo. Одна из реализуемых функций будет называться GetStrings и выглядеть следующим образом:
564564
565565``` pascal
566566class function TQtWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
567567var
568568 ListWidgetH: QListWidgetH;
569569begin
570570 ListWidgetH := QListWidgetH((TQtWidget(ACustomListBox.Handle).Widget));
571571 Result := TQtListStrings.Create(ListWidgetH, ACustomListBox);
572572end;
573573```
574574
575575Эта функция должна возвращать потомок TStrings, предназначенный для отслеживания, что строки добавляются или удаляются из списка, и отправлять эту информацию в набор виджетов для обновления элемента управления. Например, следующее объявление показывает, как выглядит TQtListStrings:
576576
577577``` pascal
578578 TQtListStrings = class(TStrings)
579579 private
580580 FListChanged: Boolean; // StringList и QtListWidget не синхронизированы
581581 FStringList: TStringList; // Содержит пункты для показа
582582 FQtListWidget: QListWidgetH; // Qt Widget
583583 FOwner: TWinControl; // Lazarus'овский владелец элементов управления ListStrings
584584 FUpdating: Boolean; // Мы меняем Qt Widget
585585 procedure InternalUpdate;
586586 procedure ExternalUpdate(var Astr: TStringList; Clear: Boolean = True);
587587 procedure IsChanged; // событие OnChange, вызваемое действием программы
588588 protected
589589 function GetTextStr: string; override;
590590 function GetCount: integer; override;
591591 function Get(Index : Integer) : string; override;
592592 //procedure SetSorted(Val : boolean); virtual;
593593 public
594594 constructor Create(ListWidgetH : QListWidgetH; TheOwner: TWinControl);
595595 destructor Destroy; override;
596596 procedure Assign(Source : TPersistent); override;
597597 procedure Clear; override;
598598 procedure Delete(Index : integer); override;
599599 procedure Insert(Index : integer; const S: string); override;
600600 procedure SetText(TheText: PChar); override;
601601 //procedure Sort; virtual;
602602 public
603603 //property Sorted: boolean read FSorted write SetSorted;
604604 property Owner: TWinControl read FOwner;
605605 function ListChangedHandler(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
606606 end;
607607```
608608
609609Вы можете увидеть его реализацию в модуле qtobjects.pas интерфейса qt.
610610
611611### Реализация меню
612612
613613Меню доступны на LCL для создания основных меню или всплывающих меню. TMenu является владельцем более крупной структуры меню со многими пунктами. Элементы могут иметь подэлементы, и не нуждаются в дополнительном TMenus.
614614
615615Также помните, что в LCL дескриптор создается только при необходимости, и в это время все свойства элементов управления уже инициализированы. Это очень помогает для наборов виджетов, где в зависимости от свойств элемента меню он может принадлежать к одному или другому классу, например, Qt.
616616
617617Следующие вещи должны быть реализованы для того, чтобы меню работали:
618618
6196191\) Все методы модуля QtWSMenus, которые будут реализовывать создание и изменение меню
620620
6216212\) функция `TWinCEWidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;` из файла wincewinapi.inc, в котором будет реализована поддержка главного меню, связанного с окном.
622622
623623#### Порядок создания меню
624624
625625При реализации меню важно понимать, в каком порядке они создаются. Например, мы хотим создать следующую структуру меню:
626626
627-<figure>
628-<img src="Menu_creation_order.png" title="Menu_creation_order.png" />
629-<figcaption>Menu_creation_order.png</figcaption>
630-</figure>
627+![](/wiki-images/6/69/Menu_creation_order.png)
631628
632629И когда наше приложение будет выполнено, при каждом вызове TQtWSMenuItem.CreateHandle будет появляться сообщение 'Creating MenuItem'(Создание MenuItem) с заголовком меню и сообщение 'Creating Menu'(Создание меню) с названием меню (потомки TMenu не имеют подпись), каждый раз, когда вызывается TQtWSMenu.CreateHandle.
633630
634631Вот результирующий вывод такого программного обеспечения:
635632
636633` Creating Menu. Name: MainMenu1`\
637634` Creating MenuItem: Item1           Parent=Menu.Items : TMenuItem`\
638635` Creating MenuItem: SubItem11       Parent=Item1      : TMenuItem`\
639636` Creating MenuItem: SubItem12       Parent=Item1      : TMenuItem`\
640637` Creating MenuItem: SubItem13       Parent=Item1      : TMenuItem`\
641638` Creating MenuItem: SubItem14       Parent=Item1      : TMenuItem`\
642639` Creating MenuItem: SubSubItem141   Parent=SubItem14  : TMenuItem`\
643640` Creating MenuItem: SubSubItem142   Parent=SubItem14  : TMenuItem`\
644641` Creating MenuItem: SubSubItem143   Parent=SubItem14  : TMenuItem`\
645642` Creating MenuItem: SubSubItem144   Parent=SubItem14  : TMenuItem`\
646643` Creating MenuItem: Item2           Parent=Menu.Items : TMenuItem`\
647644` Creating MenuItem: SubItem21       Parent=Item2      : TMenuItem`\
648645` Creating MenuItem: SubItem22       Parent=Item2      : TMenuItem`\
649646` Creating MenuItem: SubItem23       Parent=Item2      : TMenuItem`\
650647` Creating MenuItem: Item3           Parent=Menu.Items : TMenuItem`\
651648` Creating MenuItem: Item4           Parent=Menu.Items : TMenuItem`
652649
653650Для всех MenuItems можно использовать GetParentMenu, чтобы получить владельца их родителя: Menu (TMainMenu).
654651
655652### Включение/отключение элемента управления
656653
657654Текущий способ установить включение/отключение элемента управления - реализация winapi EnableWindow. Этот API должен работать в общем на любом элементе управления. Он должен включать/отключать ввод с помощью мыши и клавиатуры для указанного окна или элемента управления, а также помечать его как недоступный для редактирования пользователем, например, делая его серым.
658655
659656``` pascal
660657{------------------------------------------------------------------------------
661658 Method: EnableWindow
662659 Params: HWnd - handle to window / дескриптор окна
663660 BEnable - whether to enable the window / нужно ли включать окно
664661 Returns: If the window was previously disabled / возращаемый результат: если окно было ранее отключено
665662
666663 Enables or disables mouse and keyboard input to the specified window or
667664 control / Включает или отключает ввод с клавиатуры и мыши в указанное окно или
668665  элемент управления
669666 ------------------------------------------------------------------------------}
670667function TWin32WidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
671668```
672669
673670### Фигурные окна
674671
675672Окна могут быть сформированы на основе растрового изображения (TBitmap) или региона(TRegion). Регион является видимой частью
676673
677674Чтобы реализовать фигурные окна на основе TBitmap, реализуйте TWSWinControl.setShape
678675
679676Для реализации фигурных окон на основе TRegion реализуйте LCLIntf.SetWindowRgn
680677
681678См.также: [[LCL Tips/ru|Создание не прямоугольных окон или элементов управления]]
682679
683680### Системные цвета
684681
685682Некоторые константы цвета на самом деле являются системными цветами, такими как clBtnFace, clForm, clWindow и проч. и проч.
686683
687684Для реализации поддержки системных цветов должна быть реализована подпрограмма WinAPI GetSysColor:
688685
689686``` pascal
690687function GetSysColor(nIndex: Integer): DWORD; override;
691688```
692689
693690А вот фрагмент цветовых констант, которые должны поддерживаться. Проверьте LCLType для последних значений:
694691
695692``` pascal
696693//==============================================
697694// API system Color constants pbd
698695// note these are usually shown ORed with
699696// $80000000 as these would have interfered with
700697// other MS color enumerations
701698// GetSysColor and SetSysColor expects the values
702699// below
703700//==============================================
704701
705702type
706703 COLORREF = LongInt;
707704 TColorRef = COLORREF;
708705
709706const
710707 CLR_INVALID = TColorRef($FFFFFFFF);
711708
712709 COLOR_SCROLLBAR = 0;
713710 COLOR_BACKGROUND = 1;
714711 COLOR_ACTIVECAPTION = 2;
715712 COLOR_INACTIVECAPTION = 3;
716713 COLOR_MENU = 4;
717714 COLOR_WINDOW = 5;
718715 COLOR_WINDOWFRAME = 6;
719716 COLOR_MENUTEXT = 7;
720717 COLOR_WINDOWTEXT = 8;
721718 COLOR_CAPTIONTEXT = 9;
722719 COLOR_ACTIVEBORDER = 10;
723720 COLOR_INACTIVEBORDER = 11;
724721 COLOR_APPWORKSPACE = 12;
725722 COLOR_HIGHLIGHT = 13;
726723 COLOR_HIGHLIGHTTEXT = 14;
727724 COLOR_BTNFACE = 15;
728725 COLOR_BTNSHADOW = 16;
729726 COLOR_GRAYTEXT = 17;
730727 COLOR_BTNTEXT = 18;
731728 COLOR_INACTIVECAPTIONTEXT = 19;
732729 COLOR_BTNHIGHLIGHT = 20;
733730 COLOR_3DDKSHADOW = 21;
734731 COLOR_3DLIGHT = 22;
735732 COLOR_INFOTEXT = 23;
736733 COLOR_INFOBK = 24;
737734 // PBD: 25 is unassigned in all the docs I can find
738735 // if someone finds what this is supposed to be then fill it in
739736 // note defaults below, and cl[ColorConst] in graphics
740737 COLOR_HOTLIGHT = 26;
741738 COLOR_GRADIENTACTIVECAPTION = 27;
742739 COLOR_GRADIENTINACTIVECAPTION = 28;
743740 COLOR_MENUHILIGHT = 29;
744741 COLOR_MENUBAR = 30;
745742
746743 COLOR_FORM = 31;
747744
748745 COLOR_ENDCOLORS = COLOR_FORM;
749746
750747 COLOR_DESKTOP = COLOR_BACKGROUND;
751748 COLOR_3DFACE = COLOR_BTNFACE;
752749 COLOR_3DSHADOW = COLOR_BTNSHADOW;
753750 COLOR_3DHIGHLIGHT = COLOR_BTNHIGHLIGHT;
754751 COLOR_3DHILIGHT = COLOR_BTNHIGHLIGHT;
755752 COLOR_BTNHILIGHT = COLOR_BTNHIGHLIGHT;
756753
757754 MAX_SYS_COLORS = COLOR_ENDCOLORS;
758755 SYS_COLOR_BASE = TColorRef($80000000);
759756```
760757
761758### ShowMessage
762759
763760Эти стандартные диалоги реализованы исключительно в LCL в следующих местах:
764761
765762- Файл класса TPromptDialog lcl/include/promptdialog.inc
766763
767764### SpinEdit
768765
769766И TFloatSpinEdit, и TSpinEdit реализованы в классе TWSFloatSpinEdit.
770767
771768### Буфер обмена
772769
773770Поддержка буфера обмена реализована в lclintf путем реализации подпрограмм Windows API. Это процедуры:
774771
775772``` pascal
776773function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
777774function ClipboardGetData(ClipboardType: TClipboardType;
778775 FormatID: TClipboardFormat; Stream: TStream): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
779776// ! ClipboardGetFormats: List будет создан. Вы должны освободить его самостоятельно с помощью FreeMem(List) !
780777function ClipboardGetFormats(ClipboardType: TClipboardType;
781778 var Count: integer; var List: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
782779function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
783780 OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
784781 Formats: PClipboardFormat): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
785782function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
786783```
787784
788785Последовательность вызовов при запуске программы:
789786
790787``` pascal
791788TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/bmp Result=51027040
792789TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/delphi.bitmap Result=0
793790TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/xpm Result=0
794791TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/png Result=0
795792TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=image/jpeg Result=0
796793```
797794
798795Последовательность вызовов во время присвоения "Caption:= Clipboard.AsText":
799796
800797``` pascal
801798TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=text/plain Result=51026976
802799TCocoaWidgetSet.ClipboardGetData ClipboardType=clipboard FormatID: 51026976
803800```
804801
805802### TSpeedButton
806803
807804Этот элемент управления является потомком TGraphicControl, поэтому он не имеет дескриптора и рисуется сам. Чтобы сохранить собственный внешний вид, он использует функцию `ThemeServices.DrawElement(Details.Element=teButton)` для отрисовки самого себя, поэтому реализуйте эту функцию, чтобы этот элемент управления работал. Естественно, многие другие DC, WindowOrg, рисование текста и рисование должны работать, как объяснено для TLabel.
808805
809806### TRadioButton и TCheckButton
810807
811808**Сообщения:**
812809
813810В основном Widgetset должен делать:
814811
815812- Отправлять LM_CHANGE, когда радиокнопка не отмечена/отмечена (LCL позаботится о том, будет ли вызываться OnClick или нет)
816813- Не отправлять LM_CHANGE, когда вызывается TWSCustomCheckBox.SetState(SetChecked)
817814
818815См. также этот отчет об ошибке: <http://bugs.freepascal.org/view.php?id=13939>
819816
820817### Поддержка FullScreen
821818
822819FullScreen(окно на весь экран без рамки - прим.перев.) реализован как состояние окна wsFullScreen и, как таковой, реализован в LCLIntf.ShowWindow, где должна обрабатываться константа SW_SHOWFULLSCREEN.
823820
824821## Пример работы интерфейсов LCL
825822
826823Ниже приведен простой пример. Предположим, вы разработали компонент trayicon. Как бы вы реализовали его в LCL для правильной работы на различных поддерживаемых платформах?
827824
828825Вам нужно будет сгенерировать следующие файлы:
829826
830827 \trayicon.pas
831828 \wstrayicon.pas
832829 \gtk\gtkwstrayicon.pas
833830 \gtk\trayintf.pas
834831 \win32\win32wstrayicon.pas
835832 \win32\trayintf.pas
836833
837834Предоставление отдельных файлов wsXXX.pas и \\\$(LCLWidgetType)\XXXintf.pas полностью исключает необходимость использования ifdefs. Вам нужно будет добавить в качестве пути модуля \$(LCLWidgetType) в файл XXXintf.pas, чтобы инициализировать корректный файл trayintf.pas, который, в свою очередь, инициализирует корректный класс WS Tray.
838835
839836Внутри trayicon.pas вы включаете wstrayicon. Извлеките свой основной класс из класса LCL и используйте только wstrayicon в его реализации. Все классы LCL, которые взаимодействуют с набором виджетов, должны быть получены из [[doc:/lcl/lclclasses/tlclcomponent.html|TLCLComponent]], объявленного в модуле [[doc:/lcl/lclclasses|LCLClasses]].
840837
841838``` pascal
842839unit TrayIcon;
843840
844841interface
845842
846843type
847844 TTrayIcon = class(TLCLComponent)
848845 public
849846 procedure DoTray;
850847 end;
851848
852849implementation
853850
854851uses wstrayicon;
855852
856853procedure TTrayIcon.DoTray;
857854begin
858855 // вызов wstrayicon
859856end;
860857
861858end.
862859```
863860
864861в trayintf вы используете gtkwstrayicon или win32trayicon, в зависимости от того, какой это файл trayintf.
865862
866863в wstrayicon вы создаете класс следующим образом:
867864
868865``` pascal
869866unit WSTrayIcon;
870867
871868uses WSLCLClasses, Controls, TrayIcon; // и другие модули
872869
873870TWSTrayIconClass = class of TWSTrayIcon;
874871TWSTrayIcon = class(TWSWinControl);
875872public
876873 // все они должны быть виртуальными и классовыми процедурами !!
877874 class procedure EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon); virtual;
878875 class procedure RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon); virtual;
879876 ....
880877end;
881878...
882879
883880implementation
884881
885882procedure TWSTrayIcon.EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon);
886883begin
887884 //ничего не делаем
888885end;
889886
890887procedure TWSTrayIcon.RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon);
891888begin
892889 //ничего не делаем
893890end;
894891```
895892
896893теперь в gtkwstrayicon.pas сделайте так:
897894
898895``` pascal
899896uses WSTrayIcon, WSLCLClasses, Controls, TrayIcon, gtk, gdk;
900897
901898TGtkWSTrayIcon = class(TWSTrayIcon);
902899private
903900 class function FindSystemTray(const ATrayIcon: TCustomTrayIcon): TWindow; virtual;public
904901 class procedure EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon); override;
905902 class procedure RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon); override;
906903 class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
907904 ....
908905end;
909906...
910907
911908implementation
912909
913910procedure TGtkWSTrayIcon.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND;
914911var
915912WidgetInfo: PWidgetInfo;
916913begin
917914 Result := gtk_plug_new;
918915 WidgetInfo := CreateWidgetInfo(AWinControl, Result); // как-то так или иначе
919916 TGtkWSWincontrolClass(WidgetSetClass).SetCallbacks(AWinControl);
920917 // и многое другое
921918end;
922919
923920function TGtkWSTrayIcon.FindSystemTray(const ATrayIcon:
924921TCustomTrayIcon): TWindow;
925922begin
926923 // что-то делаем
927924end;
928925
929926procedure TGtkWSTrayIcon.EmbedTrayIcon(const ATrayIcon: TCustomTrayIcon);
930927var
931928SystemTray: TWindow;
932929begin
933930 SystemTray := FindSystemTray(ATrayIcon);
934931 //что-то делаем
935932end;
936933
937934procedure TGtkWSTrayIcon.RemoveTrayIcon(const ATrayIcon: TCustomTrayIcon);
938935begin
939936 //что-то делаем
940937end;
941938
942939......
943940
944941initialization
945942
946943RegisterWSComponent(TCustomTrayIcon, TGtkWSTrayIcon); //вот это очень важно!!!
947944
948945end.
949946```
950947
951948затем наконец-то в trayicon.pas вы пишете как обычно
952949
953950``` pascal
954951uses WSTrayIcon; //и т.д., вы НЕ включаете сюда GtkWSTrayIcon!
955952
956953TCustomTrayIcon = class(TWinControl)
957954public
958955 procedure EmbedControl;
959956....
960957end;
961958
962959...
963960procedure TTrayIcon.EmbedControl;
964961begin
965962 TWSTrayIconClass(WidgetSetClass).EmbedControl(Self);
966963end;
967964```
968965
969966------------------------------------------------------------------------
970967
971968Этот документ находится в стадии разработки. Вы можете помочь, написав разделы этого документа. Если вы не можете найти информацию, которую вы ищете в этом документе, пожалуйста, добавьте свой вопрос на страницу обсуждения. Это поможет нам писать документацию на уровне, который не является ни слишком простым, ни слишком сложным, и полностью охватывает области, о которых люди хотят знать.
972969
973970---
974971*From the Free Pascal wiki, page "LCL Internals/ru", as it stood on 2020-02-19 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history