1 {
2  *****************************************************************************
3  *                              QtObjects.pas                                *
4  *                              --------------                               *
5  *                                                                           *
6  *                                                                           *
7  *****************************************************************************
8 
9  *****************************************************************************
10   This file is part of the Lazarus Component Library (LCL)
11 
12   See the file COPYING.modifiedLGPL.txt, included in this distribution,
13   for details about the license.
14  *****************************************************************************
15 }
16 unit qtobjects;
17 
18 {$mode objfpc}{$H+}
19 
20 interface
21 
22 {$I qtdefines.inc}
23 
24 uses
25   // Bindings
26   qt5,
27   // Free Pascal
28   Classes, SysUtils, Types,
29   // LCL
30   LCLType, LCLIntf, LCLProc, LazUTF8, Menus, Graphics, ClipBrd, ExtCtrls,
31   Interfacebase, maps;
32 
33 type
34   // forward declarations
35   TQActions = Array of QActionH;
36   TQtImage = class;
37   TQtFontMetrics = class;
38   TQtFontInfo = class;
39   TQtTimer = class;
40   TRop2OrCompositionSupport = (rocNotSupported, rocSupported, rocUndefined);
41 
42   { TQtObject }
43   TQtObject = class(TObject)
44   private
45     FUpdateCount: Integer;
46     FInEventCount: Integer;
47     FReleaseInEvent: Boolean;
48   public
49     FDeleteLater: Boolean;
50     FEventHook: QObject_hookH;
51     FDestroyedHook: QObject_hookH;
52     TheObject: QObjectH;
53     constructor Create; virtual; overload;
54     destructor Destroy; override;
55     procedure Release; virtual;
56   public
57     procedure AttachEvents; virtual;
58     procedure DetachEvents; virtual;
EventFilternull59     function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; virtual; abstract;
60     procedure Destroyed; cdecl; virtual;
61     procedure BeginEventProcessing;
62     procedure EndEventProcessing;
InEventnull63     function InEvent: Boolean;
64   public
65     procedure BeginUpdate; virtual;
66     procedure EndUpdate; virtual;
InUpdatenull67     function InUpdate: Boolean;
68   end;
69 
70   { TQtResource }
71 
72   TQtResource = class(TObject)
73   public
74     Owner: TObject;
75     FShared: Boolean;
76     FSelected: Boolean;
77   end;
78 
79   { TQtActionGroup }
80 
81   TQtActionGroup = class(TObject)
82   private
83     FActions: TQActions;
84     FGroupIndex: integer;
85     FHandle: QActionGroupH;
getEnablednull86     function getEnabled: boolean;
getExclusivenull87     function getExclusive: boolean;
getVisiblenull88     function getVisible: boolean;
89     procedure setEnabled(const AValue: boolean);
90     procedure setExclusive(const AValue: boolean);
91     procedure setVisible(const AValue: boolean);
92   public
93     constructor Create(const AParent: QObjectH = nil);
94     destructor Destroy; override;
addActionnull95     function addAction(action: QActionH): QActionH; overload;
addActionnull96     function addAction(text: WideString): QActionH; overload;
addActionnull97     function addAction(icon: QIconH; text: WideString): QActionH; overload;
98     procedure removeAction(action: QActionH);
actionsnull99     function actions: TQActions;
checkedActionnull100     function checkedAction: QActionH;
101     procedure setDisabled(ADisabled: Boolean);
102     property Enabled: boolean read getEnabled write setEnabled;
103     property Exclusive: boolean read getExclusive write setExclusive;
104     property GroupIndex: integer read FGroupIndex write FGroupIndex;
105     property Handle: QActionGroupH read FHandle;
106     property Visible: boolean read getVisible write setVisible;
107   end;
108 
109   { TQtAction }
110 
111   TQtAction = class(TObject)
112   private
113     FIcon: QIconH;
114   public
115     FHandle: QActionH;
116     MenuItem: TMenuItem;
117   public
118     constructor Create(const AHandle: QActionH);
119     destructor Destroy; override;
120   public
121     procedure SlotTriggered({%H-}checked: Boolean = False); cdecl;
122   public
123     procedure setChecked(p1: Boolean);
124     procedure setCheckable(p1: Boolean);
125     procedure setEnabled(p1: Boolean);
126     procedure setIcon(const AIcon: QIconH);
127     procedure setImage(const AImage: TQtImage);
128     procedure setVisible(p1: Boolean);
129   end;
130 
131   { TQtImage }
132 
133   TQtImage = class(TObject)
134   private
135     FData: PByte;
136     FDataOwner: Boolean;
137     FHandle: QImageH;
138   public
139     constructor Create;
140     constructor Create(vHandle: QImageH); overload;
141     constructor Create(AData: PByte; width: Integer; height: Integer; format: QImageFormat; const ADataOwner: Boolean = False); overload;
142     constructor Create(AData: PByte; width: Integer; height: Integer; bytesPerLine: Integer; format: QImageFormat; const ADataOwner: Boolean = False); overload;
143     destructor Destroy; override;
AsIconnull144     function AsIcon(AMode: QIconMode = QIconNormal; AState: QIconState = QIconOff): QIconH;
AsPixmapnull145     function AsPixmap(flags: QtImageConversionFlags = QtAutoColor): QPixmapH;
AsBitmapnull146     function AsBitmap(flags: QtImageConversionFlags = QtAutoColor): QBitmapH;
147     procedure CopyFrom(AImage: QImageH; x, y, w, h: integer);
148   public
heightnull149     function height: Integer;
widthnull150     function width: Integer;
depthnull151     function depth: Integer;
dotsPerMeterXnull152     function dotsPerMeterX: Integer;
dotsPerMeterYnull153     function dotsPerMeterY: Integer;
bitsnull154     function bits: PByte;
numBytesnull155     function numBytes: Integer;
bytesPerLinenull156     function bytesPerLine: Integer;
157     procedure invertPixels(InvertMode: QImageInvertMode = QImageInvertRgb);
getFormatnull158     function getFormat: QImageFormat;
159     property Handle: QImageH read FHandle;
160   end;
161 
162   { TQtFont }
163 
164   TQtFont = class(TQtResource)
165   private
166     FDefaultFont: QFontH;
167     FMetrics: TQtFontMetrics;
168     FFontInfo: TQtFontInfo;
GetFontInfonull169     function GetFontInfo: TQtFontInfo;
GetMetricsnull170     function GetMetrics: TQtFontMetrics;
GetDefaultFontnull171     function GetDefaultFont: QFontH;
172   public
173     FHandle: QFontH;
174     Angle: Integer;
175   public
176     constructor Create(CreateHandle: Boolean); virtual;
177     constructor Create(AFromFont: QFontH); virtual;
178     destructor Destroy; override;
179   public
getPointSizenull180     function getPointSize: Integer;
getPixelSizenull181     function getPixelSize: Integer;
getWeightnull182     function getWeight: Integer;
getItalicnull183     function getItalic: Boolean;
getBoldnull184     function getBold: Boolean;
getUnderlinenull185     function getUnderline: Boolean;
getStrikeOutnull186     function getStrikeOut: Boolean;
getFamilynull187     function getFamily: WideString;
getStyleStategynull188     function getStyleStategy: QFontStyleStrategy;
189 
190     procedure setPointSize(p1: Integer);
191     procedure setPixelSize(p1: Integer);
192     procedure setWeight(p1: Integer);
193     procedure setBold(p1: Boolean);
194     procedure setItalic(b: Boolean);
195     procedure setUnderline(p1: Boolean);
196     procedure setStrikeOut(p1: Boolean);
197     procedure setRawName(p1: string);
198     procedure setFamily(p1: string);
199     procedure setStyleStrategy(s: QFontStyleStrategy);
200     procedure family(retval: PWideString);
fixedPitchnull201     function fixedPitch: Boolean;
202 
203     property FontInfo: TQtFontInfo read GetFontInfo;
204     property Metrics: TQtFontMetrics read GetMetrics;
205   end;
206 
207   { TQtFontMetrics }
208 
209   TQtFontMetrics = class(TObject)
210   private
211   public
212     FHandle: QFontMetricsH;
213   public
214     constructor Create(Parent: QFontH); virtual;
215     destructor Destroy; override;
216   public
heightnull217     function height: Integer;
widthnull218     function width(p1: PWideString): Integer; overload;
widthnull219     function width(p1: PWideString; ALen: Integer): Integer; overload;
ascentnull220     function ascent: Integer;
descentnull221     function descent: Integer;
leadingnull222     function leading: Integer;
maxWidthnull223     function maxWidth: Integer;
224     procedure boundingRect(retval: PRect; r: PRect; flags: Integer; text: PWideString; tabstops: Integer = 0; tabarray: PInteger = nil);
charWidthnull225     function charWidth(str: WideString; pos: Integer): Integer;
averageCharWidthnull226     function averageCharWidth: Integer;
elidedTextnull227     function elidedText(const AText: WideString;
228       const AMode: QtTextElideMode; const AWidth: Integer;
229       const AFlags: Integer = 0): WideString;
230   end;
231 
232   { TQtFontInfo }
233 
234   TQtFontInfo = class(TObject)
235   private
GetBoldnull236     function GetBold: Boolean;
GetExactMatchnull237     function GetExactMatch: Boolean;
GetFamilynull238     function GetFamily: WideString;
GetFixedPitchnull239     function GetFixedPitch: Boolean;
GetFontStylenull240     function GetFontStyle: QFontStyle;
GetFontStyleHintnull241     function GetFontStyleHint: QFontStyleHint;
GetItalicnull242     function GetItalic: Boolean;
GetOverLinenull243     function GetOverLine: Boolean;
GetPixelSizenull244     function GetPixelSize: Integer;
GetPointSizenull245     function GetPointSize: Integer;
GetRawModenull246     function GetRawMode: Boolean;
GetStrikeOutnull247     function GetStrikeOut: Boolean;
GetUnderlinenull248     function GetUnderline: Boolean;
GetWeightnull249     function GetWeight: Integer;
250   public
251     FHandle: QFontInfoH;
252   public
253     constructor Create(AFont: QFontH); virtual;
254     destructor Destroy; override;
255   public
256     property Bold: Boolean read GetBold;
257     property Italic: Boolean read GetItalic;
258     property ExactMatch: Boolean read GetExactMatch;
259     property Family: WideString read GetFamily;
260     property FixedPitch: Boolean read GetFixedPitch;
261     property Overline: Boolean read GetOverLine;
262     property PointSize: Integer read GetPointSize;
263     property PixelSize: Integer read GetPixelSize;
264     property RawMode: Boolean read GetRawMode;
265     property StrikeOut: Boolean read GetStrikeOut;
266     property Style: QFontStyle read GetFontStyle;
267     property StyleHint: QFontStyleHint read GetFontStyleHint;
268     property Underline: Boolean read GetUnderline;
269     property Weight: Integer read GetWeight;
270   end;
271 
272   { TQtBrush }
273 
274   TQtBrush = class(TQtResource)
275   private
276     FRadialGradient: QRadialGradientH;
getStylenull277     function getStyle: QtBrushStyle;
278     procedure setStyle(style: QtBrushStyle);
279   public
280     FHandle: QBrushH;
281     constructor Create(CreateHandle: Boolean); virtual;
282     constructor CreateWithRadialGradient(ALogBrush: TLogRadialGradient);
283     destructor Destroy; override;
getColornull284     function getColor: PQColor;
GetLBStylenull285     function GetLBStyle(out AStyle: LongWord; out AHatch: PtrUInt): Boolean;
286     procedure setColor(AColor: PQColor);
287     procedure setTexture(pixmap: QPixmapH);
288     procedure setTextureImage(image: QImageH);
289     property Style: QtBrushStyle read getStyle write setStyle;
290   end;
291 
292   { TQtPen }
293 
294   TQtPen = class(TQtResource)
295   private
296     FIsExtPen: Boolean;
297   public
298     FHandle: QPenH;
299     constructor Create(CreateHandle: Boolean); virtual;
300     destructor Destroy; override;
301   public
getCapStylenull302     function getCapStyle: QtPenCapStyle;
getColornull303     function getColor: TQColor;
getCosmeticnull304     function getCosmetic: Boolean;
getJoinStylenull305     function getJoinStyle: QtPenJoinStyle;
getWidthnull306     function getWidth: Integer;
getStylenull307     function getStyle: QtPenStyle;
getDashPatternnull308     function getDashPattern: TQRealArray;
309 
310     procedure setCapStyle(pcs: QtPenCapStyle);
311     procedure setColor(p1: TQColor);
312     procedure setCosmetic(b: Boolean);
313     procedure setJoinStyle(pcs: QtPenJoinStyle);
314     procedure setStyle(AStyle: QtPenStyle);
315     procedure setBrush(brush: QBrushH);
316     procedure setWidth(p1: Integer);
317     procedure setDashPattern(APattern: PDWord; ALength: DWord);
318 
319     property IsExtPen: Boolean read FIsExtPen write FIsExtPen;
320   end;
321 
322 
323   { TQtRegion }
324 
325   TQtRegion = class(TQtResource)
326   private
327     FPolygon: QPolygonH;
GetIsPolyRegionnull328     function GetIsPolyRegion: Boolean;
329   public
330     FHandle: QRegionH;
331     constructor Create(CreateHandle: Boolean); virtual; overload;
332     constructor Create(CreateHandle: Boolean; X1,Y1,X2,Y2: Integer;
333       Const RegionType: QRegionRegionType = QRegionRectangle); virtual; overload;
334     constructor Create(CreateHandle: Boolean; Poly: QPolygonH;
335       Const Fill: QtFillRule = QtWindingFill); virtual; overload;
336     destructor Destroy; override;
containsPointnull337     function containsPoint(X,Y: Integer): Boolean;
containsRectnull338     function containsRect(R: TRect): Boolean;
intersectsnull339     function intersects(R: TRect): Boolean; overload;
intersectsnull340     function intersects(Rgn: QRegionH): Boolean; overload;
GetRegionTypenull341     function GetRegionType: integer;
getBoundingRectnull342     function getBoundingRect: TRect;
numRectsnull343     function numRects: Integer;
344     procedure translate(dx, dy: Integer);
345     property IsPolyRegion: Boolean read GetIsPolyRegion;
346     property Polygon: QPolygonH read FPolygon;
347   end;
348 
349   // NOTE: PQtDCData was a pointer to a structure with QPainter information
350   //       about current state, currently this functionality is implemented
351   //       using native functions qpainter_save and qpainter_restore. If in
352   //       future it needs to save/restore aditional information, PQtDCData
353   //       should point to a structure holding the additional information.
354   //       see SaveDC and RestoreDC for more information.
355   //       for example: what about textcolor, it's currently not saved....
356 
357   {
358   TQtDCData = record
359   end;
360   PQtDCData = ^TQtDCData;
361   }
362   PQtDCData = pointer;
363 
364   { TQtDeviceContext }
365 
366   TQtDeviceContext = class(TObject)
367   private
368     FSupportRasterOps: TRop2OrCompositionSupport;
369     FSupportComposition: TRop2OrCompositionSupport;
370     FRopMode: Integer;
371     FPenPos: TQtPoint;
372     FOwnPainter: Boolean;
373     FUserDC: boolean;
374     SelFont: TQtFont;
375     SelBrush: TQtBrush;
376     SelPen: TQtPen;
377     PenColor: TQColor;
378     FMetrics: TQtFontMetrics;
379     function GetMetrics: TQtFontMetrics;
380     function GetRop: Integer;
381     function DeviceSupportsComposition: Boolean;
382     function DeviceSupportsRasterOps: Boolean;
383     function R2ToQtRasterOp(AValue: Integer): QPainterCompositionMode;
384     procedure RestorePenColor;
385     procedure RestoreTextColor;
386     procedure SetRop(const AValue: Integer);
387   public
388     { public fields }
389     Widget: QPainterH;
390     Parent: QWidgetH;
391     ParentPixmap: QPixmapH;
392     vBrush: TQtBrush;
393     vFont: TQtFont;
394     vImage: TQtImage;
395     vPen: TQtPen;
396     vRegion: TQtRegion;
397     vBackgroundBrush: TQtBrush;
398     vClipRect: PRect;         // is the cliprect paint event give to us
399     vClipRectDirty: boolean;  // false=paint cliprect is still valid
400     vTextColor: TColorRef;
401     vMapMode: Integer;
402   public
403     { Our own functions }
404     constructor Create(AWidget: QWidgetH; const APaintEvent: Boolean = False); virtual;
405     constructor CreatePrinterContext(ADevice: QPrinterH); virtual;
406     constructor CreateFromPainter(APainter: QPainterH);
407     destructor Destroy; override;
408     procedure CreateObjects;
409     procedure DestroyObjects;
410     function CreateDCData: PQtDCDATA;
411     function RestoreDCData(var {%H-}DCData: PQtDCData): boolean;
412     procedure DebugClipRect(const msg: string);
413     procedure setImage(AImage: TQtImage);
414     procedure CorrectCoordinates(var ARect: TRect);
415     function GetLineLastPixelPos(PrevPos, NewPos: TPoint): TPoint;
416   public
417     { Qt functions }
418 
419     procedure qDrawPlainRect(x, y, w, h: integer; AColor: PQColor = nil;
420       lineWidth: Integer = 1; FillBrush: QBrushH = nil);
421     procedure qDrawShadeRect(x, y, w, h: integer; Palette: QPaletteH = nil; Sunken: Boolean = False;
422       lineWidth: Integer = 1; midLineWidth: Integer = 0; FillBrush: QBrushH = nil);
423     procedure qDrawWinPanel(x, y, w, h: integer;
424       ATransparent: boolean;
425       Palette: QPaletteH = nil; Sunken: Boolean = False;
426       lineWidth: Integer = 1; FillBrush: QBrushH = nil);
427 
428     procedure drawPoint(x1: Integer; y1: Integer);
429     procedure drawRect(x1: Integer; y1: Integer; w: Integer; h: Integer);
430     procedure drawRoundRect(x, y, w, h, rx, ry: Integer);
431     procedure drawText(x: Integer; y: Integer; s: PWideString); overload;
432     procedure drawText(x,y,w,h,flags: Integer; s:PWideString); overload;
433     procedure drawLine(x1: Integer; y1: Integer; x2: Integer; y2: Integer);
434     procedure drawEllipse(x: Integer; y: Integer; w: Integer; h: Integer);
435     procedure drawPixmap(p: PQtPoint; pm: QPixmapH; sr: PRect);
436     procedure drawPolyLine(P: PPoint; NumPts: Integer);
437     procedure drawPolygon(P: PPoint; NumPts: Integer; FillRule: QtFillRule = QtOddEvenFill);
438     procedure eraseRect(ARect: PRect);
439     procedure fillRect(ARect: PRect; ABrush: QBrushH); overload;
440     procedure fillRect(x, y, w, h: Integer; ABrush: QBrushH); overload;
441     procedure fillRect(x, y, w, h: Integer); overload;
442 
443     function getBKMode: Integer;
444     procedure getBrushOrigin(retval: PPoint);
445     function getClipping: Boolean;
446     function getCompositionMode: QPainterCompositionMode;
447     procedure setCompositionMode(mode: QPainterCompositionMode);
448     procedure getPenPos(retval: PPoint);
449     function getWorldTransform: QTransformH;
450     procedure setBrushOrigin(x, y: Integer);
451     procedure setPenPos(x, y: Integer);
452 
453     function font: TQtFont;
454     procedure setFont(AFont: TQtFont);
455     function brush: TQtBrush;
456     procedure setBrush(ABrush: TQtBrush);
457     function BackgroundBrush: TQtBrush;
458     function GetBkColor: TColorRef;
459     function pen: TQtPen;
460     function setPen(APen: TQtPen): TQtPen;
461     function SetBkColor(Color: TColorRef): TColorRef;
462     function SetBkMode(BkMode: Integer): Integer;
463     function getDepth: integer;
464     function getDeviceSize: TPoint;
465     function getRegionType(ARegion: QRegionH): integer;
466     function getClipRegion: TQtRegion;
467     procedure setClipping(const AValue: Boolean);
468     procedure setClipRect(const ARect: TRect);
469     procedure setClipRegion(ARegion: QRegionH; AOperation: QtClipOperation = QtReplaceClip);
470     procedure setRegion(ARegion: TQtRegion);
471     procedure drawImage(targetRect: PRect; image: QImageH; sourceRect: PRect;
472       mask: QImageH; maskRect: PRect; flags: QtImageConversionFlags = QtAutoColor);
473     function PaintEngine: QPaintEngineH;
474     procedure rotate(a: Double);
475     procedure setRenderHint(AHint: QPainterRenderHint; AValue: Boolean);
476     procedure save;
477     procedure restore;
478     procedure translate(dx: Double; dy: Double);
479     property Metrics: TQtFontMetrics read GetMetrics;
480     property Rop2: Integer read GetRop write SetRop;
481     property UserDC: boolean read FUserDC write FUserDC; {if context is created from GetDC() and it's not default DC.}
482   end;
483 
484   { TQtPixmap }
485 
486   TQtPixmap = class(TObject)
487   protected
488     FHandle: QPixmapH;
489   public
490     constructor Create(p1: PSize); virtual;
491     destructor Destroy; override;
492   public
493     property Handle: QPixmapH read FHandle;
494 
getHeightnull495     function getHeight: Integer;
getWidthnull496     function getWidth: Integer;
497     procedure grabWidget(AWidget: QWidgetH; x: Integer = 0; y: Integer = 0; w: Integer = -1; h: Integer = -1);
498     procedure grabWindow(p1: Cardinal; x: Integer = 0; y: Integer = 0; w: Integer = -1; h: Integer = -1);
499     procedure toImage(retval: QImageH);
500     class procedure fromImage(retval: QPixmapH; image: QImageH; flags: QtImageConversionFlags = QtAutoColor);
501   end;
502 
503   { TQtIcon }
504 
505   TQtIcon = class(TObject)
506   protected
507     FHandle: QIconH;
508   public
509     constructor Create;
510     destructor Destroy; override;
511     procedure addPixmap(pixmap: QPixmapH; mode: QIconMode = QIconNormal; state: QIconState = QIconOff);
512     property Handle: QIconH read FHandle;
513   end;
514 
515   { TQtCursor }
516 
517   TQtCursor = class(TObject)
518   protected
519     FHandle: QCursorH;
520   public
521     constructor Create;
522     constructor Create(pixmap: QPixmapH; hotX: Integer  = -1; hotY: Integer = -1);
523     constructor Create(shape: QtCursorShape);
524     destructor Destroy; override;
525     property Handle: QCursorH read FHandle;
526   end;
527 
528   { TQtButtonGroup }
529 
530   TQtButtonGroup = class(TObject)
531   private
532   public
533     Handle: QButtonGroupH;
534     constructor Create(AParent: QObjectH); virtual;
535     destructor Destroy; override;
536   public
537     procedure AddButton(AButton: QAbstractButtonH); overload;
538     procedure AddButton(AButton: QAbstractButtonH; Id: Integer); overload;
ButtonFromIdnull539     function ButtonFromId(id: Integer): QAbstractButtonH;
540     procedure RemoveButton(AButton: QAbstractButtonH);
GetExclusivenull541     function GetExclusive: Boolean;
542     procedure SetExclusive(AExclusive: Boolean);
543     procedure SignalButtonClicked(AButton: QAbstractButtonH); cdecl;
544   end;
545 
546   { TQtClipboard }
547 
548   TQtClipboard = class(TQtObject)
549   private
550     FLockClip: Boolean;
551     FClipDataChangedHook: QClipboard_hookH;
552     {$IFDEF HASX11}
553     FClipSelectionChangedHook: QClipboard_hookH;
554     FSelTimer: TQtTimer; // timer for keyboard X11 selection
555     FSelFmtCount: Integer;
556     FLockX11Selection: Integer;
557     {$ENDIF}
558     FClipChanged: Boolean;
559     FClipBoardFormats: TStringList;
560     FOnClipBoardRequest: Array[TClipBoardType] of TClipboardRequestEvent;
IsClipboardChangednull561     function IsClipboardChanged: Boolean;
562   public
563     constructor Create; override;
564     destructor Destroy; override;
565     procedure AttachEvents; override;
566     procedure DetachEvents; override;
EventFilternull567     function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
568 
Clipboardnull569     function Clipboard: QClipboardH; inline;
570 
getMimeDatanull571     function getMimeData(AMode: QClipboardMode): QMimeDataH;
572     procedure setMimeData(AMimeData: QMimeDataH; AMode: QClipboardMode);
573     procedure Clear(AMode: QClipboardMode);
574 
FormatToMimeTypenull575     function FormatToMimeType(AFormat: TClipboardFormat): String;
RegisterFormatnull576     function RegisterFormat(AMimeType: String): TClipboardFormat;
GetDatanull577     function GetData(ClipboardType: TClipboardType; FormatID: TClipboardFormat;
578       Stream: TStream): boolean;
GetFormatsnull579     function GetFormats(ClipboardType: TClipboardType; var Count: integer;
580       var List: PClipboardFormat): boolean;
GetOwnerShipnull581     function GetOwnerShip(ClipboardType: TClipboardType; OnRequestProc: TClipboardRequestEvent;
582       FormatCount: integer; Formats: PClipboardFormat): boolean;
583 
584     procedure signalDataChanged; cdecl;
585     {$IFDEF HASX11}
586     procedure BeginX11SelectionLock;
587     procedure EndX11SelectionLock;
InX11SelectionLocknull588     function InX11SelectionLock: Boolean;
589     procedure signalSelectionChanged; cdecl;
590     procedure selectionTimer;
591     {$ENDIF}
592   end;
593 
594   { TQtPrinter }
595 
596   TQtPrinter = class(TObject)
597   protected
598     FHandle: QPrinterH;
599     FPrinterContext: TQtDeviceContext;
600   private
601     FPrinterActive: Boolean;
GetDuplexModenull602     function GetDuplexMode: QPrinterDuplexMode;
getPrinterContextnull603     function getPrinterContext: TQtDeviceContext;
getCollateCopiesnull604     function getCollateCopies: Boolean;
getColorModenull605     function getColorMode: QPrinterColorMode;
getCreatornull606     function getCreator: WideString;
getDevTypenull607     function getDevType: Integer;
getDocNamenull608     function getDocName: WideString;
getDoubleSidedPrintingnull609     function getDoubleSidedPrinting: Boolean;
getFontEmbeddingnull610     function getFontEmbedding: Boolean;
getFullPagenull611     function getFullPage: Boolean;
getOutputFormatnull612     function getOutputFormat: QPrinterOutputFormat;
getPaperSourcenull613     function getPaperSource: QPrinterPaperSource;
getPrintProgramnull614     function getPrintProgram: WideString;
getPrintRangenull615     function getPrintRange: QPrinterPrintRange;
616     procedure setCollateCopies(const AValue: Boolean);
617     procedure setColorMode(const AValue: QPrinterColorMode);
618     procedure setCreator(const AValue: WideString);
619     procedure setDocName(const AValue: WideString);
620     procedure setDoubleSidedPrinting(const AValue: Boolean);
621     procedure SetDuplexMode(AValue: QPrinterDuplexMode);
622     procedure setFontEmbedding(const AValue: Boolean);
623     procedure setFullPage(const AValue: Boolean);
624     procedure setOutputFormat(const AValue: QPrinterOutputFormat);
625     procedure setPaperSource(const AValue: QPrinterPaperSource);
626     procedure setPrinterName(const AValue: WideString);
getPrinterNamenull627     function getPrinterName: WideString;
628     procedure setOutputFileName(const AValue: WideString);
getOutputFileNamenull629     function getOutputFileName: WideString;
630     procedure setOrientation(const AValue: QPrinterOrientation);
getOrientationnull631     function getOrientation: QPrinterOrientation;
632     procedure setPageSize(const AValue: QPagedPaintDevicePageSize);
getPageSizenull633     function getPageSize: QPagedPaintDevicePageSize;
634     procedure setPageOrder(const AValue: QPrinterPageOrder);
getPageOrdernull635     function getPageOrder: QPrinterPageOrder;
636     procedure setPrintProgram(const AValue: WideString);
637     procedure setPrintRange(const AValue: QPrinterPrintRange);
638     procedure setResolution(const AValue: Integer);
getResolutionnull639     function getResolution: Integer;
getNumCopiesnull640     function getNumCopies: Integer;
641     procedure setNumCopies(const AValue: Integer);
getPrinterStatenull642     function getPrinterState: QPrinterPrinterState;
643   public
644     constructor Create; virtual; overload;
645     constructor Create(AMode: QPrinterPrinterMode); virtual; overload;
646     destructor Destroy; override;
647 
DefaultPrinternull648     function DefaultPrinter: WideString;
GetAvailablePrintersnull649     function GetAvailablePrinters(Lst: TStrings): Boolean;
650 
651     procedure beginDoc;
652     procedure endDoc;
653 
NewPagenull654     function NewPage: Boolean;
Abortnull655     function Abort: Boolean;
656     procedure setFromPageToPage(Const AFromPage, AToPage: Integer);
fromPagenull657     function fromPage: Integer;
toPagenull658     function toPage: Integer;
PaintEnginenull659     function PaintEngine: QPaintEngineH;
PageRectnull660     function PageRect: TRect; overload;
PaperRectnull661     function PaperRect: TRect; overload;
PageRectnull662     function PageRect(AUnits: QPrinterUnit): TRect; overload;
PaperRectnull663     function PaperRect(AUnits: QPrinterUnit): TRect; overload;
PrintEnginenull664     function PrintEngine: QPrintEngineH;
GetPaperSizenull665     function GetPaperSize(AUnits: QPrinterUnit): TSize;
666     procedure SetPaperSize(ASize: TSize; AUnits: QPrinterUnit);
SupportedResolutionsnull667     function SupportedResolutions: TPtrIntArray;
668 
669     property Collate: Boolean read getCollateCopies write setCollateCopies;
670     property ColorMode: QPrinterColorMode read getColorMode write setColorMode;
671     property Creator: WideString read getCreator write setCreator;
672     property DeviceType: Integer read getDevType;
673     property DocName: WideString read getDocName write setDocName;
674     property DoubleSidedPrinting: Boolean read getDoubleSidedPrinting write setDoubleSidedPrinting;
675     property Duplex: QPrinterDuplexMode read GetDuplexMode write SetDuplexMode;
676     property FontEmbedding: Boolean read getFontEmbedding write setFontEmbedding;
677     property FullPage: Boolean read getFullPage write setFullPage;
678     property Handle: QPrinterH read FHandle;
679     property NumCopies: Integer read getNumCopies write setNumCopies;
680     property Orientation: QPrinterOrientation read getOrientation write setOrientation;
681     property OutputFormat: QPrinterOutputFormat read getOutputFormat write setOutputFormat;
682     property OutputFileName: WideString read getOutputFileName write setOutputFileName;
683     property PageOrder: QPrinterPageOrder read getPageOrder write setPageOrder;
684     property PageSize: QPagedPaintDevicePageSize read getPageSize write setPageSize;
685     property PaperSource: QPrinterPaperSource read getPaperSource write setPaperSource;
686     property PrinterContext: TQtDeviceContext read getPrinterContext;
687     property PrinterName: WideString read getPrinterName write setPrinterName;
688     property PrinterActive: Boolean read FPrinterActive;
689     property PrintRange: QPrinterPrintRange read getPrintRange write setPrintRange;
690     property PrinterState: QPrinterPrinterState read getPrinterState;
691     property PrintProgram: WideString read getPrintProgram write setPrintProgram;
692     property Resolution: Integer read getResolution write setResolution;
693   end;
694 
695   { TQtTimer }
696 
697   TQtTimer = class(TQtObject)
698   private
699     FTimerHook: QTimer_hookH;
700     FCallbackFunc: TWSTimerProc;
701     FId: Integer;
702     FAppObject: QObjectH;
getTimerEnablednull703     function getTimerEnabled: Boolean;
704     procedure setTimerEnabled(const AValue: Boolean);
705   public
706     constructor CreateTimer(Interval: integer; const TimerFunc: TWSTimerProc; App: QObjectH); virtual;
707     destructor Destroy; override;
708     procedure AttachEvents; override;
709     procedure DetachEvents; override;
710     procedure signalTimeout; cdecl;
711     property TimerEnabled: Boolean read getTimerEnabled write setTimerEnabled;
712     property TimerID: Integer read FId;
713   public
EventFilternull714     function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
715   end;
716 
717   { TQtStringList }
718 
719   TQtStringList = class(TStrings)
720   private
721     FHandle: QStringListH;
722     FOwnHandle: Boolean;
723   protected
Getnull724     function Get(Index: Integer): string; override;
GetCountnull725     function GetCount: Integer; override;
726   public
727     constructor Create;
728     constructor Create(Source: QStringListH);
729     destructor Destroy; override;
730 
731     procedure Clear; override;
732     procedure Delete(Index: Integer); override;
733     procedure Insert(Index: Integer; const S: string); override;
734     property Handle: QStringListH read FHandle;
735   end;
736 
737   { TQtWidgetPalette }
738 
739   TQtWidgetPalette = class(TObject)
740   private
741     procedure initializeSysColors;
ColorChangeNeedednull742     function ColorChangeNeeded(const AColor: TQColor;
743       const ATextRole: Boolean): Boolean;
744   protected
745     FForceColor: Boolean;
746     FInReload: Boolean;
747     FWidget: QWidgetH;
748     FWidgetRole: QPaletteColorRole;
749     FTextRole: QPaletteColorRole;
750     FDefaultColor: TQColor;
751     FCurrentColor: TQColor;
752     FDefaultTextColor: TQColor;
753     FCurrentTextColor: TQColor;
754     FDisabledColor: TQColor;
755     FDisabledTextColor: TQColor;
756     FHandle: QPaletteH;
757   public
758     constructor Create(AWidgetColorRole: QPaletteColorRole;
759       AWidgetTextColorRole: QPaletteColorRole; AWidget: QWidgetH);
760     destructor Destroy; override;
761     procedure ReloadPaletteBegin; // used in QEventPaletteChange !
762     procedure ReloadPaletteEnd; // used in QEventPaletteChange !
763     procedure setColor(const AColor: PQColor);
764     procedure setTextColor(const AColor: PQColor);
765     property Handle: QPaletteH read FHandle;
766     property CurrentColor: TQColor read FCurrentColor;
767     property CurrentTextColor: TQColor read FCurrentTextColor;
768     property DefaultColor: TQColor read FDefaultColor;
769     property DefaultTextColor: TQColor read FDefaultTextColor;
770     property DisabledColor: TQColor read FDisabledColor;
771     property DisabledTextColor: TQColor read FDisabledTextColor;
772     property InReload: Boolean read FInReload;
773     property ForceColor: Boolean read FForceColor write FForceColor;
774   end;
775 
776   {TQtObjectDump}
777 
778   TQtObjectDump = class(TObject) // helper class to dump complete children tree
779   private
780     FRoot: QObjectH;
781     FObjList: TFPList;
782     FList: TStrings;
783     procedure Iterator(ARoot: QObjectH);
784     procedure AddToList(AnObject: QObjectH);
785   public
786     constructor Create(AnObject: QObjectH);
787     destructor Destroy; override;
788     procedure DumpObject;
findWidgetByNamenull789     function findWidgetByName(const AName: WideString): QWidgetH;
IsWidgetnull790     function IsWidget(AnObject: QObjectH): Boolean;
GetObjectNamenull791     function GetObjectName(AnObject: QObjectH): WideString;
InheritsQtClassnull792     function InheritsQtClass(AnObject: QObjectH; AQtClass: WideString): Boolean;
793     property List: TStrings read FList;
794     property ObjList: TFPList read FObjList;
795   end;
796 
797   { TQtGDIObjects }
798 
799   TQtGDIObjects = class(TObject)
800   private
801     {$IFDEF DebugQTGDIObjects}
802     FMaxCount: Int64;
803     FInvalidCount: Int64;
804     {$ENDIF}
805     FCount: PtrInt;
806     FSavedHandlesList: TMap;
807   public
808     constructor Create;
809     destructor Destroy; override;
810     procedure AddGDIObject(AObject: TObject);
811     procedure RemoveGDIObject(AObject: TObject);
IsValidGDIObjectnull812     function IsValidGDIObject(AGDIObject: PtrUInt): Boolean;
813     property Count: PtrInt read FCount;
814   end;
815 
816 
817 const
818   LCLQt_Destroy = QEventType(Ord(QEventUser) + $1000);
819 
820 procedure TQColorToColorRef(const AColor: TQColor; out AColorRef: TColorRef);
821 procedure ColorRefToTQColor(const AColorRef: TColorRef; var AColor:TQColor);
EqualTQColornull822 function EqualTQColor(const Color1, Color2: TQColor): Boolean;
823 procedure DebugRegion(const msg: string; Rgn: QRegionH);
824 
CheckGDIObjectnull825 function CheckGDIObject(const AGDIObject: HGDIOBJ; const AMethodName: String; AParamName: String = ''): Boolean;
CheckBitmapnull826 function CheckBitmap(const ABitmap: HBITMAP; const AMethodName: String; AParamName: String = ''): Boolean;
827 
QtDefaultPrinternull828 function QtDefaultPrinter: TQtPrinter;
Clipboardnull829 function Clipboard: TQtClipboard;
QtDefaultContextnull830 function QtDefaultContext: TQtDeviceContext;
QtScreenContextnull831 function QtScreenContext: TQtDeviceContext;
832 
833 procedure AssignQtFont(FromFont: QFontH; ToFont: QFontH);
IsFontEqualnull834 function IsFontEqual(AFont1, AFont2: TQtFont): Boolean;
835 
836 var
837   QtGDIObjects: TQtGDIObjects = nil;
838 
839 implementation
840 
841 uses
842   Controls, qtproc;
843 
844 const
845   ClipbBoardTypeToQtClipboard: array[TClipboardType] of QClipboardMode =
846   (
847 {ctPrimarySelection  } QClipboardSelection,
848 {ctSecondarySelection} QClipboardSelection,
849 {ctClipboard         } QClipboardClipboard
850   );
851 
852 const
853   Rop2CompSupported: Array[Boolean] of TRop2OrCompositionSupport =
854     (rocNotSupported, rocSupported);
855 
856 const
857   SQTWSPrefix = 'TQTWidgetSet.';
858 
859 {$IFDEF HASX11}
860   // defined here to reduce includes (qtint)
861   LCLQt_ClipboardPrimarySelection = QEventType(Ord(QEventUser) + $1004);
862 {$ENDIF}
863 
864 var
865   FClipboard: TQtClipboard = nil;
866   FDefaultContext: TQtDeviceContext = nil;
867   FScreenContext: TQtDeviceContext = nil;
868   FPrinter: TQtPrinter = nil;
869 
870 {------------------------------------------------------------------------------
871   Name:    CheckGDIObject
872   Params:  GDIObject   - Handle to a GDI Object (TQTFont, ...)
873            AMethodName - Method name
874            AParamName  - Param name
875   Returns: If the GDIObject is valid
876 
877   Remark: All handles for GDI objects must be pascal objects so we can
878  distinguish between them
879  ------------------------------------------------------------------------------}
CheckGDIObjectnull880 function CheckGDIObject(const AGDIObject: HGDIOBJ; const AMethodName: String;
881   AParamName: String): Boolean;
882 begin
883   {$note CheckGDIObject TODO: make TQTImage a TQtResource}
884   Result := (TObject(AGDIObject) is TQtResource) or (TObject(AGDIObject) is TQtImage);
885   if Result then Exit;
886 
887   if Pos('.', AMethodName) = 0 then
888     DebugLn(SQTWSPrefix + AMethodName + ' Error - invalid GDIObject ' +
889       AParamName + ' = ' + DbgS(AGDIObject) + '!')
890   else
891     DebugLn(AMethodName + ' Error - invalid GDIObject ' + AParamName + ' = ' +
892       DbgS(AGDIObject) + '!');
893 end;
894 
895 {------------------------------------------------------------------------------
896   Name:    CheckBitmap
897   Params:  Bitmap      - Handle to a bitmap (TQTBitmap)
898            AMethodName - Method name
899            AParamName  - Param name
900   Returns: If the bitmap is valid
901  ------------------------------------------------------------------------------}
CheckBitmapnull902 function CheckBitmap(const ABitmap: HBITMAP; const AMethodName: String;
903   AParamName: String): Boolean;
904 begin
905   Result := TObject(ABitmap) is TQTImage;
906   if Result then Exit;
907 
908   if Pos('.', AMethodName) = 0 then
909     DebugLn(SQTWSPrefix + AMethodName + ' Error - invalid bitmap ' +
910       AParamName + ' = ' + DbgS(ABitmap) + '!')
911   else
912     DebugLn(AMethodName + ' Error - invalid bitmap ' + AParamName + ' = ' +
913       DbgS(ABitmap) + '!');
914 end;
915 
QtDefaultContextnull916 function QtDefaultContext: TQtDeviceContext;
917 begin
918   if FDefaultContext = nil then
919     FDefaultContext := TQtDeviceContext.Create(nil, False);
920   Result := FDefaultContext;
921 end;
922 
QtScreenContextnull923 function QtScreenContext: TQtDeviceContext;
924 begin
925   if FScreenContext = nil then
926     FScreenContext := TQtDeviceContext.Create(QApplication_desktop(), False);
927   Result := FScreenContext;
928 end;
929 
930 procedure AssignQtFont(FromFont: QFontH; ToFont: QFontH);
931 var
932   FntFam: WideString;
933 begin
934   QFont_family(FromFont, @FntFam);
935   QFont_setFamily(ToFont, @FntFam);
936   if QFont_pixelSize(FromFont) > 0 then
937     QFont_setPixelSize(ToFont, QFont_pixelSize(FromFont))
938   else
939     QFont_setPointSize(ToFont, QFont_pointSize(FromFont));
940   QFont_setWeight(ToFont, QFont_weight(FromFont));
941   QFont_setBold(ToFont, QFont_bold(FromFont));
942   QFont_setItalic(ToFont, QFont_italic(FromFont));
943   QFont_setUnderline(ToFont, QFont_underline(FromFont));
944   QFont_setStrikeOut(ToFont, QFont_strikeOut(FromFont));
945   QFont_setStyle(ToFont, QFont_style(FromFont));
946   QFont_setStyleStrategy(ToFont, QFont_styleStrategy(FromFont));
947 end;
948 
IsFontEqualnull949 function IsFontEqual(AFont1, AFont2: TQtFont): Boolean;
950 var
951   AInfo1, AInfo2: TQtFontInfo;
952 begin
953   Result := False;
954   if (AFont1 = nil) or (AFont2 = nil) then
955     exit;
956   if (AFont1.FHandle = nil) or (AFont2.FHandle = nil) then
957     exit;
958   AInfo1 := AFont1.FontInfo;
959   AInfo2 := AFont2.FontInfo;
960   if (AInfo1 = nil) or (AInfo2 = nil) then
961     exit;
962   Result := (AInfo1.Family = AInfo2.Family) and (AInfo1.Bold = AInfo2.Bold) and
963     (AInfo1.Italic = AInfo2.Italic) and (AInfo1.FixedPitch = AInfo2.FixedPitch) and
964     (AInfo1.Underline = AInfo2.Underline) and (AInfo1.Overline = AInfo2.OverLine) and
965     (AInfo1.PixelSize = AInfo2.PixelSize) and (AInfo1.PointSize = AInfo2.PointSize) and
966     (AInfo1.StrikeOut = AInfo2.StrikeOut) and (AInfo1.Weight = AInfo2.Weight) and
967     (AInfo1.RawMode = AInfo2.RawMode) and (AInfo1.Style = AInfo2.Style) and
968     (AInfo1.StyleHint = AInfo2.StyleHint);
969 end;
970 
971 { TQtFontInfo }
972 
TQtFontInfo.GetBoldnull973 function TQtFontInfo.GetBold: Boolean;
974 begin
975   Result := QFontInfo_bold(FHandle);
976 end;
977 
TQtFontInfo.GetExactMatchnull978 function TQtFontInfo.GetExactMatch: Boolean;
979 begin
980   Result := QFontInfo_exactMatch(FHandle);
981 end;
982 
GetFamilynull983 function TQtFontInfo.GetFamily: WideString;
984 var
985   WStr: WideString;
986 begin
987   QFontInfo_family(FHandle, @WStr);
988   Result := UTF8ToUTF16(WStr);
989 end;
990 
TQtFontInfo.GetFixedPitchnull991 function TQtFontInfo.GetFixedPitch: Boolean;
992 begin
993   Result := QFontInfo_fixedPitch(FHandle);
994 end;
995 
TQtFontInfo.GetFontStylenull996 function TQtFontInfo.GetFontStyle: QFontStyle;
997 begin
998   Result := QFontInfo_style(FHandle);
999 end;
1000 
GetFontStyleHintnull1001 function TQtFontInfo.GetFontStyleHint: QFontStyleHint;
1002 begin
1003   Result := QFontInfo_styleHint(FHandle);
1004 end;
1005 
GetItalicnull1006 function TQtFontInfo.GetItalic: Boolean;
1007 begin
1008   Result := QFontInfo_italic(FHandle);
1009 end;
1010 
TQtFontInfo.GetOverLinenull1011 function TQtFontInfo.GetOverLine: Boolean;
1012 begin
1013   Result := QFontInfo_overline(FHandle);
1014 end;
1015 
GetPixelSizenull1016 function TQtFontInfo.GetPixelSize: Integer;
1017 begin
1018   Result := QFontInfo_pixelSize(FHandle);
1019 end;
1020 
TQtFontInfo.GetPointSizenull1021 function TQtFontInfo.GetPointSize: Integer;
1022 begin
1023   Result := QFontInfo_pointSize(FHandle);
1024 end;
1025 
TQtFontInfo.GetRawModenull1026 function TQtFontInfo.GetRawMode: Boolean;
1027 begin
1028   Result := QFontInfo_rawMode(FHandle);
1029 end;
1030 
TQtFontInfo.GetStrikeOutnull1031 function TQtFontInfo.GetStrikeOut: Boolean;
1032 begin
1033   Result := QFontInfo_strikeOut(FHandle);
1034 end;
1035 
GetUnderlinenull1036 function TQtFontInfo.GetUnderline: Boolean;
1037 begin
1038   Result := QFontInfo_underline(FHandle);
1039 end;
1040 
TQtFontInfo.GetWeightnull1041 function TQtFontInfo.GetWeight: Integer;
1042 begin
1043   Result := QFontInfo_weight(FHandle);
1044 end;
1045 
1046 constructor TQtFontInfo.Create(AFont: QFontH);
1047 begin
1048   FHandle := QFontInfo_create(AFont);
1049 end;
1050 
1051 destructor TQtFontInfo.Destroy;
1052 begin
1053   QFontInfo_destroy(FHandle);
1054   inherited Destroy;
1055 end;
1056 
1057 { TQtObject }
1058 
1059 constructor TQtObject.Create;
1060 begin
1061   FDeleteLater := False;
1062   FEventHook := nil;
1063   FUpdateCount := 0;
1064   FInEventCount := 0;
1065   FReleaseInEvent := False;
1066 end;
1067 
1068 destructor TQtObject.Destroy;
1069 begin
1070   if TheObject <> nil then
1071   begin
1072     DetachEvents;
1073     if FDeleteLater then
1074       QObject_deleteLater(TheObject)
1075     else
1076       QObject_destroy(TheObject);
1077     TheObject := nil;
1078   end;
1079   inherited Destroy;
1080 end;
1081 
1082 procedure TQtObject.Release;
1083 begin
1084   if InEvent then
1085   begin
1086     FDeleteLater := True;
1087     FReleaseInEvent := True;
1088   end else
1089     Free;
1090 end;
1091 
1092 procedure TQtObject.AttachEvents;
1093 begin
1094   FEventHook := QObject_hook_create(TheObject);
1095   QObject_hook_hook_events(FEventHook, @EventFilter);
1096   FDestroyedHook := QObject_hook_create(TheObject);
1097   QObject_hook_hook_destroyed(FDestroyedHook, @Destroyed);
1098 end;
1099 
1100 procedure TQtObject.DetachEvents;
1101 begin
1102   if FEventHook <> nil then
1103   begin
1104     QObject_hook_destroy(FEventHook);
1105     FEventHook := nil;
1106   end;
1107   if FDestroyedHook <> nil then
1108   begin
1109     QObject_hook_destroy(FDestroyedHook);
1110     FDestroyedHook := nil;
1111   end;
1112 end;
1113 
1114 procedure TQtObject.Destroyed; cdecl;
1115 begin
1116 end;
1117 
1118 procedure TQtObject.BeginEventProcessing;
1119 begin
1120   inc(FInEventCount);
1121 end;
1122 
1123 procedure TQtObject.EndEventProcessing;
1124 begin
1125   if FInEventCount > 0 then
1126     dec(FInEventCount);
1127   if (FInEventCount = 0) and FReleaseInEvent then
1128     Free;
1129 end;
1130 
InEventnull1131 function TQtObject.InEvent: Boolean;
1132 begin
1133   Result := FInEventCount > 0;
1134 end;
1135 
1136 procedure TQtObject.BeginUpdate;
1137 begin
1138   inc(FUpdateCount);
1139 end;
1140 
1141 procedure TQtObject.EndUpdate;
1142 begin
1143   if FUpdateCount > 0 then
1144     dec(FUpdateCount);
1145 end;
1146 
TQtObject.InUpdatenull1147 function TQtObject.InUpdate: Boolean;
1148 begin
1149   Result := FUpdateCount > 0;
1150 end;
1151 
1152 { TQtAction }
1153 
1154 {------------------------------------------------------------------------------
1155   Method: TQtAction.Create
1156 
1157   Constructor for the class.
1158  ------------------------------------------------------------------------------}
1159 constructor TQtAction.Create(const AHandle: QActionH);
1160 begin
1161   FHandle := AHandle;
1162   FIcon := nil;
1163 end;
1164 
1165 {------------------------------------------------------------------------------
1166   Method: TQtAction.Destroy
1167 
1168   Destructor for the class.
1169  ------------------------------------------------------------------------------}
1170 destructor TQtAction.Destroy;
1171 begin
1172   if FIcon <> nil then
1173     QIcon_destroy(FIcon);
1174 
1175   if FHandle <> nil then
1176     QAction_destroy(FHandle);
1177 
1178   inherited Destroy;
1179 end;
1180 
1181 {------------------------------------------------------------------------------
1182   Method: TQtAction.SlotTriggered
1183 
1184   Callback for menu item click
1185  ------------------------------------------------------------------------------}
1186 procedure TQtAction.SlotTriggered(checked: Boolean); cdecl;
1187 begin
1188   if Assigned(MenuItem) and Assigned(MenuItem.OnClick) then
1189     MenuItem.OnClick(Self.MenuItem);
1190 end;
1191 
1192 {------------------------------------------------------------------------------
1193   Method: TQtAction.setChecked
1194 
1195   Checks or unchecks a menu entry
1196 
1197   To mimic the behavior LCL should have we added code to handle
1198  setCheckable automatically
1199  ------------------------------------------------------------------------------}
1200 procedure TQtAction.setChecked(p1: Boolean);
1201 begin
1202   if p1 then setCheckable(True)
1203   else setCheckable(False);
1204 
1205   QAction_setChecked(FHandle, p1);
1206 end;
1207 
1208 {------------------------------------------------------------------------------
1209   Method: TQtAction.setCheckable
1210 
1211   Set's if a menu can be checked. Is false by default
1212  ------------------------------------------------------------------------------}
1213 procedure TQtAction.setCheckable(p1: Boolean);
1214 begin
1215   QAction_setCheckable(FHandle, p1);
1216 end;
1217 
1218 {------------------------------------------------------------------------------
1219   Method: TQtAction.setEnabled
1220  ------------------------------------------------------------------------------}
1221 procedure TQtAction.setEnabled(p1: Boolean);
1222 begin
1223   QAction_setEnabled(FHandle, p1);
1224 end;
1225 
1226 procedure TQtAction.setIcon(const AIcon: QIconH);
1227 begin
1228   QAction_setIcon(FHandle, AIcon);
1229 end;
1230 
1231 procedure TQtAction.setImage(const AImage: TQtImage);
1232 begin
1233   if FIcon <> nil then
1234   begin
1235     QIcon_destroy(FIcon);
1236     FIcon := nil;
1237   end;
1238 
1239   if AImage <> nil then
1240     FIcon := AImage.AsIcon()
1241   else
1242     FIcon := QIcon_create();
1243 
1244   setIcon(FIcon);
1245 end;
1246 
1247 {------------------------------------------------------------------------------
1248   Method: TQtAction.setVisible
1249  ------------------------------------------------------------------------------}
1250 procedure TQtAction.setVisible(p1: Boolean);
1251 begin
1252   QAction_setVisible(FHandle, p1);
1253 end;
1254 
1255 { TQtImage }
1256 
1257 constructor TQtImage.Create;
1258 begin
1259   FHandle := QImage_create();
1260   FData := nil;
1261   FDataOwner := False;
1262   QtGDIObjects.AddGDIObject(Self);
1263 end;
1264 
1265 {------------------------------------------------------------------------------
1266   Method: TQtImage.Create
1267 
1268   Constructor for the class.
1269  ------------------------------------------------------------------------------}
1270 constructor TQtImage.Create(vHandle: QImageH);
1271 begin
1272   FHandle := vHandle;
1273   FData := nil;
1274   FDataOwner := False;
1275   QtGDIObjects.AddGDIObject(Self);
1276 end;
1277 
1278 {------------------------------------------------------------------------------
1279   Method: TQtImage.Create
1280 
1281   Constructor for the class.
1282  ------------------------------------------------------------------------------}
1283 constructor TQtImage.Create(AData: PByte; width: Integer; height: Integer;
1284   format: QImageFormat; const ADataOwner: Boolean = False);
1285 begin
1286   FData := AData;
1287   FDataOwner := ADataOwner;
1288 
1289   if FData = nil then
1290   begin
1291     FHandle := QImage_create(width, height, format);
1292     QImage_fill(FHandle, 0);
1293   end
1294   else
1295   begin
1296     FHandle := QImage_create(FData, width, height, format);
1297     if format = QImageFormat_Mono then
1298     begin
1299       QImage_setColorCount(FHandle, 2);
1300       {$IFDEF DARWIN}
1301       //rgba
1302       QImage_SetColor(FHandle, 0, $000000FF);
1303       {$ELSE}
1304       //argb
1305       QImage_SetColor(FHandle, 0, $FF000000);
1306       {$ENDIF}
1307       QImage_SetColor(FHandle, 1, $FFFFFFFF);
1308     end;
1309   end;
1310   QtGDIObjects.AddGDIObject(Self);
1311 end;
1312 
1313 constructor TQtImage.Create(AData: PByte; width: Integer; height: Integer;
1314   bytesPerLine: Integer; format: QImageFormat; const ADataOwner: Boolean);
1315 begin
1316   FData := AData;
1317   FDataOwner := ADataOwner;
1318 
1319   if FData = nil then
1320     FHandle := QImage_create(width, height, format)
1321   else
1322   begin
1323     FHandle := QImage_create(FData, width, height, bytesPerLine, format);
1324     if format = QImageFormat_Mono then
1325     begin
1326       QImage_setColorCount(FHandle, 2);
1327       {$IFDEF DARWIN}
1328       // rgba
1329       QImage_SetColor(FHandle, 0, $000000FF);
1330       {$ELSE}
1331       // argb
1332       QImage_SetColor(FHandle, 0, $FF000000);
1333       {$ENDIF}
1334       QImage_SetColor(FHandle, 1, $FFFFFFFF);
1335     end;
1336   end;
1337   QtGDIObjects.AddGDIObject(Self);
1338 end;
1339 
1340 {------------------------------------------------------------------------------
1341   Method: TQtImage.Destroy
1342   Params:  None
1343   Returns: Nothing
1344 
1345   Destructor for the class.
1346  ------------------------------------------------------------------------------}
1347 destructor TQtImage.Destroy;
1348 begin
1349   {$ifdef VerboseQt}
1350     WriteLn('TQtImage.Destroy Handle:', dbgs(Handle));
1351   {$endif}
1352 
1353   QtGDIObjects.RemoveGDIObject(Self);
1354 
1355   if FHandle <> nil then
1356     QImage_destroy(FHandle);
1357   if (FDataOwner) and (FData <> nil) then
1358     FreeMem(FData);
1359 
1360   inherited Destroy;
1361 end;
1362 
TQtImage.AsIconnull1363 function TQtImage.AsIcon(AMode: QIconMode = QIconNormal; AState: QIconState = QIconOff): QIconH;
1364 var
1365   APixmap: QPixmapH;
1366 begin
1367   APixmap := AsPixmap;
1368   Result := QIcon_create();
1369   if Result <> nil then
1370     QIcon_addPixmap(Result, APixmap, AMode, AState);
1371   QPixmap_destroy(APixmap);
1372 end;
1373 
AsPixmapnull1374 function TQtImage.AsPixmap(flags: QtImageConversionFlags = QtAutoColor): QPixmapH;
1375 begin
1376   Result := QPixmap_create();
1377   QPixmap_fromImage(Result, FHandle, flags);
1378 end;
1379 
TQtImage.AsBitmapnull1380 function TQtImage.AsBitmap(flags: QtImageConversionFlags = QtAutoColor): QBitmapH;
1381 begin
1382   Result := QBitmap_create();
1383   QBitmap_fromImage(Result, FHandle, flags);
1384 end;
1385 
1386 procedure TQtImage.CopyFrom(AImage: QImageH; x, y, w, h: integer);
1387 begin
1388   QImage_copy(AImage, FHandle, x, y, w, h);
1389 end;
1390 
1391 {------------------------------------------------------------------------------
1392   Method: TQtImage.height
1393   Params:  None
1394   Returns: The height of the image
1395  ------------------------------------------------------------------------------}
TQtImage.heightnull1396 function TQtImage.height: Integer;
1397 begin
1398   Result := QImage_height(FHandle);
1399 end;
1400 
1401 {------------------------------------------------------------------------------
1402   Method: TQtImage.width
1403   Params:  None
1404   Returns: The width of the image
1405  ------------------------------------------------------------------------------}
TQtImage.widthnull1406 function TQtImage.width: Integer;
1407 begin
1408   Result := QImage_width(FHandle);
1409 end;
1410 
depthnull1411 function TQtImage.depth: Integer;
1412 begin
1413   Result := QImage_depth(FHandle);
1414 end;
1415 
dotsPerMeterXnull1416 function TQtImage.dotsPerMeterX: Integer;
1417 begin
1418   Result := QImage_dotsPerMeterX(FHandle);
1419 end;
1420 
dotsPerMeterYnull1421 function TQtImage.dotsPerMeterY: Integer;
1422 begin
1423   Result := QImage_dotsPerMeterY(FHandle);
1424 end;
1425 
1426 {------------------------------------------------------------------------------
1427   Method: TQtImage.bits
1428   Params:  None
1429   Returns: The internal array of bits of the image
1430  ------------------------------------------------------------------------------}
bitsnull1431 function TQtImage.bits: PByte;
1432 begin
1433   Result := QImage_bits(FHandle);
1434 end;
1435 
1436 {------------------------------------------------------------------------------
1437   Method: TQtImage.numBytes
1438   Params:  None
1439   Returns: The number of bytes the image occupies in memory
1440  ------------------------------------------------------------------------------}
numBytesnull1441 function TQtImage.numBytes: Integer;
1442 begin
1443   Result := QImage_numBytes(FHandle);
1444 end;
1445 
bytesPerLinenull1446 function TQtImage.bytesPerLine: Integer;
1447 begin
1448   Result := QImage_bytesPerLine(FHandle);
1449 end;
1450 
1451 procedure TQtImage.invertPixels(InvertMode: QImageInvertMode = QImageInvertRgb);
1452 begin
1453   QImage_invertPixels(FHandle, InvertMode);
1454 end;
1455 
getFormatnull1456 function TQtImage.getFormat: QImageFormat;
1457 begin
1458   Result := QImage_format(FHandle);
1459 end;
1460 
1461 { TQtFont }
1462 
GetMetricsnull1463 function TQtFont.GetMetrics: TQtFontMetrics;
1464 begin
1465   if FMetrics = nil then
1466   begin
1467     if FHandle = nil then
1468       FMetrics := TQtFontMetrics.Create(getDefaultFont)
1469     else
1470       FMetrics := TQtFontMetrics.Create(FHandle);
1471   end;
1472   Result := FMetrics;
1473 end;
1474 
GetFontInfonull1475 function TQtFont.GetFontInfo: TQtFontInfo;
1476 begin
1477   if not Assigned(FFontInfo) and Assigned(FHandle) then
1478     FFontInfo := TQtFontInfo.Create(FHandle);
1479   Result := FFontInfo;
1480 end;
1481 
1482 {------------------------------------------------------------------------------
1483   Function: TQtFont.GetDefaultFont
1484   Params:  None
1485   Returns: QFontH
1486   If our Widget is nil then we have to ask for default application font.
1487  ------------------------------------------------------------------------------}
TQtFont.GetDefaultFontnull1488 function TQtFont.GetDefaultFont: QFontH;
1489 begin
1490   if FDefaultFont = nil then
1491   begin
1492     FDefaultFont := QFont_create();
1493     QApplication_font(FDefaultFont);
1494   end;
1495   Result := FDefaultFont;
1496 end;
1497 
1498 {------------------------------------------------------------------------------
1499   Function: TQtFont.Create
1500   Params:  None
1501   Returns: Nothing
1502  ------------------------------------------------------------------------------}
1503 constructor TQtFont.Create(CreateHandle: Boolean);
1504 begin
1505   {$ifdef VerboseQt}
1506     WriteLn('TQtFont.Create CreateHandle: ', dbgs(CreateHandle));
1507   {$endif}
1508 
1509   if CreateHandle then
1510     FHandle := QFont_create
1511   else
1512     FHandle := nil;
1513 
1514   FShared := False;
1515   FMetrics := nil;
1516   FDefaultFont := nil;
1517   FFontInfo := nil;
1518   QtGDIObjects.AddGDIObject(Self);
1519 end;
1520 
1521 constructor TQtFont.Create(AFromFont: QFontH);
1522 begin
1523   {$ifdef VerboseQt}
1524     WriteLn('TQtFont.Create AFromFont: ', dbgs(AFromFont));
1525   {$endif}
1526 
1527   FHandle := QFont_create(AFromFont);
1528   FShared := False;
1529   FMetrics := nil;
1530   FDefaultFont := nil;
1531   GetFontInfo;
1532   QtGDIObjects.AddGDIObject(Self);
1533 end;
1534 
1535 {------------------------------------------------------------------------------
1536   Function: TQtFont.Destroy
1537   Params:  None
1538   Returns: Nothing
1539  ------------------------------------------------------------------------------}
1540 destructor TQtFont.Destroy;
1541 begin
1542   {$ifdef VerboseQt}
1543     WriteLn('TQtFont.Destroy');
1544   {$endif}
1545 
1546   QtGDIObjects.RemoveGDIObject(Self);
1547 
1548   if FMetrics <> nil then
1549     FMetrics.Free;
1550 
1551   if FFontInfo <> nil then
1552     FFontInfo.Free;
1553 
1554   if not FShared and (FHandle <> nil) then
1555     QFont_destroy(FHandle);
1556 
1557   if FDefaultFont <> nil then
1558     QFont_destroy(FDefaultFont);
1559 
1560 
1561   inherited Destroy;
1562 end;
1563 
getPointSizenull1564 function TQtFont.getPointSize: Integer;
1565 begin
1566   if FHandle = nil then
1567     Result := QFont_pointSize(getDefaultFont)
1568   else
1569     Result := QFont_pointSize(FHandle);
1570 end;
1571 
1572 procedure TQtFont.setPointSize(p1: Integer);
1573 begin
1574   if p1 > 0 then
1575     QFont_setPointSize(FHandle, p1);
1576 end;
1577 
TQtFont.getPixelSizenull1578 function TQtFont.getPixelSize: Integer;
1579 begin
1580   if FHandle = nil then
1581     Result := QFont_pixelSize(getDefaultFont)
1582   else
1583     Result := QFont_pixelSize(FHandle);
1584 end;
1585 
1586 procedure TQtFont.setPixelSize(p1: Integer);
1587 begin
1588   if p1 > 0 then
1589     QFont_setPixelSize(FHandle, p1);
1590 end;
1591 
TQtFont.getWeightnull1592 function TQtFont.getWeight: Integer;
1593 begin
1594   if FHandle = nil then
1595     Result := QFont_weight(getDefaultFont)
1596   else
1597     Result := QFont_weight(FHandle);
1598 end;
1599 
getItalicnull1600 function TQtFont.getItalic: Boolean;
1601 begin
1602   if FHandle = nil then
1603     Result := QFont_italic(getDefaultFont)
1604   else
1605     Result := QFont_italic(FHandle);
1606 end;
1607 
getBoldnull1608 function TQtFont.getBold: Boolean;
1609 begin
1610   if FHandle = nil then
1611     Result := QFont_bold(getDefaultFont)
1612   else
1613     Result := QFont_bold(FHandle);
1614 end;
1615 
getUnderlinenull1616 function TQtFont.getUnderline: Boolean;
1617 begin
1618   if FHandle = nil then
1619     Result := QFont_underline(getDefaultFont)
1620   else
1621     Result := QFont_underline(FHandle);
1622 end;
1623 
TQtFont.getStrikeOutnull1624 function TQtFont.getStrikeOut: Boolean;
1625 begin
1626   if FHandle = nil then
1627     Result := QFont_strikeOut(getDefaultFont)
1628   else
1629     Result := QFont_strikeOut(FHandle);
1630 end;
1631 
getFamilynull1632 function TQtFont.getFamily: WideString;
1633 begin
1634   if FHandle = nil then
1635     QFont_family(getDefaultFont, @Result)
1636   else
1637     QFont_family(FHandle, @Result);
1638 end;
1639 
TQtFont.getStyleStategynull1640 function TQtFont.getStyleStategy: QFontStyleStrategy;
1641 begin
1642   if FHandle = nil then
1643     Result := QFont_styleStrategy(getDefaultFont)
1644   else
1645     Result := QFont_styleStrategy(FHandle);
1646 end;
1647 
1648 procedure TQtFont.setWeight(p1: Integer);
1649 begin
1650   QFont_setWeight(FHandle, p1);
1651 end;
1652 
1653 procedure TQtFont.setBold(p1: Boolean);
1654 begin
1655   QFont_setBold(FHandle, p1);
1656 end;
1657 
1658 procedure TQtFont.setItalic(b: Boolean);
1659 begin
1660   QFont_setItalic(FHandle, b);
1661 end;
1662 
1663 procedure TQtFont.setUnderline(p1: Boolean);
1664 begin
1665   QFont_setUnderline(FHandle, p1);
1666 end;
1667 
1668 procedure TQtFont.setStrikeOut(p1: Boolean);
1669 begin
1670   QFont_setStrikeOut(FHandle, p1);
1671 end;
1672 
1673 procedure TQtFont.setRawName(p1: string);
1674 var
1675   Str: WideString;
1676 begin
1677   Str := GetUtf8String(p1);
1678 
1679   QFont_setRawName(FHandle, @Str);
1680 end;
1681 
1682 procedure TQtFont.setFamily(p1: string);
1683 var
1684   Str: WideString;
1685 begin
1686   Str := GetUtf8String(p1);
1687 
1688   QFont_setFamily(FHandle, @Str);
1689 end;
1690 
1691 procedure TQtFont.setStyleStrategy(s: QFontStyleStrategy);
1692 begin
1693   QFont_setStyleStrategy(FHandle, s);
1694 end;
1695 
1696 procedure TQtFont.family(retval: PWideString);
1697 begin
1698   if FHandle = nil then
1699     QFont_family(getDefaultFont, retval)
1700   else
1701     QFont_family(FHandle, retval);
1702 end;
1703 
TQtFont.fixedPitchnull1704 function TQtFont.fixedPitch: Boolean;
1705 begin
1706   if FHandle = nil then
1707     Result := QFont_fixedPitch(getDefaultFont)
1708   else
1709     Result := QFont_fixedPitch(FHandle);
1710 end;
1711 
1712 { TQtFontMetrics }
1713 
1714 constructor TQtFontMetrics.Create(Parent: QFontH);
1715 begin
1716   FHandle := QFontMetrics_create(Parent);
1717 end;
1718 
1719 destructor TQtFontMetrics.Destroy;
1720 begin
1721   QFontMetrics_destroy(FHandle);
1722   FHandle := nil;
1723 
1724   inherited Destroy;
1725 end;
1726 
TQtFontMetrics.heightnull1727 function TQtFontMetrics.height: Integer;
1728 begin
1729   Result := QFontMetrics_height(FHandle);
1730 end;
1731 
widthnull1732 function TQtFontMetrics.width(p1: PWideString): Integer;
1733 begin
1734   Result := QFontMetrics_width(FHandle, p1);
1735 end;
1736 
widthnull1737 function TQtFontMetrics.width(p1: PWideString; ALen: Integer): Integer;
1738 begin
1739   Result := QFontMetrics_width(FHandle, p1, ALen);
1740 end;
1741 
ascentnull1742 function TQtFontMetrics.ascent: Integer;
1743 begin
1744   Result := QFontMetrics_ascent(FHandle);
1745 end;
1746 
descentnull1747 function TQtFontMetrics.descent: Integer;
1748 begin
1749   Result := QFontMetrics_descent(FHandle);
1750 end;
1751 
leadingnull1752 function TQtFontMetrics.leading: Integer;
1753 begin
1754   Result := QFontMetrics_leading(FHandle);
1755 end;
1756 
maxWidthnull1757 function TQtFontMetrics.maxWidth: Integer;
1758 begin
1759   Result := QFontMetrics_maxWidth(FHandle);
1760 end;
1761 
1762 procedure TQtFontMetrics.boundingRect(retval: PRect; r: PRect; flags: Integer; text: PWideString; tabstops: Integer = 0; tabarray: PInteger = nil);
1763 begin
1764   QFontMetrics_boundingRect(FHandle, retval, r, flags, text, tabstops, tabarray);
1765 end;
1766 
charWidthnull1767 function TQtFontMetrics.charWidth(str: WideString; pos: Integer): Integer;
1768 begin
1769   Result := QFontMetrics_charWidth(FHandle, @str, pos);
1770 end;
1771 
averageCharWidthnull1772 function TQtFontMetrics.averageCharWidth: Integer;
1773 begin
1774   Result := QFontMetrics_averageCharWidth(FHandle);
1775 end;
1776 
elidedTextnull1777 function TQtFontMetrics.elidedText(const AText: WideString;
1778   const AMode: QtTextElideMode; const AWidth: Integer;
1779   const AFlags: Integer = 0): WideString;
1780 begin
1781   QFontMetrics_elidedText(FHandle, @Result, @AText, AMode, AWidth, AFlags);
1782 end;
1783 
1784 { TQtBrush }
1785 
1786 {------------------------------------------------------------------------------
1787   Function: TQtBrush.Create
1788   Params:  None
1789   Returns: Nothing
1790  ------------------------------------------------------------------------------}
1791 constructor TQtBrush.Create(CreateHandle: Boolean);
1792 begin
1793   // Creates the widget
1794   {$ifdef VerboseQt}
1795     WriteLn('TQtBrush.Create CreateHandle: ', dbgs(CreateHandle));
1796   {$endif}
1797 
1798   if CreateHandle then
1799     FHandle := QBrush_create
1800   else
1801     FHandle := nil;
1802 
1803   FShared := False;
1804   FSelected := False;
1805   QtGDIObjects.AddGDIObject(Self);
1806 end;
1807 
1808 constructor TQtBrush.CreateWithRadialGradient(ALogBrush: TLogRadialGradient);
1809 var
1810   i: Integer;
1811   lColor: PQColor;
1812   lR, lG, lB, lA: Double;
1813 begin
1814   FRadialGradient := QRadialGradient_create(
1815     ALogBrush.radCenterX, ALogBrush.radCenterY, ALogBrush.radCenterY,
1816     ALogBrush.radFocalX, ALogBrush.radFocalY);
1817   for i := 0 to Length(ALogBrush.radStops) - 1 do
1818   begin
1819     lR := ALogBrush.radStops[i].radColorR / $FFFF;
1820     lG := ALogBrush.radStops[i].radColorG / $FFFF;
1821     lB := ALogBrush.radStops[i].radColorB / $FFFF;
1822     lA := ALogBrush.radStops[i].radColorA / $FFFF;
1823     QColor_fromRgbF(lColor, lR, lG, lB, lA);
1824     QGradient_setColorAt(FRadialGradient, ALogBrush.radStops[i].radPosition, lColor);
1825   end;
1826 
1827   FHandle := QBrush_create(FRadialGradient);
1828 end;
1829 
1830 {------------------------------------------------------------------------------
1831   Function: TQtBrush.Destroy
1832   Params:  None
1833   Returns: Nothing
1834  ------------------------------------------------------------------------------}
1835 destructor TQtBrush.Destroy;
1836 begin
1837   {$ifdef VerboseQt}
1838     WriteLn('TQtBrush.Destroy');
1839   {$endif}
1840 
1841   QtGDIObjects.RemoveGDIObject(Self);
1842 
1843   if not FShared and (FHandle <> nil) and not FSelected then
1844     QBrush_destroy(FHandle);
1845 
1846   inherited Destroy;
1847 end;
1848 
TQtBrush.getColornull1849 function TQtBrush.getColor: PQColor;
1850 begin
1851   Result := QBrush_Color(FHandle);
1852 end;
1853 
GetLBStylenull1854 function TQtBrush.GetLBStyle(out AStyle: LongWord; out AHatch: PtrUInt
1855   ): Boolean;
1856 begin
1857   Result := FHandle <> nil;
1858   if not Result then
1859     exit;
1860 
1861   AStyle := BS_SOLID;
1862   if Style in [QtHorPattern, QtVerPattern, QtCrossPattern,
1863                     QtBDiagPattern, QtFDiagPattern, QtDiagCrossPattern] then
1864     AStyle := BS_HATCHED
1865   else
1866     AHatch := 0;
1867   case Style of
1868     QtNoBrush: AStyle := BS_NULL;
1869     QtHorPattern: AHatch := HS_HORIZONTAL;
1870     QtVerPattern: AHatch := HS_VERTICAL;
1871     QtCrossPattern: AHatch := HS_CROSS;
1872     QtBDiagPattern: AHatch := HS_BDIAGONAL;
1873     QtFDiagPattern: AHatch := HS_FDIAGONAL;
1874     QtDiagCrossPattern: AHatch := HS_DIAGCROSS;
1875     QtTexturePattern: AStyle := BS_PATTERN;
1876   end;
1877 end;
1878 
1879 procedure TQtBrush.setColor(AColor: PQColor);
1880 begin
1881   QBrush_setColor(FHandle, AColor);
1882 end;
1883 
getStylenull1884 function TQtBrush.getStyle: QtBrushStyle;
1885 begin
1886   Result := QBrush_style(FHandle);
1887 end;
1888 
1889 {------------------------------------------------------------------------------
1890   Function: TQtBrush.setStyle
1891   Params:  None
1892   Returns: Nothing
1893  ------------------------------------------------------------------------------}
1894 procedure TQtBrush.setStyle(style: QtBrushStyle);
1895 begin
1896   QBrush_setStyle(FHandle, style);
1897 end;
1898 
1899 procedure TQtBrush.setTexture(pixmap: QPixmapH);
1900 begin
1901   QBrush_setTexture(FHandle, pixmap);
1902 end;
1903 
1904 procedure TQtBrush.setTextureImage(image: QImageH);
1905 var
1906   TempImage: QImageH;
1907 begin
1908   // workaround thurther deletion of original image
1909   // When image is deleted its data will be deleted too
1910   // If image has been created with predefined data then it will be owner of it
1911   // => it will Free owned data => brush will be invalid
1912   // as workaround we are copying an original image so qt create new image with own data
1913   TempImage := QImage_create();
1914   QImage_copy(image, TempImage, 0, 0, QImage_width(image), QImage_height(image));
1915   QBrush_setTextureImage(FHandle, TempImage);
1916   QImage_destroy(TempImage);
1917 end;
1918 
1919 { TQtPen }
1920 
1921 {------------------------------------------------------------------------------
1922   Function: TQtPen.Create
1923   Params:  None
1924   Returns: Nothing
1925  ------------------------------------------------------------------------------}
1926 constructor TQtPen.Create(CreateHandle: Boolean);
1927 begin
1928   {$ifdef VerboseQt}
1929     WriteLn('TQtPen.Create CreateHandle: ', dbgs(CreateHandle));
1930   {$endif}
1931 
1932   if CreateHandle then
1933     FHandle := QPen_create
1934   else
1935     FHandle := nil;
1936   FShared := False;
1937   FIsExtPen := False;
1938   QtGDIObjects.AddGDIObject(Self);
1939 end;
1940 
1941 {------------------------------------------------------------------------------
1942   Function: TQtPen.Destroy
1943   Params:  None
1944   Returns: Nothing
1945  ------------------------------------------------------------------------------}
1946 destructor TQtPen.Destroy;
1947 begin
1948   {$ifdef VerboseQt}
1949     WriteLn('TQtPen.Destroy');
1950   {$endif}
1951 
1952   QtGDIObjects.RemoveGDIObject(Self);
1953 
1954   if not FShared and (FHandle <> nil) then
1955     QPen_destroy(FHandle);
1956 
1957   inherited Destroy;
1958 end;
1959 
getCapStylenull1960 function TQtPen.getCapStyle: QtPenCapStyle;
1961 begin
1962   Result := QPen_capStyle(FHandle);
1963 end;
1964 
TQtPen.getWidthnull1965 function TQtPen.getWidth: Integer;
1966 begin
1967   Result := QPen_width(FHandle);
1968 end;
1969 
getStylenull1970 function TQtPen.getStyle: QtPenStyle;
1971 begin
1972   Result := QPen_style(FHandle);
1973 end;
1974 
getDashPatternnull1975 function TQtPen.getDashPattern: TQRealArray;
1976 begin
1977   QPen_dashPattern(FHandle, @Result);
1978 end;
1979 
1980 {------------------------------------------------------------------------------
1981   Function: TQtPen.setBrush
1982   Params:  None
1983   Returns: Nothing
1984  ------------------------------------------------------------------------------}
1985 
1986 procedure TQtPen.setBrush(brush: QBrushH);
1987 begin
1988   QPen_setBrush(FHandle, brush);
1989 end;
1990 
1991 {------------------------------------------------------------------------------
1992   Function: TQtPen.setStyle
1993   Params:  None
1994   Returns: Nothing
1995  ------------------------------------------------------------------------------}
1996 procedure TQtPen.setStyle(AStyle: QtPenStyle);
1997 begin
1998   QPen_setStyle(FHandle, AStyle);
1999 end;
2000 
2001 {------------------------------------------------------------------------------
2002   Function: TQtPen.setWidth
2003   Params:  None
2004   Returns: Nothing
2005  ------------------------------------------------------------------------------}
2006 procedure TQtPen.setWidth(p1: Integer);
2007 begin
2008   QPen_setWidth(FHandle, p1);
2009 end;
2010 
2011 procedure TQtPen.setDashPattern(APattern: PDWord; ALength: DWord);
2012 var
2013   QtPattern: TQRealArray;
2014   i: integer;
2015 begin
2016   SetLength(QtPattern, ALength);
2017   for i := 0 to ALength - 1 do
2018     QtPattern[i] := APattern[i];
2019   QPen_setDashPattern(FHandle, @QtPattern);
2020 end;
2021 
2022 procedure TQtPen.setJoinStyle(pcs: QtPenJoinStyle);
2023 begin
2024   QPen_setJoinStyle(FHandle, pcs);
2025 end;
2026 
TQtPen.getColornull2027 function TQtPen.getColor: TQColor;
2028 begin
2029   QPen_color(FHandle, @Result);
2030 end;
2031 
TQtPen.getCosmeticnull2032 function TQtPen.getCosmetic: Boolean;
2033 begin
2034   Result := QPen_isCosmetic(FHandle);
2035 end;
2036 
getJoinStylenull2037 function TQtPen.getJoinStyle: QtPenJoinStyle;
2038 begin
2039   Result := QPen_joinStyle(FHandle);
2040 end;
2041 
2042 procedure TQtPen.setCapStyle(pcs: QtPenCapStyle);
2043 begin
2044   QPen_setCapStyle(FHandle, pcs);
2045 end;
2046 
2047 
2048 {------------------------------------------------------------------------------
2049   Function: TQtPen.setColor
2050   Params:  p1: TQColor
2051   Returns: Nothing
2052   Setting pen color.
2053  ------------------------------------------------------------------------------}
2054 procedure TQtPen.setColor(p1: TQColor);
2055 begin
2056   QPen_setColor(FHandle, @p1);
2057 end;
2058 
2059 procedure TQtPen.setCosmetic(b: Boolean);
2060 begin
2061   QPen_setCosmetic(FHandle, b);
2062 end;
2063 
2064 
2065 { TQtRegion }
2066 
2067 {------------------------------------------------------------------------------
2068   Function: TQtRegion.Create
2069   Params:  CreateHandle: Boolean
2070   Returns: Nothing
2071  ------------------------------------------------------------------------------}
2072 constructor TQtRegion.Create(CreateHandle: Boolean);
2073 begin
2074   {$ifdef VerboseQt}
2075     WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
2076   {$endif}
2077   FPolygon := nil;
2078   // Creates the widget
2079   if CreateHandle then
2080     FHandle := QRegion_create()
2081   else
2082     FHandle := nil;
2083   QtGDIObjects.AddGDIObject(Self);
2084 end;
2085 
2086 {------------------------------------------------------------------------------
2087   Function: TQtRegion.Create (CreateRectRgn)
2088   Params:  CreateHandle: Boolean; X1,Y1,X2,Y2:Integer
2089   Returns: Nothing
2090  ------------------------------------------------------------------------------}
2091 constructor TQtRegion.Create(CreateHandle: Boolean; X1,Y1,X2,Y2:Integer;
2092   Const RegionType: QRegionRegionType = QRegionRectangle);
2093 var
2094   W, H: Integer;
2095 begin
2096   {$ifdef VerboseQt}
2097     WriteLn('TQtRegion.Create CreateHandle: ', dbgs(CreateHandle));
2098   {$endif}
2099   FPolygon := nil;
2100   // Creates the widget
2101   // Note that QRegion_create expects a width and a height,
2102   // and not a X2, Y2 bottom-right point
2103   if CreateHandle then
2104   begin
2105     W := X2 - X1;
2106     H := Y2 - Y1;
2107     if W < 0 then
2108       W := 0;
2109     if H < 0 then
2110       H := 0;
2111     FHandle := QRegion_create(X1, Y1, W, H, RegionType);
2112   end else
2113     FHandle := nil;
2114   QtGDIObjects.AddGDIObject(Self);
2115 end;
2116 
2117 constructor TQtRegion.Create(CreateHandle: Boolean; Poly: QPolygonH;
2118   Const Fill: QtFillRule = QtWindingFill);
2119 begin
2120   {$ifdef VerboseQt}
2121     WriteLn('TQtRegion.Create polyrgn CreateHandle: ', dbgs(CreateHandle));
2122   {$endif}
2123   FPolygon := nil;
2124   if CreateHandle then
2125   begin
2126     FPolygon := QPolygon_create(Poly);
2127     FHandle := QRegion_create(FPolygon, Fill);
2128   end else
2129     FHandle := nil;
2130   QtGDIObjects.AddGDIObject(Self);
2131 end;
2132 
2133 
2134 {------------------------------------------------------------------------------
2135   Function: TQtRegion.Destroy
2136   Params:  None
2137   Returns: Nothing
2138  ------------------------------------------------------------------------------}
2139 destructor TQtRegion.Destroy;
2140 begin
2141   {$ifdef VerboseQt}
2142     WriteLn('TQtRegion.Destroy');
2143   {$endif}
2144   QtGDIObjects.RemoveGDIObject(Self);
2145   if FPolygon <> nil then
2146     QPolygon_destroy(FPolygon);
2147   if FHandle <> nil then
2148     QRegion_destroy(FHandle);
2149 
2150   inherited Destroy;
2151 end;
2152 
TQtRegion.GetIsPolyRegionnull2153 function TQtRegion.GetIsPolyRegion: Boolean;
2154 begin
2155   Result := FPolygon <> nil;
2156 end;
2157 
containsPointnull2158 function TQtRegion.containsPoint(X, Y: Integer): Boolean;
2159 var
2160   P: TQtPoint;
2161 begin
2162   P.X := X;
2163   P.Y := Y;
2164   Result := QRegion_contains(FHandle, PQtPoint(@P));
2165 end;
2166 
TQtRegion.containsRectnull2167 function TQtRegion.containsRect(R: TRect): Boolean;
2168 begin
2169   Result := QRegion_contains(FHandle, PRect(@R));
2170 end;
2171 
intersectsnull2172 function TQtRegion.intersects(R: TRect): Boolean;
2173 begin
2174   Result := QRegion_intersects(FHandle, PRect(@R));
2175 end;
2176 
intersectsnull2177 function TQtRegion.intersects(Rgn: QRegionH): Boolean;
2178 begin
2179   Result := QRegion_intersects(FHandle, Rgn);
2180 end;
2181 
TQtRegion.GetRegionTypenull2182 function TQtRegion.GetRegionType: integer;
2183 begin
2184   try
2185     if not IsPolyRegion and QRegion_isEmpty(FHandle) then
2186       Result := NULLREGION
2187     else
2188     begin
2189       if IsPolyRegion or (QRegion_numRects(FHandle) > 1) then
2190         Result := COMPLEXREGION
2191       else
2192         Result := SIMPLEREGION;
2193     end;
2194   except
2195     Result := ERROR;
2196   end;
2197 end;
2198 
getBoundingRectnull2199 function TQtRegion.getBoundingRect: TRect;
2200 begin
2201   if IsPolyRegion then
2202     QPolygon_boundingRect(FPolygon, @Result)
2203   else
2204     QRegion_boundingRect(FHandle, @Result);
2205 end;
2206 
numRectsnull2207 function TQtRegion.numRects: Integer;
2208 begin
2209   Result := QRegion_numRects(FHandle);
2210 end;
2211 
2212 procedure TQtRegion.translate(dx, dy: Integer);
2213 begin
2214   QRegion_translate(FHandle, dx, dy);
2215 end;
2216 
2217 { TQtDeviceContext }
2218 
2219 {------------------------------------------------------------------------------
2220   Function: TQtDeviceContext.Create
2221   Params:  None
2222   Returns: Nothing
2223  ------------------------------------------------------------------------------}
2224 constructor TQtDeviceContext.Create(AWidget: QWidgetH; const APaintEvent: Boolean = False);
2225 var
2226   W: Integer;
2227   H: Integer;
2228 begin
2229   {$ifdef VerboseQt}
2230     WriteLn('TQtDeviceContext.Create (',
2231      ' WidgetHandle: ', dbghex(PtrInt(AWidget)),
2232      ' FromPaintEvent:',BoolToStr(APaintEvent),' )');
2233   {$endif}
2234 
2235   {NOTE FOR QT DEVELOPERS: Whenever you call TQtDeviceContext.Create() outside
2236    of TQtWidgetSet.BeginPaint() SET APaintEvent TO FALSE !}
2237   FUserDC := False;
2238   Parent := nil;
2239   ParentPixmap := nil;
2240   FMetrics := nil;
2241   SelFont := nil;
2242   SelBrush := nil;
2243   SelPen := nil;
2244 
2245   if AWidget = nil then
2246   begin
2247     ParentPixmap := QPixmap_Create(10, 10);
2248     Widget := QPainter_Create(QPaintDeviceH(ParentPixmap));
2249   end else
2250   begin
2251     Parent := AWidget;
2252     if not APaintEvent then
2253     begin
2254       {avoid paints on null pixmaps !}
2255       W := QWidget_width(Parent);
2256       H := QWidget_height(Parent);
2257 
2258       if W <= 0 then W := 1;
2259       if H <= 0 then H := 1;
2260 
2261       ParentPixmap := QPixmap_Create(W, H);
2262       Widget := QPainter_create(QPaintDeviceH(ParentPixmap));
2263     end else
2264       Widget := QPainter_create(QWidget_to_QPaintDevice(Parent));
2265   end;
2266   {$IFDEF USEQT4COMPATIBILEPAINTER}
2267   QPainter_setRenderHint(Widget, QPainterQt4CompatiblePainting);
2268   {$ENDIF}
2269   FRopMode := R2_COPYPEN;
2270   FOwnPainter := True;
2271   CreateObjects;
2272   FPenPos.X := 0;
2273   FPenPos.Y := 0;
2274 end;
2275 
2276 constructor TQtDeviceContext.CreatePrinterContext(ADevice: QPrinterH);
2277 begin
2278   FUserDC := False;
2279   SelFont := nil;
2280   SelBrush := nil;
2281   SelPen := nil;
2282   FMetrics := nil;
2283   Parent := nil;
2284   Widget := QPainter_Create(ADevice);
2285   {$IFDEF USEQT4COMPATIBILEPAINTER}
2286   QPainter_setRenderHint(Widget, QPainterQt4CompatiblePainting);
2287   {$ENDIF}
2288   FRopMode := R2_COPYPEN;
2289   FOwnPainter := True;
2290   CreateObjects;
2291   FPenPos.X := 0;
2292   FPenPos.Y := 0;
2293 end;
2294 
2295 constructor TQtDeviceContext.CreateFromPainter(APainter: QPainterH);
2296 begin
2297   FUserDC := False;
2298   SelFont := nil;
2299   SelBrush := nil;
2300   SelPen := nil;
2301   FMetrics := nil;
2302   FRopMode := R2_COPYPEN;
2303   Widget := APainter;
2304   Parent := nil;
2305   FOwnPainter := False;
2306   CreateObjects;
2307 end;
2308 
2309 {------------------------------------------------------------------------------
2310   Function: TQtDeviceContext.Destroy
2311   Params:  None
2312   Returns: Nothing
2313  ------------------------------------------------------------------------------}
2314 destructor TQtDeviceContext.Destroy;
2315 begin
2316   {$ifdef VerboseQt}
2317     WriteLn('TQtDeviceContext.Destroy');
2318   {$endif}
2319 
2320   if (vClipRect <> nil) then
2321     dispose(vClipRect);
2322 
2323   if FMetrics <> nil then
2324     FreeThenNil(FMetrics);
2325 
2326   DestroyObjects;
2327 
2328   if (Widget <> nil) and FOwnPainter then
2329   begin
2330     QPainter_destroy(Widget);
2331     Widget := nil;
2332   end;
2333 
2334   if ParentPixmap <> nil then
2335   begin
2336     QPixmap_destroy(ParentPixmap);
2337     ParentPixmap := nil;
2338   end;
2339 
2340   inherited Destroy;
2341 end;
2342 
2343 procedure TQtDeviceContext.CreateObjects;
2344 begin
2345   FSupportComposition := rocUndefined;
2346   FSupportRasterOps := rocUndefined;
2347 
2348   vFont := TQtFont.Create(False);
2349   vFont.Owner := Self;
2350 
2351   vBrush := TQtBrush.Create(False);
2352   vBrush.Owner := Self;
2353 
2354   vPen := TQtPen.Create(False);
2355   vPen.Owner := Self;
2356 
2357   vRegion := TQtRegion.Create(False);
2358   vRegion.Owner := Self;
2359 
2360   vBackgroundBrush := TQtBrush.Create(False);
2361   vBackgroundBrush.Owner := Self;
2362 
2363   vTextColor := ColorToRGB(clWindowText);
2364 
2365   vMapMode := MM_TEXT;
2366 end;
2367 
2368 procedure TQtDeviceContext.DestroyObjects;
2369 begin
2370   // vFont creates widget and copies font into it => we should destroy it
2371   //vFont.Widget := nil;
2372   FreeAndNil(vFont);
2373   //WriteLn('Destroying brush: ', PtrUInt(vBrush), ' ', ClassName, ' ', PtrUInt(Self));
2374   vBrush.FHandle := nil;
2375   FreeAndNil(vBrush);
2376   vPen.FHandle := nil;
2377   FreeAndNil(vPen);
2378   if vRegion.FHandle <> nil then
2379   begin
2380     QRegion_destroy(vRegion.FHandle);
2381     vRegion.FHandle := nil;
2382   end;
2383   FreeAndNil(vRegion);
2384   vBackgroundBrush.FHandle := nil;
2385   FreeAndNil(vBackgroundBrush);
2386 end;
2387 
2388 {------------------------------------------------------------------------------
2389   Function: TQtDeviceContext.DebugClipRect
2390   Params:  None
2391   Returns: Nothing
2392  ------------------------------------------------------------------------------}
2393 procedure TQtDeviceContext.DebugClipRect(const msg: string);
2394 var
2395   Rgn: QRegionH;
2396   ok: boolean;
2397 begin
2398   ok := getClipping;
2399   Write(Msg, 'DC: HasClipping=', ok);
2400 
2401   if Ok then
2402   begin
2403     Rgn := QRegion_Create;
2404     QPainter_ClipRegion(Widget, Rgn);
2405     DebugRegion('', Rgn);
2406     QRegion_Destroy(Rgn);
2407   end
2408   else
2409     WriteLn;
2410 end;
2411 
2412 {------------------------------------------------------------------------------
2413   Function: TQtDeviceContext.setImage
2414   Params:  None
2415   Returns: Nothing
2416 
2417   This function will destroy the previous DC handle and generate
2418  a new one based on an image. This is necessary because when painting
2419  is being done to a TBitmap, LCL will create a completely abstract DC,
2420  using GetDC(0), and latter use SelectObject to associate that DC
2421  with the Image.
2422  ------------------------------------------------------------------------------}
2423 procedure TQtDeviceContext.setImage(AImage: TQtImage);
2424 begin
2425   {$ifdef VerboseQt}
2426   writeln('TQtDeviceContext.setImage() ');
2427   {$endif}
2428   vImage := AImage;
2429 
2430   QPainter_destroy(Widget);
2431 
2432   Widget := QPainter_Create(vImage.FHandle);
2433   {$IFDEF USEQT4COMPATIBILEPAINTER}
2434   QPainter_setRenderHint(Widget, QPainterQt4CompatiblePainting);
2435   {$ENDIF}
2436 end;
2437 
2438 {------------------------------------------------------------------------------
2439   Function: TQtDeviceContext.CorrectCoordinates
2440   Params:  None
2441   Returns: Nothing
2442 
2443   If you draw an image with negative coordinates
2444  (for example x: -50 y: -50 w: 100 h: 100), the result is not well
2445  defined in Qt, and could well be: (x: 0 y: 0 w: 100 h: 100)
2446   This method corrects the coordinates, cutting the result, so we draw:
2447  (x: 0 y: 0 w: 50 h: 50)
2448  ------------------------------------------------------------------------------}
2449 procedure TQtDeviceContext.CorrectCoordinates(var ARect: TRect);
2450 begin
2451   if ARect.Left < 0 then ARect.Left := 0;
2452 
2453   if ARect.Top < 0 then ARect.Top := 0;
2454 
2455 {  if ARect.Right > MaxRight then ARect.Right := MaxRight;
2456 
2457   if ARect.Bottom > MaxBottom then ARect.Bottom := MaxBottom;}
2458 end;
2459 
TQtDeviceContext.GetLineLastPixelPosnull2460 function TQtDeviceContext.GetLineLastPixelPos(PrevPos, NewPos: TPoint): TPoint;
2461 begin
2462   Result := NewPos;
2463 
2464   if NewPos.X > PrevPos.X then
2465     dec(Result.X)
2466   else
2467   if NewPos.X < PrevPos.X then
2468     inc(Result.X);
2469 
2470   if NewPos.Y > PrevPos.Y then
2471     dec(Result.Y)
2472   else
2473   if NewPos.Y < PrevPos.Y then
2474     inc(Result.Y);
2475 end;
2476 
2477 procedure TQtDeviceContext.qDrawPlainRect(x, y, w, h: integer; AColor: PQColor = nil;
2478   lineWidth: Integer = 1; FillBrush: QBrushH = nil);
2479 begin
2480   if AColor = nil then
2481     AColor := BackgroundBrush.getColor;
2482   // stop asserts from qtlib
2483   if (w < x) or (h < y) then
2484     exit;
2485   q_DrawPlainRect(Widget, x, y, w, h, AColor, lineWidth, FillBrush);
2486 end;
2487 
2488 procedure TQtDeviceContext.qDrawShadeRect(x, y, w, h: integer; Palette: QPaletteH = nil; Sunken: Boolean = False;
2489   lineWidth: Integer = 1; midLineWidth: Integer = 0; FillBrush: QBrushH = nil);
2490 var
2491   AppPalette: QPaletteH;
2492 begin
2493   if (w < 0) or (h < 0) then
2494     exit;
2495   AppPalette := nil;
2496   if Palette = nil then
2497   begin
2498     if Parent = nil then
2499     begin
2500       AppPalette := QPalette_create();
2501       QGuiApplication_palette(AppPalette);
2502       // QApplication_palette(AppPalette);
2503       Palette := AppPalette;
2504     end else
2505       Palette := QWidget_palette(Parent);
2506   end;
2507   q_DrawShadeRect(Widget, x, y, w, h, Palette, Sunken, lineWidth, midLineWidth, FillBrush);
2508   if AppPalette <> nil then
2509   begin
2510     QPalette_destroy(AppPalette);
2511     Palette := nil;
2512   end;
2513 end;
2514 
2515 procedure TQtDeviceContext.qDrawWinPanel(x, y, w, h: integer;
2516   ATransparent: boolean; Palette: QPaletteH; Sunken: Boolean;
2517   lineWidth: Integer; FillBrush: QBrushH);
2518 var
2519   i: integer;
2520   AppPalette: QPaletteH;
2521 begin
2522 
2523   if (w < 0) or (h < 0) then
2524     exit;
2525 
2526   AppPalette := nil;
2527   if Palette = nil then
2528   begin
2529     if Parent = nil then
2530     begin
2531       AppPalette := QPalette_create();
2532       QGUIApplication_palette(AppPalette);
2533       Palette := AppPalette;
2534     end else
2535       Palette := QWidget_palette(Parent);
2536   end;
2537   // since q_DrawWinPanel doesnot supports lineWidth we should do it ourself
2538   for i := 1 to lineWidth - 2 do
2539   begin
2540     q_DrawWinPanel(Widget, x, y, w, h, Palette, Sunken);
2541     inc(x);
2542     inc(y);
2543     dec(w, 2);
2544     dec(h, 2);
2545   end;
2546 
2547   if lineWidth > 1 then
2548     q_DrawWinPanel(Widget, x, y, w, h, Palette, Sunken, FillBrush)
2549   else
2550   begin
2551     // issue #26491, draw opaque TCustomPanel if csOpaque is setted up in control style
2552     // otherwise use brush and painter backgroundmode settings.
2553     if not ATransparent and (FillBrush = nil) and Assigned(Parent) then
2554       q_DrawShadePanel(Widget, x, y, w, h, Palette, Sunken, 1, QPalette_background(Palette))
2555     else
2556       q_DrawShadePanel(Widget, x, y, w, h, Palette, Sunken, 1, FillBrush);
2557   end;
2558 
2559   if AppPalette <> nil then
2560   begin
2561     QPalette_destroy(AppPalette);
2562     Palette := nil;
2563   end;
2564 end;
2565 
2566 {------------------------------------------------------------------------------
2567   Function: TQtDeviceContext.CreateDCData
2568   Params:  None
2569   Returns: Nothing
2570  ------------------------------------------------------------------------------}
CreateDCDatanull2571 function TQtDeviceContext.CreateDCData: PQtDCDATA;
2572 begin
2573   {$ifdef VerboseQt}
2574   writeln('TQtDeviceContext.CreateDCData() ');
2575   {$endif}
2576   QPainter_save(Widget);
2577   Result := nil; // doesn't matter;
2578 end;
2579 
2580 {------------------------------------------------------------------------------
2581   Function: TQtDeviceContext.RestoreDCData
2582   Params:  DCData, dummy in current implementation
2583   Returns: true if QPainter state was successfuly restored
2584  ------------------------------------------------------------------------------}
RestoreDCDatanull2585 function TQtDeviceContext.RestoreDCData(var DCData: PQtDCData):boolean;
2586 begin
2587   {$ifdef VerboseQt}
2588   writeln('TQtDeviceContext.RestoreDCData() ');
2589   {$endif}
2590   QPainter_restore(Widget);
2591   Result := True;
2592 end;
2593 
DeviceSupportsCompositionnull2594 function TQtDeviceContext.DeviceSupportsComposition: Boolean;
2595 var
2596   Engine: QPaintEngineH;
2597   AType: QPaintEngineType;
2598 begin
2599 
2600   Result := (Widget <> nil) and QPainter_isActive(Widget);
2601 
2602   if not Result then
2603     exit;
2604 
2605   Result := FSupportComposition = rocSupported;
2606 
2607   if (FSupportComposition <> rocUndefined) then
2608     exit;
2609 
2610   Engine := QPainter_paintEngine(Widget);
2611 
2612   if Engine <> nil then
2613   begin
2614     AType := QPaintEngine_type(Engine);
2615     Result := not (AType in
2616       [QPaintEngineX11, QPaintEngineWindows,
2617        QPaintEngineQuickDraw, QPaintEngineCoreGraphics,
2618        QPaintEngineQWindowSystem]);
2619 
2620     FSupportComposition := Rop2CompSupported[Result];
2621   end;
2622 end;
2623 
DeviceSupportsRasterOpsnull2624 function TQtDeviceContext.DeviceSupportsRasterOps: Boolean;
2625 var
2626   Engine: QPaintEngineH;
2627   AType: QPaintEngineType;
2628 begin
2629 
2630   Result := (Widget <> nil) and QPainter_isActive(Widget);
2631 
2632   if not Result then
2633     exit;
2634 
2635   Result := FSupportRasterOps = rocSupported;
2636 
2637   if (FSupportRasterOps <> rocUndefined) then
2638     exit;
2639 
2640   Engine := QPainter_paintEngine(Widget);
2641   if Engine <> nil then
2642   begin
2643     AType := QPaintEngine_type(Engine);
2644     Result := not (AType in
2645       [QPaintEngineQuickDraw, QPaintEngineCoreGraphics,
2646        QPaintEngineQWindowSystem]);
2647 
2648     FSupportRasterOps := Rop2CompSupported[Result];
2649   end;
2650 end;
2651 
2652 {------------------------------------------------------------------------------
2653   Function: TQtDeviceContext.R2ToQtRasterOp
2654   Params:  Raster ops binary operator
2655   Returns: QPainterCompositionMode
2656  ------------------------------------------------------------------------------}
R2ToQtRasterOpnull2657 function TQtDeviceContext.R2ToQtRasterOp(AValue: Integer): QPainterCompositionMode;
2658 begin
2659   Result := QPainterCompositionMode_SourceOver;
2660 
2661   if not DeviceSupportsRasterOps then
2662     exit;
2663   (*
2664    IMPLEMENTED = +
2665    NOT IMPLEMENTED = -
2666    NOT SURE HOWTO IMPLEMENT = ?
2667   +SRCCOPY     = $00CC0020;     { dest = source                    }
2668   +SRCPAINT    = $00EE0086;     { dest = source OR dest            }
2669   +SRCAND      = $008800C6;     { dest = source AND dest           }
2670   +SRCINVERT   = $00660046;     { dest = source XOR dest           }
2671   +SRCERASE    = $00440328;     { dest = source AND (NOT dest )    }
2672   +NOTSRCCOPY  = $00330008;     { dest = (NOT source)              }
2673   +NOTSRCERASE = $001100A6;     { dest = (NOT src) AND (NOT dest)  }
2674   -MERGECOPY   = $00C000CA;     { dest = (source AND pattern)      }
2675   +MERGEPAINT  = $00BB0226;     { dest = (NOT source) OR dest      }
2676   -PATCOPY     = $00F00021;     { dest = pattern                   }
2677   -PATPAINT    = $00FB0A09;     { dest = DPSnoo                    }
2678   -PATINVERT   = $005A0049;     { dest = pattern XOR dest          }
2679   +DSTINVERT   = $00550009;     { dest = (NOT dest)                }
2680   ?BLACKNESS   = $00000042;     { dest = BLACK                     }
2681   ?WHITENESS   = $00FF0062;     { dest = WHITE                     }
2682   *)
2683 
2684   case AValue of
2685     BLACKNESS,
2686     R2_BLACK: if DeviceSupportsComposition then
2687                 Result := QPainterCompositionMode_Clear;
2688 
2689     SRCCOPY,
2690     R2_COPYPEN: Result := QPainterCompositionMode_SourceOver; // default
2691 
2692     MERGEPAINT,
2693     R2_MASKNOTPEN: Result := QPainterRasterOp_NotSourceAndDestination;
2694 
2695     SRCAND,
2696     R2_MASKPEN: Result := QPainterRasterOp_SourceAndDestination;
2697 
2698     SRCERASE,
2699     R2_MASKPENNOT: Result := QPainterRasterOp_SourceAndNotDestination;
2700 
2701     R2_MERGENOTPEN: Result := QPainterCompositionMode_SourceOver; // unsupported
2702 
2703     SRCPAINT,
2704     R2_MERGEPEN: Result := QPainterRasterOp_SourceOrDestination;
2705 
2706     R2_MERGEPENNOT: Result := QPainterCompositionMode_SourceOver; // unsupported
2707 
2708     R2_NOP: if DeviceSupportsComposition then
2709               Result := QPainterCompositionMode_Destination;
2710     R2_NOT: if DeviceSupportsComposition then
2711               Result := QPainterCompositionMode_SourceOut; // unsupported
2712 
2713     NOTSRCCOPY,
2714     R2_NOTCOPYPEN: Result := QPainterRasterOp_NotSource;
2715 
2716     PATPAINT,
2717     R2_NOTMASKPEN: Result := QPainterRasterOp_NotSourceOrNotDestination;
2718 
2719     NOTSRCERASE,
2720     R2_NOTMERGEPEN: Result := QPainterRasterOp_NotSourceAndNotDestination;
2721 
2722     DSTINVERT,
2723     R2_NOTXORPEN: Result := QPainterRasterOp_NotSourceXorDestination;
2724 
2725     WHITENESS,
2726     R2_WHITE: if DeviceSupportsComposition then
2727                 Result := QPainterCompositionMode_Screen;
2728     SRCINVERT,
2729     R2_XORPEN: Result := QPainterRasterOp_SourceXorDestination;
2730   end;
2731 end;
2732 
2733 {------------------------------------------------------------------------------
2734   Function: TQtDeviceContext.RestorePenColor
2735   Params:  None
2736   Returns: Nothing
2737  ------------------------------------------------------------------------------}
2738 procedure TQtDeviceContext.RestorePenColor;
2739 begin
2740   {$ifdef VerboseQt}
2741   writeln('TQtDeviceContext.RestorePenColor() ');
2742   {$endif}
2743   QPainter_setPen(Widget, @PenColor);
2744 end;
2745 
GetRopnull2746 function TQtDeviceContext.GetRop: Integer;
2747 begin
2748   Result := FRopMode;
2749 end;
2750 
GetMetricsnull2751 function TQtDeviceContext.GetMetrics: TQtFontMetrics;
2752 begin
2753   Result := Font.Metrics;
2754 end;
2755 
2756 {------------------------------------------------------------------------------
2757   Function: TQtDeviceContext.RestoreTextColor
2758   Params:  None
2759   Returns: Nothing
2760  ------------------------------------------------------------------------------}
2761 procedure TQtDeviceContext.RestoreTextColor;
2762 var
2763   CurPen: QPenH;
2764   TxtColor: TQColor;
2765 begin
2766   {$ifdef VerboseQt}
2767   writeln('TQtDeviceContext.RestoreTextColor() ');
2768   {$endif}
2769   CurPen := QPainter_Pen(Widget);
2770   QPen_color(CurPen, @PenColor);
2771   TxtColor := PenColor;
2772   ColorRefToTQColor(vTextColor, TxtColor);
2773   QPainter_setPen(Widget, @txtColor);
2774 end;
2775 
2776 procedure TQtDeviceContext.SetRop(const AValue: Integer);
2777 var
2778   QtROPMode: QPainterCompositionMode;
2779 begin
2780   FRopMode := AValue;
2781   QtRopMode := R2ToQtRasterOp(AValue);
2782   if QPainter_compositionMode(Widget) <> QtRopMode then
2783     QPainter_setCompositionMode(Widget, QtROPMode);
2784 end;
2785 
2786 {------------------------------------------------------------------------------
2787   Function: TQtDeviceContext.drawRect
2788   Params:  None
2789   Returns: Nothing
2790 
2791   Draws a rectangle. Helper function of winapi.Rectangle
2792  ------------------------------------------------------------------------------}
2793 procedure TQtDeviceContext.drawRect(x1: Integer; y1: Integer; w: Integer;
2794   h: Integer);
2795 var
2796   PW: Double;
2797 begin
2798   {$ifdef VerboseQt}
2799   writeln('TQtDeviceContext.drawRect() x1: ',x1,' y1: ',y1,' w: ',w,' h: ',h);
2800   {$endif}
2801   QPainter_drawRect(Widget, x1, y1, w, h);
2802 end;
2803 
2804 procedure TQtDeviceContext.drawRoundRect(x, y, w, h, rx, ry: Integer);
2805 begin
2806   QPainter_drawRoundedRect(Widget, x, y, w, h, rx, ry);
2807 end;
2808 
2809 {------------------------------------------------------------------------------
2810   Function: TQtDeviceContext.drawText
2811   Params:  None
2812   Returns: Nothing
2813 
2814   Draws a Text. Helper function of winapi.TextOut
2815 
2816   Qt does not draw the text starting at Y position and downwards, like LCL.
2817 
2818   Instead, Y becomes the baseline for the text and it's drawn upwards.
2819 
2820   To get a correct behavior we need to sum the text's height to the Y coordinate.
2821  ------------------------------------------------------------------------------}
2822 procedure TQtDeviceContext.drawText(x: Integer; y: Integer; s: PWideString);
2823 begin
2824   {$ifdef VerboseQt}
2825   Write('TQtDeviceContext.drawText TargetX: ', X, ' TargetY: ', Y);
2826   {$endif}
2827 
2828   // First translate and then rotate, that makes the
2829   // correct rotation effect that we want
2830   if Font.Angle <> 0 then
2831   begin
2832     Translate(x, y);
2833     Rotate(-0.1 * Font.Angle);
2834   end;
2835 
2836   // what about Metrics.descent and Metrics.leading ?
2837   y := y + Metrics.ascent;
2838 
2839   RestoreTextColor;
2840 
2841   // The ascent is only applied here, because it also needs
2842   // to be rotated
2843   if Font.Angle <> 0 then
2844     QPainter_drawText(Widget, 0, Metrics.ascent, s)
2845   else
2846     QPainter_drawText(Widget, x, y, s);
2847 
2848   RestorePenColor;
2849 
2850   // Restore previous angle
2851   if Font.Angle <> 0 then
2852   begin
2853     y := y - Metrics.ascent;
2854     Rotate(0.1 * Font.Angle);
2855     Translate(-x, -y);
2856   end;
2857 
2858   {$ifdef VerboseQt}
2859   WriteLn(' Font metrics height: ', Metrics.height, ' Angle: ',
2860     Round(0.1 * Font.Angle));
2861   {$endif}
2862 end;
2863 
2864 {------------------------------------------------------------------------------
2865   Function: TQtDeviceContext.DrawText
2866   Params:  None
2867   Returns: Nothing
2868  ------------------------------------------------------------------------------}
2869 procedure TQtDeviceContext.drawText(x, y, w, h, flags: Integer; s: PWideString);
2870 begin
2871   {$ifdef VerboseQt}
2872   Write('TQtDeviceContext.drawText x: ', X, ' Y: ', Y,' w: ',w,' h: ',h);
2873   {$endif}
2874 
2875   // First translate and then rotate, that makes the
2876   // correct rotation effect that we want
2877   if Font.Angle <> 0 then
2878   begin
2879     Translate(x, y);
2880     Rotate(-0.1 * Font.Angle);
2881   end;
2882 
2883   RestoreTextColor;
2884   if Font.Angle <> 0 then
2885     QPainter_DrawText(Widget, 0, 0, w, h, Flags, s)
2886   else
2887     QPainter_DrawText(Widget, x, y, w, h, Flags, s);
2888   RestorePenColor;
2889 
2890   // Restore previous angle
2891   if Font.Angle <> 0 then
2892   begin
2893     Rotate(0.1 * Font.Angle);
2894     Translate(-x, -y);
2895   end;
2896 end;
2897 
2898 {------------------------------------------------------------------------------
2899   Function: TQtDeviceContext.drawLine
2900   Params:  None
2901   Returns: Nothing
2902 
2903   Draws a Text. Helper function for winapi.LineTo
2904  ------------------------------------------------------------------------------}
2905 procedure TQtDeviceContext.drawLine(x1: Integer; y1: Integer; x2: Integer; y2: Integer);
2906 begin
2907   {$ifdef VerboseQt}
2908   Write('TQtDeviceContext.drawLine x1: ', X1, ' Y1: ', Y1,' x2: ',x2,' y2: ',y2);
2909   {$endif}
2910   QPainter_drawLine(Widget, x1, y1, x2, y2);
2911 end;
2912 
2913 {------------------------------------------------------------------------------
2914   Function: TQtDeviceContext.drawEllipse
2915   Params:  None
2916   Returns: Nothing
2917 
2918   Draws a ellipse. Helper function for winapi.Ellipse
2919  ------------------------------------------------------------------------------}
2920 procedure TQtDeviceContext.drawEllipse(x: Integer; y: Integer; w: Integer; h: Integer);
2921 begin
2922   QPainter_drawEllipse(Widget, x, y, w, h);
2923 end;
2924 
2925 procedure TQtDeviceContext.drawPixmap(p: PQtPoint; pm: QPixmapH; sr: PRect);
2926 begin
2927   QPainter_drawPixmap(Widget, p, pm, sr);
2928 end;
2929 
2930 procedure TQtDeviceContext.drawPolyLine(P: PPoint; NumPts: Integer);
2931 var
2932   QtPoints: PQtPoint;
2933   i: integer;
2934   LastPoint: TPoint;
2935 begin
2936   GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
2937   for i := 0 to NumPts - 2 do
2938     QtPoints[i] := QtPoint(P[i].x, P[i].y);
2939 
2940   LastPoint := P[NumPts - 1];
2941   if NumPts > 1 then
2942     LastPoint := GetLineLastPixelPos(P[NumPts - 2], LastPoint);
2943   QtPoints[NumPts - 1] := QtPoint(LastPoint.X, LastPoint.Y);
2944 
2945   QPainter_drawPolyline(Widget, QtPoints, NumPts);
2946   FreeMem(QtPoints);
2947 end;
2948 
2949 procedure TQtDeviceContext.drawPolygon(P: PPoint; NumPts: Integer;
2950   FillRule: QtFillRule);
2951 var
2952   QtPoints: PQtPoint;
2953   i: integer;
2954   LastPoint: TPoint;
2955 begin
2956   GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
2957   for i := 0 to NumPts - 2 do
2958     QtPoints[i] := QtPoint(P[i].x, P[i].y);
2959 
2960   LastPoint := P[NumPts - 1];
2961   if NumPts > 1 then
2962     LastPoint := GetLineLastPixelPos(P[NumPts - 2], LastPoint);
2963   QtPoints[NumPts - 1] := QtPoint(LastPoint.X, LastPoint.Y);
2964 
2965   QPainter_drawPolygon(Widget, QtPoints, NumPts, FillRule);
2966   FreeMem(QtPoints);
2967 end;
2968 
2969 procedure TQtDeviceContext.eraseRect(ARect: PRect);
2970 begin
2971   QPainter_eraseRect(Widget, ARect);
2972 end;
2973 
2974 procedure TQtDeviceContext.fillRect(ARect: PRect; ABrush: QBrushH);
2975 begin
2976   {$ifdef VerboseQt}
2977   Write('TQtDeviceContext.fillRect() from PRect');
2978   {$endif}
2979   QPainter_fillRect(Widget, ARect, ABrush);
2980 end;
2981 
2982 procedure TQtDeviceContext.fillRect(x, y, w, h: Integer; ABrush: QBrushH);
2983 begin
2984   {$ifdef VerboseQt}
2985   Write('TQtDeviceContext.fillRect() x: ',x,' y: ',y,' w: ',w,' h: ',h);
2986   {$endif}
2987   QPainter_fillRect(Widget, x, y, w, h, ABrush);
2988 end;
2989 
2990 procedure TQtDeviceContext.fillRect(x, y, w, h: Integer);
2991 begin
2992   fillRect(x, y, w, h, BackgroundBrush.FHandle);
2993 end;
2994 
getBKModenull2995 function TQtDeviceContext.getBKMode: Integer;
2996 begin
2997   if QPainter_BackgroundMode(Widget) = QtOpaqueMode then
2998     Result := OPAQUE
2999   else
3000     Result := TRANSPARENT;
3001 end;
3002 
3003 {------------------------------------------------------------------------------
3004   Function: TQtDeviceContext.drawPoint
3005   Params:  x1,y1 : Integer
3006   Returns: Nothing
3007 
3008   Draws a point. Helper function of winapi. DrawFocusRect
3009  ------------------------------------------------------------------------------}
3010 procedure TQtDeviceContext.drawPoint(x1: Integer; y1: Integer);
3011 begin
3012   {$ifdef VerboseQt}
3013   Write('TQtDeviceContext.drawPoint() x1: ',x1,' y1: ',y1);
3014   {$endif}
3015   QPainter_drawPoint(Widget, x1, y1);
3016 end;
3017 
3018 {------------------------------------------------------------------------------
3019   Function: TQtDeviceContext.setBrushOrigin
3020   Params:  None
3021   Returns: Nothing
3022  ------------------------------------------------------------------------------}
3023 procedure TQtDeviceContext.setBrushOrigin(x, y: Integer);
3024 begin
3025   {$ifdef VerboseQt}
3026   Write('TQtDeviceContext.setBrushOrigin() x: ',x,' y: ',y);
3027   {$endif}
3028   QPainter_setBrushOrigin(Widget, x, y);
3029 end;
3030 
3031 {------------------------------------------------------------------------------
3032   Function: TQtDeviceContext.brushOrigin
3033   Params:  None
3034   Returns: Nothing
3035  ------------------------------------------------------------------------------}
3036 procedure TQtDeviceContext.getBrushOrigin(retval: PPoint);
3037 var
3038   QtPoint: TQtPoint;
3039 begin
3040   {$ifdef VerboseQt}
3041   Write('TQtDeviceContext.brushOrigin() ');
3042   {$endif}
3043 
3044   QPainter_brushOrigin(Widget, @QtPoint);
3045   retval^.x := QtPoint.x;
3046   retval^.y := QtPoint.y;
3047 end;
3048 
getClippingnull3049 function TQtDeviceContext.getClipping: Boolean;
3050 begin
3051   Result := QPainter_hasClipping(Widget);
3052 end;
3053 
getCompositionModenull3054 function TQtDeviceContext.getCompositionMode: QPainterCompositionMode;
3055 begin
3056   Result := QPainter_compositionMode(Widget);
3057 end;
3058 
3059 procedure TQtDeviceContext.getPenPos(retval: PPoint);
3060 begin
3061   retval^.x := FPenPos.x;
3062   retval^.y := FPenPos.y;
3063 end;
3064 
getWorldTransformnull3065 function TQtDeviceContext.getWorldTransform: QTransformH;
3066 begin
3067   Result := QPainter_worldTransform(Widget);
3068 end;
3069 
3070 procedure TQtDeviceContext.setPenPos(x, y: Integer);
3071 begin
3072   FPenPos.X := x;
3073   FPenPos.Y := y;
3074 end;
3075 
3076 {------------------------------------------------------------------------------
3077   Function: TQtDeviceContext.font
3078   Params:  None
3079   Returns: The current font object of the DC
3080  ------------------------------------------------------------------------------}
fontnull3081 function TQtDeviceContext.font: TQtFont;
3082 begin
3083   {$ifdef VerboseQt}
3084   Write('TQtDeviceContext.font()');
3085   {$endif}
3086 
3087   if SelFont = nil then
3088   begin
3089     if vFont <> nil then
3090     begin
3091       if vFont.FHandle <> nil then
3092       begin
3093         QFont_destroy(vFont.FHandle);
3094         vFont.FHandle := nil;
3095       end;
3096     end;
3097     Result := vFont;
3098   end
3099   else
3100     Result := SelFont;
3101 end;
3102 
3103 {------------------------------------------------------------------------------
3104   Function: TQtDeviceContext.setFont
3105   Params:  None
3106   Returns: Nothing
3107  ------------------------------------------------------------------------------}
3108 procedure TQtDeviceContext.setFont(AFont: TQtFont);
3109 var
3110   QFnt: QFontH;
3111 begin
3112   {$ifdef VerboseQt}
3113   Write('TQtDeviceContext.setFont() ');
3114   {$endif}
3115   SelFont := AFont;
3116   if (AFont.FHandle <> nil) and (Widget <> nil) then
3117   begin
3118     QFnt := QFont_Create(AFont.FHandle);
3119     QPainter_setFont(Widget, QFnt);
3120     QFont_destroy(QFnt);
3121     vFont.Angle := AFont.Angle;
3122   end;
3123 end;
3124 
3125 {------------------------------------------------------------------------------
3126   Function: TQtDeviceContext.brush
3127   Params:  None
3128   Returns: The current brush object of the DC
3129  ------------------------------------------------------------------------------}
brushnull3130 function TQtDeviceContext.brush: TQtBrush;
3131 begin
3132   {$ifdef VerboseQt}
3133   Write('TQtDeviceContext.brush() ');
3134   {$endif}
3135 
3136   if vBrush <> nil then
3137     vBrush.FHandle := QPainter_brush(Widget);
3138 
3139   if SelBrush = nil then
3140     Result := vBrush
3141   else
3142     Result := SelBrush;
3143 end;
3144 
3145 {------------------------------------------------------------------------------
3146   Function: TQtDeviceContext.setBrush
3147   Params:  None
3148   Returns: Nothing
3149  ------------------------------------------------------------------------------}
3150 procedure TQtDeviceContext.setBrush(ABrush: TQtBrush);
3151 begin
3152   {$ifdef VerboseQt}
3153   Write('TQtDeviceContext.setBrush() ');
3154   {$endif}
3155   if SelBrush <> nil then
3156     SelBrush.FSelected := False;
3157   SelBrush := ABrush;
3158   if SelBrush <> nil then
3159     SelBrush.FSelected := True;
3160 
3161   if (ABrush.FHandle <> nil) and (Widget <> nil) then
3162     QPainter_setBrush(Widget, ABrush.FHandle);
3163 end;
3164 
BackgroundBrushnull3165 function TQtDeviceContext.BackgroundBrush: TQtBrush;
3166 begin
3167   {$ifdef VerboseQt}
3168   Write('TQtDeviceContext.backgroundBrush() ');
3169   {$endif}
3170   vBackgroundBrush.FHandle := QPainter_background(Widget);
3171   result := vBackGroundBrush;
3172 end;
3173 
GetBkColornull3174 function TQtDeviceContext.GetBkColor: TColorRef;
3175 var
3176   TheBrush: QBrushH;
3177   TheColor: TQColor;
3178 begin
3179   TheBrush := QPainter_background(Widget);
3180   TheColor := QBrush_color(TheBrush)^;
3181   TQColorToColorRef(TheColor, Result);
3182 end;
3183 
3184 {------------------------------------------------------------------------------
3185   Function: TQtDeviceContext.pen
3186   Params:  None
3187   Returns: The current pen object of the DC
3188  ------------------------------------------------------------------------------}
pennull3189 function TQtDeviceContext.pen: TQtPen;
3190 begin
3191   {$ifdef VerboseQt}
3192   Write('TQtDeviceContext.pen() ');
3193   {$endif}
3194 
3195   if vPen <> nil then
3196     vPen.FHandle := QPainter_pen(Widget);
3197 
3198   if SelPen = nil then
3199     Result := vPen
3200   else
3201     Result := SelPen;
3202 end;
3203 
3204 {------------------------------------------------------------------------------
3205   Function: TQtDeviceContext.setPen
3206   Params:  None
3207   Returns: Nothing
3208  ------------------------------------------------------------------------------}
setPennull3209 function TQtDeviceContext.setPen(APen: TQtPen): TQtPen;
3210 begin
3211   {$ifdef VerboseQt}
3212   Write('TQtDeviceContext.setPen() ');
3213   {$endif}
3214   Result := pen;
3215   SelPen := APen;
3216   if (APen <> nil) and (APen.FHandle <> nil) and (Widget <> nil) then
3217     QPainter_setPen(Widget, APen.FHandle);
3218 end;
3219 
3220 procedure TQColorToColorRef(const AColor: TQColor; out AColorRef: TColorRef);
3221 begin
3222   AColorRef := ((AColor.r shr 8) and $FF) or
3223                 (AColor.g and $FF00) or
3224                ((AColor.b shl 8) and $FF0000);
3225 end;
3226 
3227 procedure ColorRefToTQColor(const AColorRef: TColorRef; var AColor:TQColor);
3228 begin
3229   QColor_fromRgb(@AColor, Red(AColorRef),Green(AColorRef),Blue(AColorRef));
3230 end;
3231 
3232 function EqualTQColor(const Color1, Color2: TQColor): Boolean;
3233 begin
3234   Result := (Color1.r = Color2.r) and
3235     (Color1.g = Color2.g) and
3236     (Color1.b = Color2.b);
3237 end;
3238 
3239 procedure DebugRegion(const msg: string; Rgn: QRegionH);
3240 var
3241   R: TRect;
3242   ok: boolean;
3243 begin
3244   Write(Msg);
3245   ok := QRegion_isEmpty(Rgn);
3246   QRegion_BoundingRect(Rgn, @R);
3247   WriteLn(' Empty=',Ok,' Rect=', dbgs(R));
3248 end;
3249 
3250 function QtDefaultPrinter: TQtPrinter;
3251 begin
3252   if FPrinter = nil then
3253     FPrinter := TQtPrinter.Create;
3254   Result := FPrinter;
3255 end;
3256 
3257 function Clipboard: TQtClipboard;
3258 begin
3259   if FClipboard = nil then
3260     FClipboard := TQtClipboard.Create;
3261   Result := FClipboard;
3262 end;
3263 
SetBkColornull3264 function TQtDeviceContext.SetBkColor(Color: TColorRef): TColorRef;
3265 var
3266   NColor: TQColor;
3267 begin
3268   {$ifdef VerboseQt}
3269   Write('TQtDeviceContext.setBKColor() ');
3270   {$endif}
3271   Result := GetBkColor;
3272   ColorRefToTQColor(ColorToRGB(TColor(Color)), NColor{%H-});
3273   BackgroundBrush.setColor(@NColor);
3274 end;
3275 
SetBkModenull3276 function TQtDeviceContext.SetBkMode(BkMode: Integer): Integer;
3277 var
3278   Mode: QtBGMode;
3279 begin
3280   {$ifdef VerboseQt}
3281   Write('TQtDeviceContext.setBKMode() ');
3282   {$endif}
3283   Result := 0;
3284   if Widget <> nil then
3285   begin
3286     Mode := QPainter_BackgroundMode(Widget);
3287     if Mode = QtOpaqueMode then
3288       Result := OPAQUE
3289     else
3290       Result := TRANSPARENT;
3291 
3292     if BkMode = OPAQUE then
3293       Mode := QtOpaqueMode
3294     else
3295       Mode := QtTransparentMode;
3296     QPainter_SetBackgroundMode(Widget, Mode);
3297   end;
3298 end;
3299 
getDepthnull3300 function TQtDeviceContext.getDepth: integer;
3301 var
3302   device: QPaintDeviceH;
3303 begin
3304   device := QPainter_device(Widget);
3305   Result := QPaintDevice_depth(Device);
3306 end;
3307 
getDeviceSizenull3308 function TQtDeviceContext.getDeviceSize: TPoint;
3309 var
3310   device: QPaintDeviceH;
3311 begin
3312   device := QPainter_device(Widget);
3313   Result.x := QPaintDevice_width(device);
3314   Result.y := QPaintDevice_height(device);
3315 end;
3316 
3317 {------------------------------------------------------------------------------
3318   Function: TQtDeviceContext.getRegionType
3319   Params:  QRegionH
3320   Returns: Region type
3321  ------------------------------------------------------------------------------}
getRegionTypenull3322 function TQtDeviceContext.getRegionType(ARegion: QRegionH): integer;
3323 begin
3324   try
3325     if QRegion_isEmpty(ARegion) then
3326       Result := NULLREGION
3327     else
3328     begin
3329       if QRegion_numRects(ARegion) = 1 then
3330         Result := SIMPLEREGION
3331       else
3332         Result := COMPLEXREGION;
3333     end;
3334   except
3335     Result := ERROR;
3336   end;
3337 end;
3338 
3339 procedure TQtDeviceContext.setCompositionMode(mode: QPainterCompositionMode);
3340 begin
3341   QPainter_setCompositionMode(Widget, mode);
3342 end;
3343 
3344 {------------------------------------------------------------------------------
3345   Function: TQtDeviceContext.region
3346   Params:  None
3347   Returns: The current clip region
3348  ------------------------------------------------------------------------------}
getClipRegionnull3349 function TQtDeviceContext.getClipRegion: TQtRegion;
3350 begin
3351   {$ifdef VerboseQt}
3352   Write('TQtDeviceContext.region() ');
3353   {$endif}
3354   if vRegion.FHandle <> nil then
3355   begin
3356     QRegion_destroy(vRegion.FHandle);
3357     vRegion.FHandle := nil;
3358   end;
3359   if vRegion.FHandle = nil then
3360     vRegion.FHandle := QRegion_Create();
3361 
3362   QPainter_clipRegion(Widget,  vRegion.FHandle);
3363   Result := vRegion;
3364 end;
3365 
3366 procedure TQtDeviceContext.setClipping(const AValue: Boolean);
3367 begin
3368   QPainter_setClipping(Widget, AValue);
3369 end;
3370 
3371 procedure TQtDeviceContext.setClipRect(const ARect: TRect);
3372 begin
3373   QPainter_setClipRect(Widget, @ARect);
3374 end;
3375 
3376 procedure TQtDeviceContext.setClipRegion(ARegion: QRegionH;
3377   AOperation: QtClipOperation = QtReplaceClip);
3378 begin
3379   {X11 and mac does not like QtNoClip & empty region.It makes disaster}
3380   if (AOperation = QtNoClip) and QRegion_isEmpty(ARegion) and
3381   (QPaintEngine_type(PaintEngine) in [QPaintEngineX11,QPaintEngineQuickDraw,
3382     QPaintEngineCoreGraphics,QPaintEngineMacPrinter]) then
3383       setClipping(False)
3384   else
3385     QPainter_SetClipRegion(Widget, ARegion, AOperation);
3386 end;
3387 
3388 {------------------------------------------------------------------------------
3389   Function: TQtDeviceContext.setRegion
3390   Params:  None
3391   Returns: Nothing
3392  ------------------------------------------------------------------------------}
3393 procedure TQtDeviceContext.setRegion(ARegion: TQtRegion);
3394 begin
3395   {$ifdef VerboseQt}
3396   Write('TQtDeviceContext.setRegion() ');
3397   {$endif}
3398   if (ARegion.FHandle <> nil) and (Widget <> nil) then
3399     setClipRegion(ARegion.FHandle);
3400 end;
3401 
3402 {------------------------------------------------------------------------------
3403   Function: TQtDeviceContext.drawImage
3404   Params:  None
3405   Returns: Nothing
3406  ------------------------------------------------------------------------------}
3407 procedure TQtDeviceContext.drawImage(targetRect: PRect;
3408      image: QImageH; sourceRect: PRect;
3409       mask: QImageH; maskRect: PRect; flags: QtImageConversionFlags = QtAutoColor);
3410 var
3411   LocalRect: TRect;
3412   APixmap, ATemp: QPixmapH;
3413   AMask: QBitmapH;
3414   ScaledImage: QImageH;
3415   ScaledMask: QImageH;
3416   NewRect: TRect;
3417   ARenderHint: Boolean;
3418   ATransformation: QtTransformationMode;
3419   ARenderHints: QPainterRenderHints;
3420   {$IFDEF DARWIN}
3421   BMacPrinter: boolean;
3422   {$ENDIF}
3423   function NeedScaling: boolean;
3424   var
3425     R: TRect;
3426     TgtW, TgtH,
3427     ClpW, ClpH: integer;
3428   begin
3429 
3430     if not getClipping or EqualRect(LocalRect, sourceRect^) then
3431       exit(False);
3432 
3433     R := getClipRegion.getBoundingRect;
3434 
3435     TgtW := LocalRect.Right - LocalRect.Left;
3436     TgtH := LocalRect.Bottom - LocalRect.Top;
3437     ClpW := R.Right - R.Left;
3438     ClpH := R.Bottom - R.Top;
3439 
3440     Result := PtInRect(R, Point(R.Left + 1, R.Top + 1)) and
3441       (ClpW <= TgtW) and (ClpH <= TgtH);
3442   end;
3443 
3444 begin
3445   {$ifdef VerboseQt}
3446   Write('TQtDeviceContext.drawImage() ');
3447   {$endif}
3448   ScaledImage := nil;
3449   LocalRect := targetRect^;
3450 
3451   {$IFDEF DARWIN}
3452   BMacPrinter := (PaintEngine <> nil) and (QPaintEngine_type(PaintEngine) = QPaintEngineMacPrinter);
3453   {$ENDIF}
3454 
3455   if mask <> nil then
3456   begin
3457     if NeedScaling then
3458     begin
3459       ScaledImage := QImage_create();
3460       QImage_copy(Image, ScaledImage, 0, 0, QImage_width(Image), QImage_height(Image));
3461       QImage_scaled(ScaledImage, ScaledImage, LocalRect.Right - LocalRect.Left,
3462             LocalRect.Bottom - LocalRect.Top);
3463       NewRect := sourceRect^;
3464       NewRect.Right := (LocalRect.Right - LocalRect.Left) + sourceRect^.Left;
3465       NewRect.Bottom := (LocalRect.Bottom - LocalRect.Top) + sourceRect^.Top;
3466     end;
3467     // TODO: check maskRect
3468     APixmap := QPixmap_create();
3469     try
3470       if ScaledImage <> nil then
3471         QPixmap_fromImage(APixmap, ScaledImage, flags)
3472       else
3473         QPixmap_fromImage(APixmap, image, flags);
3474       ATemp := QPixmap_create();
3475       try
3476         // QBitmap_fromImage raises assertion in the qt library
3477         if ScaledImage <> nil then
3478         begin
3479           ScaledMask := QImage_create();
3480           QImage_copy(Mask, ScaledMask, 0, 0, QImage_width(Mask), QImage_height(Mask));
3481           QImage_scaled(ScaledMask, ScaledMask, LocalRect.Right - LocalRect.Left,
3482               LocalRect.Bottom - LocalRect.Top);
3483           QPixmap_fromImage(ATemp, ScaledMask, flags);
3484           QImage_destroy(ScaledMask);
3485         end else
3486           QPixmap_fromImage(ATemp, mask, flags);
3487         AMask := QBitmap_create(ATemp);
3488         try
3489           QPixmap_setMask(APixmap, AMask);
3490 
3491           {$IFDEF DARWIN}
3492           ScaledMask := QImage_create();
3493           QPixmap_toImage(APixmap, ScaledMask);
3494           if ScaledImage <> nil then
3495             QPainter_drawImage(Widget, PRect(@LocalRect), image, @NewRect, flags)
3496           else
3497             QPainter_drawImage(Widget, PRect(@LocalRect), image, sourceRect, flags);
3498 
3499           QImage_destroy(ScaledMask);
3500           {$ELSE}
3501           if ScaledImage <> nil then
3502             QPainter_drawPixmap(Widget, PRect(@LocalRect), APixmap, @NewRect)
3503           else
3504             QPainter_drawPixmap(Widget, PRect(@LocalRect), APixmap, sourceRect);
3505           {$ENDIF}
3506 
3507         finally
3508           QBitmap_destroy(AMask);
3509         end;
3510       finally
3511         QPixmap_destroy(ATemp);
3512       end;
3513     finally
3514       QPixmap_destroy(APixmap);
3515     end;
3516     if ScaledImage <> nil then
3517       QImage_destroy(ScaledImage);
3518   end else
3519   begin
3520     {$note TQtDeviceContext.drawImage workaround - possible qt4 bug with QPainter & RGB32 images.}
3521     {Workaround: we must convert image to ARGB32 , since we can get strange
3522      results with RGB32 images on Linux and Win32 if DstRect <> sourceRect.
3523      Explanation: Look at #11713 linux & win screenshoots.
3524      Note: This is slower operation than QImage_scaled() we used before.
3525      Issue #25590 - check if we are RGB32 and mask is nil, so make conversion
3526      too.}
3527     if (not EqualRect(LocalRect, sourceRect^) or (Mask = nil)) and
3528       (QImage_format(Image) = QImageFormat_RGB32) then
3529     begin
3530 
3531       ScaledImage := QImage_create();
3532       try
3533 
3534         QImage_convertToFormat(Image, ScaledImage, QImageFormat_ARGB32);
3535 
3536         if NeedScaling then
3537         begin
3538           QImage_scaled(ScaledImage, ScaledImage, LocalRect.Right - LocalRect.Left,
3539           LocalRect.Bottom - LocalRect.Top);
3540 
3541           NewRect := sourceRect^;
3542           NewRect.Right := (LocalRect.Right - LocalRect.Left) + sourceRect^.Left;
3543           NewRect.Bottom := (LocalRect.Bottom - LocalRect.Top) + sourceRect^.Top;
3544 
3545           QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, @NewRect, flags);
3546         end else
3547           QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, sourceRect, flags);
3548 
3549       finally
3550         QImage_destroy(ScaledImage);
3551       end;
3552 
3553     end else
3554     begin
3555       if NeedScaling then
3556       begin
3557         ScaledImage := QImage_create();
3558         try
3559           QImage_copy(Image, ScaledImage, 0, 0, QImage_width(Image), QImage_height(Image));
3560           {use smooth transformation when scaling image. issue #29883
3561            check if antialiasing is on, if not then don''t call smoothTransform. issue #330011}
3562           ARenderHints := QPainter_renderHints(Widget);
3563           if (ARenderHints and QPainterAntialiasing <> 0) or (ARenderHints and QPainterSmoothPixmapTransform <> 0) or
3564             (ARenderHints and QPainterHighQualityAntialiasing <> 0) then
3565               ATransformation := QtSmoothTransformation
3566           else
3567             ATransformation := QtFastTransformation;
3568 
3569           QImage_scaled(ScaledImage, ScaledImage, LocalRect.Right - LocalRect.Left,
3570             LocalRect.Bottom - LocalRect.Top, QtIgnoreAspectRatio, ATransformation);
3571           NewRect := sourceRect^;
3572           NewRect.Right := (LocalRect.Right - LocalRect.Left) + sourceRect^.Left;
3573           NewRect.Bottom := (LocalRect.Bottom - LocalRect.Top) + sourceRect^.Top;
3574           QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, @NewRect, flags);
3575         finally
3576           QImage_destroy(ScaledImage);
3577         end;
3578       end else
3579       begin
3580         {smooth a bit. issue #29883
3581          check if antialiasing is on, if not then don''t call smoothTransform. issue #330011}
3582 
3583         ARenderHints := QPainter_renderHints(Widget);
3584         ARenderHint := (ARenderHints and QPainterAntialiasing <> 0) or (ARenderHints and QPainterSmoothPixmapTransform <> 0) or
3585           (ARenderHints and QPainterHighQualityAntialiasing <> 0);
3586 
3587         if ARenderHint and (QImage_format(image) = QImageFormat_ARGB32) and (flags = QtAutoColor) and
3588           not EqualRect(LocalRect, sourceRect^) then
3589             QPainter_setRenderHint(Widget, QPainterSmoothPixmapTransform, True);
3590 
3591         {$IFDEF DARWIN}
3592         if BMacPrinter then
3593         begin
3594           ScaledImage := QImage_create();
3595           QImage_convertToFormat(Image, ScaledImage, QImageFormat_ARGB32_Premultiplied);
3596           QPainter_drawImage(Widget, PRect(@LocalRect), ScaledImage, sourceRect, flags);
3597           QImage_destroy(ScaledImage);
3598         end else
3599         {$ENDIF}
3600           QPainter_drawImage(Widget, PRect(@LocalRect), image, sourceRect, flags);
3601 
3602         if ARenderHint then
3603           QPainter_setRenderHint(Widget, QPainterSmoothPixmapTransform, not ARenderHint);
3604       end;
3605     end;
3606   end;
3607 end;
3608 
PaintEnginenull3609 function TQtDeviceContext.PaintEngine: QPaintEngineH;
3610 begin
3611   Result := QPainter_paintEngine(Widget);
3612 end;
3613 
3614 {------------------------------------------------------------------------------
3615   Function: TQtDeviceContext.rotate
3616   Params:  None
3617   Returns: Nothing
3618 
3619   Rotates the coordinate system
3620  ------------------------------------------------------------------------------}
3621 procedure TQtDeviceContext.rotate(a: Double);
3622 begin
3623   {$ifdef VerboseQt}
3624   Write('TQtDeviceContext.rotate() ');
3625   {$endif}
3626   QPainter_rotate(Widget, a);
3627 end;
3628 
3629 procedure TQtDeviceContext.setRenderHint(AHint: QPainterRenderHint; AValue: Boolean);
3630 begin
3631   QPainter_setRenderHint(Widget, AHint, AValue);
3632 end;
3633 
3634 {------------------------------------------------------------------------------
3635   Function: TQtDeviceContext.save
3636   Params:  None
3637   Returns: Nothing
3638 
3639   Saves the state of the canvas
3640  ------------------------------------------------------------------------------}
3641 procedure TQtDeviceContext.save;
3642 begin
3643   {$ifdef VerboseQt}
3644   Write('TQtDeviceContext.save() ');
3645   {$endif}
3646   QPainter_save(Widget);
3647 end;
3648 
3649 {------------------------------------------------------------------------------
3650   Function: TQtDeviceContext.restore
3651   Params:  None
3652   Returns: Nothing
3653 
3654   Restores the state of the canvas
3655  ------------------------------------------------------------------------------}
3656 procedure TQtDeviceContext.restore;
3657 begin
3658   {$ifdef VerboseQt}
3659   Write('TQtDeviceContext.restore() ');
3660   {$endif}
3661   QPainter_restore(Widget);
3662 end;
3663 
3664 {------------------------------------------------------------------------------
3665   Function: TQtDeviceContext.translate
3666   Params:  None
3667   Returns: Nothing
3668 
3669   Tranlates the coordinate system
3670  ------------------------------------------------------------------------------}
3671 procedure TQtDeviceContext.translate(dx: Double; dy: Double);
3672 begin
3673   {$ifdef VerboseQt}
3674   WriteLn('TQtDeviceContext.translate() ');
3675   {$endif}
3676   QPainter_translate(Widget, dx, dy);
3677 end;
3678 
3679 { TQtPixmap }
3680 
3681 constructor TQtPixmap.Create(p1: PSize);
3682 begin
3683   FHandle := QPixmap_create(p1);
3684 end;
3685 
3686 destructor TQtPixmap.Destroy;
3687 begin
3688   if FHandle <> nil then
3689     QPixmap_destroy(FHandle);
3690 
3691   inherited Destroy;
3692 end;
3693 
getHeightnull3694 function TQtPixmap.getHeight: Integer;
3695 begin
3696   Result := QPixmap_height(Handle);
3697 end;
3698 
getWidthnull3699 function TQtPixmap.getWidth: Integer;
3700 begin
3701   Result := QPixmap_width(Handle);
3702 end;
3703 
3704 procedure TQtPixmap.grabWidget(AWidget: QWidgetH; x: Integer = 0; y: Integer = 0; w: Integer = -1; h: Integer = -1);
3705 begin
3706   QPixmap_grabWidget(FHandle, AWidget, x, y, w, h);
3707 end;
3708 
3709 procedure TQtPixmap.grabWindow(p1: Cardinal; x: Integer; y: Integer; w: Integer; h: Integer);
3710 begin
3711   QPixmap_grabWindow(FHandle, p1, x, y, w, h);
3712 end;
3713 
3714 procedure TQtPixmap.toImage(retval: QImageH);
3715 begin
3716   QPixmap_toImage(FHandle, retval);
3717 end;
3718 
3719 class procedure TQtPixmap.fromImage(retval: QPixmapH; image: QImageH; flags: QtImageConversionFlags = QtAutoColor);
3720 begin
3721   QPixmap_fromImage(retval, image, flags);
3722 end;
3723 
3724 { TQtButtonGroup }
3725 
3726 constructor TQtButtonGroup.Create(AParent: QObjectH);
3727 begin
3728   inherited Create;
3729 
3730   Handle := QButtonGroup_create(AParent);
3731 end;
3732 
3733 destructor TQtButtonGroup.Destroy;
3734 begin
3735   QButtonGroup_destroy(Handle);
3736   inherited Destroy;
3737 end;
3738 
3739 procedure TQtButtonGroup.AddButton(AButton: QAbstractButtonH); overload;
3740 begin
3741   QButtonGroup_addButton(Handle, AButton);
3742 end;
3743 
3744 procedure TQtButtonGroup.AddButton(AButton: QAbstractButtonH; id: Integer); overload;
3745 begin
3746   QButtonGroup_addButton(Handle, AButton, id);
3747 end;
3748 
ButtonFromIdnull3749 function TQtButtonGroup.ButtonFromId(id: Integer): QAbstractButtonH;
3750 begin
3751   Result := QButtonGroup_button(Handle, id);
3752 end;
3753 
3754 procedure TQtButtonGroup.RemoveButton(AButton: QAbstractButtonH);
3755 begin
3756   QButtonGroup_removeButton(Handle, AButton);
3757 end;
3758 
3759 procedure TQtButtonGroup.SetExclusive(AExclusive: Boolean);
3760 begin
3761   QButtonGroup_setExclusive(Handle, AExclusive);
3762 end;
3763 
GetExclusivenull3764 function TQtButtonGroup.GetExclusive: Boolean;
3765 begin
3766   Result := QButtonGroup_exclusive(Handle);
3767 end;
3768 
3769 procedure TQtButtonGroup.SignalButtonClicked(AButton: QAbstractButtonH); cdecl;
3770 begin
3771   {todo}
3772 end;
3773 
3774 { TQtClipboard }
3775 
3776 constructor TQtClipboard.Create;
3777 var
3778   ClipboardType: TClipboardType;
3779 begin
3780   inherited Create;
3781   FLockClip := False;
3782   for ClipboardType := Low(TClipBoardType) to High(TClipBoardType) do
3783     FOnClipBoardRequest[ClipBoardType] := nil;
3784   FClipBoardFormats := TStringList.Create;
3785   FClipBoardFormats.Add('foo'); // 0 is reserved
3786   TheObject := QGUIApplication_clipBoard;
3787   {$IFDEF HASX11}
3788   FLockX11Selection := 0;
3789   FSelTimer := TQtTimer.CreateTimer(10, @selectionTimer, TheObject);
3790   {$ENDIF}
3791   AttachEvents;
3792 end;
3793 
3794 destructor TQtClipboard.Destroy;
3795 begin
3796   DetachEvents;
3797   {$IFDEF HASX11}
3798   if FSelTimer <> nil then
3799     FSelTimer.Free;
3800   {$ENDIF}
3801   FClipBoardFormats.Free;
3802   // This is global QApplication object so do NOT destroy it !!
3803   TheObject := nil;
3804   inherited Destroy;
3805 end;
3806 
3807 procedure TQtClipboard.AttachEvents;
3808 begin
3809   inherited AttachEvents;
3810   FClipDataChangedHook := QClipboard_hook_create(TheObject);
3811   QClipboard_hook_hook_dataChanged(FClipDataChangedHook, @signalDataChanged);
3812   {$IFDEF HASX11}
3813   FClipSelectionChangedHook := QClipboard_hook_create(TheObject);
3814   QClipboard_hook_hook_selectionChanged(FClipSelectionChangedHook,
3815     @signalSelectionChanged);
3816   {$ENDIF}
3817 end;
3818 
3819 procedure TQtClipboard.DetachEvents;
3820 begin
3821   if Assigned(FClipDataChangedHook) then
3822     QClipboard_hook_destroy(FClipDataChangedHook);
3823   FClipDataChangedHook := nil;
3824   {$IFDEF HASX11}
3825   if Assigned(FClipSelectionChangedHook) then
3826     QClipboard_hook_destroy(FClipSelectionChangedHook);
3827   FClipSelectionChangedHook := nil;
3828   {$ENDIF}
3829   inherited DetachEvents;
3830 end;
3831 
3832 procedure TQtClipboard.signalDataChanged; cdecl;
3833 begin
3834   {$IFDEF VERBOSE_QT_CLIPBOARD}
3835   writeln('signalDataChanged()');
3836   {$ENDIF}
3837   FClipChanged := IsClipboardChanged;
3838 end;
3839 
3840 {$IFDEF HASX11}
3841 procedure TQtClipboard.BeginX11SelectionLock;
3842 begin
3843   inc(FLockX11Selection);
3844 end;
3845 
3846 procedure TQtClipboard.EndX11SelectionLock;
3847 begin
3848   dec(FLockX11Selection);
3849 end;
3850 
InX11SelectionLocknull3851 function TQtClipboard.InX11SelectionLock: Boolean;
3852 begin
3853   Result := FLockX11Selection > 0;
3854 end;
3855 
3856 procedure TQtClipboard.signalSelectionChanged; cdecl;
3857 var
3858   TempMimeData: QMimeDataH;
3859   WStr: WideString;
3860   Clip: TClipBoard;
3861 begin
3862   {$IFDEF VERBOSE_QT_CLIPBOARD}
3863   writeln('signalSelectionChanged() OWNER?=', QClipboard_ownsSelection(Self.clipboard),
3864   ' FOnClipBoardRequest ? ',FOnClipBoardRequest[ctPrimarySelection] <> nil);
3865   {$ENDIF}
3866   if InX11SelectionLock then
3867     exit;
3868   TempMimeData := getMimeData(QClipboardSelection);
3869   if (TempMimeData <> nil) and
3870   (QMimeData_hasText(TempMimeData) or QMimeData_hasHtml(TempMimeData) or
3871     QMimeData_hasURLS(TempMimeData)) then
3872   begin
3873     QMimeData_text(TempMimeData, @WStr);
3874     // do not touch LCL's selection if shift is down
3875     // since in that case event is tracked via FSelTimer
3876     // until shift depressed.
3877     if QGUIApplication_keyboardModifiers() and QtShiftModifier <> 0 then
3878       exit;
3879     // do complete primaryselection cleanup at LCL side
3880     // so it asks for clip from qt (no matter is it owner or not).
3881     BeginUpdate;
3882     Clip := Clipbrd.Clipboard(ctPrimarySelection);
3883     Clip.OnRequest := nil;
3884     FOnClipBoardRequest[ctPrimarySelection] := nil;
3885     Clip.AsText := UTF8Decode(WStr);
3886     EndUpdate;
3887   end;
3888 end;
3889 
3890 procedure TQtClipboard.selectionTimer;
3891 var
3892   RptEvent: QLCLMessageEventH;
3893 begin
3894   if FOnClipBoardRequest[ctPrimarySelection] = nil then
3895   begin
3896     FSelTimer.TimerEnabled := False;
3897     exit;
3898   end;
3899   if QGUIApplication_keyboardModifiers() and QtShiftModifier = 0 then
3900   begin
3901     FSelTimer.TimerEnabled := False;
3902     RptEvent :=  QLCLMessageEvent_create(LCLQt_ClipboardPrimarySelection,
3903        PtrUInt(Ord(ctPrimarySelection)), PtrUInt(FSelFmtCount), 0, 0);
3904     QCoreApplication_postEvent(ClipBoard, RptEvent);
3905   end;
3906 end;
3907 
3908 {$ENDIF}
3909 
TQtClipboard.IsClipboardChangednull3910 function TQtClipboard.IsClipboardChanged: Boolean;
3911 var
3912   TempMimeData: QMimeDataH;
3913   Str: WideString;
3914   Str2: WideString;
3915 begin
3916   Result := not FLockClip;
3917   if FLockClip then
3918     exit;
3919   // FLockClip: here we know that our clipboard is not changed by LCL Clipboard
3920   FLockClip := True;
3921   try
3922     TempMimeData := getMimeData(QClipboardClipboard);
3923     if (TempMimeData <> nil) and
3924     (QMimeData_hasText(TempMimeData) or QMimeData_hasHtml(TempMimeData) or
3925       QMimeData_hasURLS(TempMimeData)) then
3926     begin
3927       QMimeData_text(TempMimeData, @Str);
3928       Str := UTF16ToUTF8(Str);
3929 
3930       Str2 := Clipbrd.Clipboard.AsText;
3931 
3932       Result := Str <> Str2;
3933       if Result then
3934         Clipbrd.Clipboard.AsText := Str;
3935     end;
3936   finally
3937     FLockClip := False;
3938   end;
3939 end;
3940 
TQtClipboard.EventFilternull3941 function TQtClipboard.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
3942 {$IFDEF HASX11}
3943 var
3944   ClipboardType: TClipboardType;
3945   FormatCount: PtrUint;
3946   Modifiers: QtKeyboardModifiers;
3947 
3948   procedure PutSelectionOnClipBoard;
3949   var
3950     MimeType: WideString;
3951     MimeData: QMimeDataH;
3952     Data: QByteArrayH;
3953     DataStream: TMemoryStream;
3954     I: Integer;
3955     Clip: TClipboard;
3956   begin
3957     // We must track this event if shift is down, since
3958     // we are doing keyboard selection.
3959     // When shift is depressed, selectionTimer will trigger
3960     // another event which will pass this point
3961     // and assign selection to qt selection clipboard.
3962     if Modifiers and QtShiftModifier <> 0 then
3963     begin
3964       if not FSelTimer.TimerEnabled then
3965         FSelTimer.TimerEnabled := True;
3966       exit;
3967     end;
3968     if FSelTimer.TimerEnabled then
3969       FSelTimer.TimerEnabled := False;
3970 
3971     Clip := Clipbrd.Clipboard(ClipboardType);
3972     MimeData := QMimeData_create();
3973     DataStream := TMemoryStream.Create;
3974     for I := 0 to FormatCount - 1 do
3975     begin
3976       DataStream.Size := 0;
3977       DataStream.Position := 0;
3978       MimeType := FormatToMimeType(Clip.Formats[I]);
3979       FOnClipBoardRequest[ClipboardType](Clip.Formats[I], DataStream);
3980       Data := QByteArray_create(PAnsiChar(DataStream.Memory), DataStream.Size);
3981       if (QByteArray_length(Data) > 1) and QByteArray_endsWith(Data, #0) then
3982         QByteArray_chop(Data, 1);
3983       QMimeData_setData(MimeData, @MimeType, Data);
3984       QByteArray_destroy(Data);
3985     end;
3986     DataStream.Free;
3987     // we must "wake up" QMimeData text property, otherwise
3988     // some non ascii chars could be eaten (possible qt bug)
3989     QMimeData_text(MimeData, @MimeType);
3990     setMimeData(MimeData, ClipbBoardTypeToQtClipboard[ClipBoardType]);
3991     // do not destroy MimeData!!!
3992   end;
3993 {$ENDIF}
3994 begin
3995   Result := False;
3996   BeginEventProcessing;
3997   try
3998     {$IFDEF HASX11}
3999     if QEvent_type(Event) = LCLQt_ClipboardPrimarySelection then
4000     begin
4001       ClipboardType := TClipBoardType(QLCLMessageEvent_getMsg(QLCLMessageEventH(Event)));
4002       FormatCount := QLCLMessageEvent_getWParam(QLCLMessageEventH(Event));
4003       Modifiers := QtKeyboardModifiers(QLCLMessageEvent_getLParam(QLCLMessageEventH(Event)));
4004       if FOnClipBoardRequest[ClipboardType] <> nil then
4005         PutSelectionOnClipboard;
4006       Result := True;
4007       QEvent_accept(Event);
4008     end;
4009     {$ENDIF}
4010 
4011     if QEvent_type(Event) = QEventClipboard then
4012     begin
4013       Result := FClipChanged;
4014       // Clipboard is changed, but we have no ability at moment to pass that info
4015       // to LCL since LCL has no support for that event
4016       // so we are using signalDataChanged() to pass changes to Clipbrd.Clipboard
4017       if FClipChanged then
4018         FClipChanged := False;
4019       QEvent_accept(Event);
4020     end;
4021   finally
4022     EndEventProcessing;
4023   end;
4024 end;
4025 
Clipboardnull4026 function TQtClipboard.Clipboard: QClipboardH;
4027 begin
4028   Result := QClipboardH(TheObject);
4029 end;
4030 
TQtClipboard.getMimeDatanull4031 function TQtClipboard.getMimeData(AMode: QClipboardMode): QMimeDataH;
4032 begin
4033   Result := QClipboard_mimeData(Clipboard, AMode);
4034 end;
4035 
4036 procedure TQtClipboard.setMimeData(AMimeData: QMimeDataH; AMode: QClipboardMode);
4037 begin
4038   QClipboard_setMimeData(Clipboard, AMimeData, AMode);
4039 end;
4040 
4041 procedure TQtClipboard.Clear(AMode: QClipboardMode);
4042 begin
4043   QClipboard_clear(ClipBoard, AMode);
4044 end;
4045 
TQtClipboard.FormatToMimeTypenull4046 function TQtClipboard.FormatToMimeType(AFormat: TClipboardFormat): String;
4047 begin
4048   if FClipBoardFormats.Count > Integer(AFormat) then
4049     Result := FClipBoardFormats[AFormat]
4050   else
4051     Result := '';
4052 end;
4053 
RegisterFormatnull4054 function TQtClipboard.RegisterFormat(AMimeType: String): TClipboardFormat;
4055 var
4056   Index: Integer;
4057 begin
4058   Index := FClipBoardFormats.IndexOf(AMimeType);
4059   if Index < 0 then
4060     Index := FClipBoardFormats.Add(AMimeType);
4061   Result := Index;
4062 end;
4063 
GetDatanull4064 function TQtClipboard.GetData(ClipboardType: TClipboardType;
4065   FormatID: TClipboardFormat; Stream: TStream): boolean;
4066 var
4067   QtMimeData: QMimeDataH;
4068   MimeType: WideString;
4069   Data: QByteArrayH;
4070   p: PAnsiChar;
4071   s: Integer;
4072 begin
4073   Result := False;
4074   QtMimeData := getMimeData(ClipbBoardTypeToQtClipboard[ClipBoardType]);
4075   MimeType := FormatToMimeType(FormatID);
4076   Data := QByteArray_create();
4077   QMimeData_data(QtMimeData, Data, @MimeType);
4078   s := QByteArray_size(Data);
4079   p := QByteArray_data(Data);
4080   Stream.Write(p^, s);
4081   // what to do with p? FreeMem or nothing?
4082   QByteArray_destroy(Data);
4083   Result := True;
4084 end;
4085 
GetFormatsnull4086 function TQtClipboard.GetFormats(ClipboardType: TClipboardType;
4087   var Count: integer; var List: PClipboardFormat): boolean;
4088 var
4089   QtMimeData: QMimeDataH;
4090   QtList: QStringListH;
4091   i: Integer;
4092   Str: WideString;
4093 begin
4094   Result := False;
4095   Count := 0;
4096   List := nil;
4097 
4098   QtMimeData := getMimeData(ClipbBoardTypeToQtClipboard[ClipBoardType]);
4099 
4100   QtList := QStringList_create;
4101   QMimeData_formats(QtMimeData, QtList);
4102 
4103   try
4104     Count := QStringList_size(QtList);
4105     GetMem(List, Count * SizeOf(TClipboardFormat));
4106 
4107     for i := 0 to Count - 1 do
4108     begin
4109       QStringList_at(QtList, @Str, i);
4110       Str := UTF16ToUTF8(Str);
4111       List[i] := RegisterFormat(Str);
4112     end;
4113 
4114     Result := True;
4115 
4116   finally
4117     QStringList_destroy(QtList);
4118   end;
4119 end;
4120 
TQtClipboard.GetOwnerShipnull4121 function TQtClipboard.GetOwnerShip(ClipboardType: TClipboardType;
4122   OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
4123   Formats: PClipboardFormat): boolean;
4124 
4125   procedure PutOnClipBoard;
4126   var
4127     MimeType: WideString;
4128     MimeData: QMimeDataH;
4129     Data: QByteArrayH;
4130     DataStream: TMemoryStream;
4131     I: Integer;
4132     {$IFDEF HASX11}
4133     Event: QLCLMessageEventH;
4134     {$ENDIF}
4135   begin
4136     {$IFDEF HASX11}
4137     // we must delay assigning selection to qt clipboard
4138     // so generate our private event
4139     if ClipboardType <> ctClipboard then
4140     begin
4141       FSelFmtCount := FormatCount;
4142       Event :=  QLCLMessageEvent_create(LCLQt_ClipboardPrimarySelection,
4143          PtrUInt(Ord(ClipboardType)), PtrUInt(FormatCount), PtrUInt(QGUIApplication_keyboardModifiers()), 0);
4144       QCoreApplication_postEvent(ClipBoard, Event);
4145       exit;
4146     end;
4147     {$ENDIF}
4148     MimeData := QMimeData_create();
4149     DataStream := TMemoryStream.Create;
4150     for I := 0 to FormatCount - 1 do
4151     begin
4152       DataStream.Size := 0;
4153       DataStream.Position := 0;
4154       MimeType := FormatToMimeType(Formats[I]);
4155       FOnClipBoardRequest[ClipboardType](Formats[I], DataStream);
4156       Data := QByteArray_create(PAnsiChar(DataStream.Memory), DataStream.Size);
4157       {do not remove #0 from Application/X-Laz-SynEdit-Tagged issue #25692}
4158       if (MimeType <> 'Application/X-Laz-SynEdit-Tagged') and
4159         (QByteArray_length(Data) > 1) and QByteArray_endsWith(Data, #0) then
4160           QByteArray_chop(Data, 1);
4161       QMimeData_setData(MimeData, @MimeType, Data);
4162       QByteArray_destroy(Data);
4163     end;
4164     DataStream.Free;
4165     setMimeData(MimeData, ClipbBoardTypeToQtClipboard[ClipBoardType]);
4166     // do not destroy MimeData!!!
4167   end;
4168 begin
4169   Result := False;
4170   if (FormatCount = 0) or (OnRequestProc = nil) then
4171   begin
4172   { The LCL indicates it doesn't have the clipboard data anymore
4173     and the interface can't use the OnRequestProc anymore.}
4174     FOnClipBoardRequest[ClipboardType] := nil;
4175     Result := True;
4176   end else
4177   begin
4178     if FLockClip then
4179       exit;
4180     {FLockClip: we are sure that this request comes from LCL Clipboard}
4181     FLockClip := True;
4182     try
4183       { clear OnClipBoardRequest to prevent destroying the LCL clipboard,
4184         when emptying the clipboard}
4185       FOnClipBoardRequest[ClipBoardType] := nil;
4186       {$IFDEF HASX11}
4187       // if we are InUpdate , then change is asked
4188       // from selectionChanged trigger, so don't do anything
4189       if (ClipboardType <> ctClipBoard) and InUpdate then
4190       begin
4191         Result := True;
4192         exit;
4193       end;
4194       {$ENDIF}
4195       FOnClipBoardRequest[ClipBoardType] := OnRequestProc;
4196       PutOnClipBoard;
4197       Result := True;
4198     finally
4199       FLockClip := False;
4200     end;
4201   end;
4202 end;
4203 
4204 { TQtPrinter }
4205 
4206 constructor TQtPrinter.Create;
4207 begin
4208   FPrinterActive := False;
4209   FHandle := QPrinter_create(QPrinterHighResolution);
4210 end;
4211 
4212 constructor TQtPrinter.Create(AMode: QPrinterPrinterMode);
4213 begin
4214   FPrinterActive := False;
4215   FHandle := QPrinter_create(AMode);
4216 end;
4217 
4218 destructor TQtPrinter.Destroy;
4219 begin
4220   endDoc;
4221   if FHandle <> nil then
4222     QPrinter_destroy(FHandle);
4223   inherited Destroy;
4224 end;
4225 
4226 {returns default system printer}
DefaultPrinternull4227 function TQtPrinter.DefaultPrinter: WideString;
4228 var
4229   prnName: WideString;
4230   PrnInfo: QPrinterInfoH;
4231 begin
4232   PrnInfo := QPrinterInfo_create();
4233   QPrinterInfo_defaultPrinter(PrnInfo);
4234   QPrinterInfo_printerName(PrnInfo, @PrnName);
4235   QPrinterInfo_destroy(PrnInfo);
4236   if PrnName = '' then
4237     PrnName := 'unknown';
4238   Result := UTF8ToUTF16(PrnName);
4239 end;
4240 
4241 {returns available list of printers.
4242  if there's no printer on system result will be false.
4243  Default sys printer is always 1st in the list.}
GetAvailablePrintersnull4244 function TQtPrinter.GetAvailablePrinters(Lst: TStrings): Boolean;
4245 var
4246   Str: WideString;
4247   PrnName: WideString;
4248   i: Integer;
4249   PrnInfo: QPrinterInfoH;
4250   Prntr: QPrinterInfoH;
4251   PrnList: TPtrIntArray;
4252 begin
4253   Result := False;
4254   Str := DefaultPrinter;
4255   // EnumQPrinters(Lst);
4256   PrnInfo := QPrinterInfo_create();
4257   try
4258     Lst.Clear;
4259     QPrinterInfo_availablePrinters(@PrnList);
4260     for i := Low(PrnList) to High(PrnList) do
4261     begin
4262       Prntr := QPrinterInfoH(PrnList[i]);
4263       if Assigned(Prntr) and not QPrinterInfo_isNull(Prntr) then
4264       begin
4265         QPrinterInfo_printerName(Prntr, @PrnName);
4266         if QPrinterInfo_isDefault(Prntr) then
4267           Lst.Insert(0, UTF8ToUTF16(PrnName))
4268         else
4269           Lst.Add(UTF8ToUTF16(PrnName));
4270       end;
4271     end;
4272   finally
4273     QPrinterInfo_destroy(PrnInfo);
4274   end;
4275 
4276   i := Lst.IndexOf(Str);
4277   if i > 0 then
4278     Lst.Move(i, 0);
4279   Result := Lst.Count > 0;
4280 end;
4281 
4282 procedure TQtPrinter.beginDoc;
4283 begin
4284   getPrinterContext;
4285   FPrinterActive := FPrinterContext <> nil;
4286 end;
4287 
4288 procedure TQtPrinter.endDoc;
4289 begin
4290   if FPrinterContext <> nil then
4291   begin
4292     if QPainter_isActive(FPrinterContext.Widget) then
4293       QPainter_end(FPrinterContext.Widget);
4294     FPrinterContext.Free;
4295     FPrinterContext := nil;
4296   end;
4297   FPrinterActive := False;
4298 end;
4299 
TQtPrinter.getPrinterContextnull4300 function TQtPrinter.getPrinterContext: TQtDeviceContext;
4301 begin
4302   if FPrinterContext = nil then
4303     FPrinterContext := TQtDeviceContext.CreatePrinterContext(Handle);
4304   Result := FPrinterContext;
4305 end;
4306 
TQtPrinter.GetDuplexModenull4307 function TQtPrinter.GetDuplexMode: QPrinterDuplexMode;
4308 begin
4309   Result := QPrinter_duplex(FHandle);
4310 end;
4311 
TQtPrinter.getCollateCopiesnull4312 function TQtPrinter.getCollateCopies: Boolean;
4313 begin
4314   Result := QPrinter_collateCopies(FHandle);
4315 end;
4316 
TQtPrinter.getColorModenull4317 function TQtPrinter.getColorMode: QPrinterColorMode;
4318 begin
4319   Result := QPrinter_colorMode(FHandle);
4320 end;
4321 
TQtPrinter.getCreatornull4322 function TQtPrinter.getCreator: WideString;
4323 var
4324   Str: WideString;
4325 begin
4326   QPrinter_creator(FHandle, @Str);
4327   Result := UTF16ToUTF8(Str);
4328 end;
4329 
getDevTypenull4330 function TQtPrinter.getDevType: Integer;
4331 begin
4332   Result := QPrinter_devType(FHandle);
4333 end;
4334 
getDocNamenull4335 function TQtPrinter.getDocName: WideString;
4336 var
4337   Str: WideString;
4338 begin
4339   QPrinter_docName(FHandle, @Str);
4340   Result := UTF16ToUTF8(Str);
4341 end;
4342 
getDoubleSidedPrintingnull4343 function TQtPrinter.getDoubleSidedPrinting: Boolean;
4344 begin
4345   Result := QPrinter_doubleSidedPrinting(FHandle);
4346 end;
4347 
getFontEmbeddingnull4348 function TQtPrinter.getFontEmbedding: Boolean;
4349 begin
4350   Result := QPrinter_fontEmbeddingEnabled(FHandle);
4351 end;
4352 
TQtPrinter.getFullPagenull4353 function TQtPrinter.getFullPage: Boolean;
4354 begin
4355   Result := QPrinter_fullPage(FHandle);
4356 end;
4357 
4358 procedure TQtPrinter.setOutputFormat(const AValue: QPrinterOutputFormat);
4359 begin
4360   QPrinter_setOutputFormat(FHandle, AValue);
4361 end;
4362 
4363 procedure TQtPrinter.setPaperSource(const AValue: QPrinterPaperSource);
4364 begin
4365   QPrinter_setPaperSource(FHandle, AValue);
4366 end;
4367 
getOutputFormatnull4368 function TQtPrinter.getOutputFormat: QPrinterOutputFormat;
4369 begin
4370   Result := QPrinter_outputFormat(FHandle);
4371 end;
4372 
TQtPrinter.getPaperSourcenull4373 function TQtPrinter.getPaperSource: QPrinterPaperSource;
4374 begin
4375   Result := QPrinter_paperSource(FHandle);
4376 end;
4377 
getPrintProgramnull4378 function TQtPrinter.getPrintProgram: WideString;
4379 var
4380   Str: WideString;
4381 begin
4382   QPrinter_printProgram(FHandle, @Str);
4383   Result := UTF16ToUTF8(Str);
4384 end;
4385 
getPrintRangenull4386 function TQtPrinter.getPrintRange: QPrinterPrintRange;
4387 begin
4388   Result := QPrinter_printRange(FHandle);
4389 end;
4390 
4391 procedure TQtPrinter.setCollateCopies(const AValue: Boolean);
4392 begin
4393   QPrinter_setCollateCopies(FHandle, AValue);
4394 end;
4395 
4396 procedure TQtPrinter.setColorMode(const AValue: QPrinterColorMode);
4397 begin
4398   QPrinter_setColorMode(FHandle, AValue);
4399 end;
4400 
4401 procedure TQtPrinter.setCreator(const AValue: WideString);
4402 var
4403   Str: WideString;
4404 begin
4405   Str := GetUtf8String(AValue);
4406   QPrinter_setCreator(FHandle, @Str);
4407 end;
4408 
4409 procedure TQtPrinter.setDocName(const AValue: WideString);
4410 var
4411   Str: WideString;
4412 begin
4413   Str := GetUtf8String(AValue);
4414   QPrinter_setDocName(FHandle, @Str);
4415 end;
4416 
4417 procedure TQtPrinter.setDoubleSidedPrinting(const AValue: Boolean);
4418 begin
4419   QPrinter_setDoubleSidedPrinting(FHandle, AValue);
4420 end;
4421 
4422 procedure TQtPrinter.SetDuplexMode(AValue: QPrinterDuplexMode);
4423 begin
4424   QPrinter_setDuplex(FHandle, AValue);
4425 end;
4426 
4427 procedure TQtPrinter.setFontEmbedding(const AValue: Boolean);
4428 begin
4429   QPrinter_setFontEmbeddingEnabled(FHandle, AValue);
4430 end;
4431 
4432 procedure TQtPrinter.setFullPage(const AValue: Boolean);
4433 begin
4434   QPrinter_setFullPage(FHandle, AValue);
4435 end;
4436 
4437 procedure TQtPrinter.setPrinterName(const AValue: WideString);
4438 var
4439   Str: WideString;
4440 begin
4441   Str := GetUtf8String(AValue);
4442   QPrinter_setPrinterName(FHandle, @Str);
4443 end;
4444 
TQtPrinter.getPrinterNamenull4445 function TQtPrinter.getPrinterName: WideString;
4446 var
4447   Str: WideString;
4448 begin
4449   QPrinter_printerName(FHandle, @Str);
4450   Result := UTF16ToUTF8(Str);
4451 end;
4452 
4453 procedure TQtPrinter.setOutputFileName(const AValue: WideString);
4454 var
4455   Str: WideString;
4456 begin
4457   Str := GetUtf8String(AValue);
4458   QPrinter_setOutputFileName(FHandle, @Str);
4459 end;
4460 
TQtPrinter.getOutputFileNamenull4461 function TQtPrinter.getOutputFileName: WideString;
4462 var
4463   Str: WideString;
4464 begin
4465   QPrinter_outputFileName(FHandle, @Str);
4466   Result := UTF16ToUTF8(Str);
4467 end;
4468 
4469 procedure TQtPrinter.setOrientation(const AValue: QPrinterOrientation);
4470 begin
4471   QPrinter_setOrientation(FHandle, AValue);
4472 end;
4473 
getOrientationnull4474 function TQtPrinter.getOrientation: QPrinterOrientation;
4475 begin
4476   Result := QPrinter_orientation(FHandle);
4477 end;
4478 
4479 procedure TQtPrinter.setPageSize(const AValue: QPagedPaintDevicePageSize);
4480 begin
4481   QPrinter_setPaperSize(FHandle, AValue);
4482 end;
4483 
getPageSizenull4484 function TQtPrinter.getPageSize: QPagedPaintDevicePageSize;
4485 begin
4486   Result := QPrinter_paperSize(FHandle);
4487 end;
4488 
4489 procedure TQtPrinter.setPageOrder(const AValue: QPrinterPageOrder);
4490 begin
4491   QPrinter_setPageOrder(FHandle, AValue);
4492 end;
4493 
getPageOrdernull4494 function TQtPrinter.getPageOrder: QPrinterPageOrder;
4495 begin
4496   Result := QPrinter_pageOrder(FHandle);
4497 end;
4498 
4499 procedure TQtPrinter.setPrintProgram(const AValue: WideString);
4500 var
4501   Str: WideString;
4502 begin
4503   Str := GetUtf8String(AValue);
4504   QPrinter_setPrintProgram(FHandle, @Str);
4505 end;
4506 
4507 procedure TQtPrinter.setPrintRange(const AValue: QPrinterPrintRange);
4508 begin
4509   QPrinter_setPrintRange(FHandle, AValue);
4510 end;
4511 
4512 procedure TQtPrinter.setResolution(const AValue: Integer);
4513 begin
4514   QPrinter_setResolution(FHandle, AValue);
4515 end;
4516 
getResolutionnull4517 function TQtPrinter.getResolution: Integer;
4518 begin
4519   Result := QPrinter_resolution(FHandle);
4520 end;
4521 
TQtPrinter.getNumCopiesnull4522 function TQtPrinter.getNumCopies: Integer;
4523 begin
4524   Result := QPrinter_numCopies(FHandle);
4525 end;
4526 
4527 procedure TQtPrinter.setNumCopies(const AValue: Integer);
4528 begin
4529   QPrinter_setNumCopies(FHandle, AValue);
4530 end;
4531 
TQtPrinter.getPrinterStatenull4532 function TQtPrinter.getPrinterState: QPrinterPrinterState;
4533 begin
4534   Result := QPrinter_printerState(FHandle);
4535 end;
4536 
NewPagenull4537 function TQtPrinter.NewPage: Boolean;
4538 begin
4539   Result := QPrinter_newPage(FHandle);
4540 end;
4541 
Abortnull4542 function TQtPrinter.Abort: Boolean;
4543 begin
4544   Result := QPrinter_abort(FHandle);
4545 end;
4546 
4547 procedure TQtPrinter.setFromPageToPage(const AFromPage, AToPage: Integer);
4548 begin
4549   QPrinter_setFromTo(FHandle, AFromPage, AToPage);
4550 end;
4551 
TQtPrinter.fromPagenull4552 function TQtPrinter.fromPage: Integer;
4553 begin
4554   Result := QPrinter_fromPage(FHandle);
4555 end;
4556 
TQtPrinter.toPagenull4557 function TQtPrinter.toPage: Integer;
4558 begin
4559   Result := QPrinter_toPage(FHandle);
4560 end;
4561 
PaintEnginenull4562 function TQtPrinter.PaintEngine: QPaintEngineH;
4563 begin
4564   Result := QPrinter_paintEngine(FHandle);
4565 end;
4566 
PageRectnull4567 function TQtPrinter.PageRect: TRect;
4568 begin
4569   QPrinter_pageRect(FHandle, @Result);
4570 end;
4571 
TQtPrinter.PaperRectnull4572 function TQtPrinter.PaperRect: TRect;
4573 begin
4574   QPrinter_paperRect(FHandle, @Result);
4575 end;
4576 
PageRectnull4577 function TQtPrinter.PageRect(AUnits: QPrinterUnit): TRect;
4578 var
4579   R: QRectFH;
4580 begin
4581   R := QRectF_create();
4582   QPrinter_pageRect(FHandle, R, AUnits);
4583   QRectF_toRect(R, @Result);
4584   QRectF_destroy(R);
4585 end;
4586 
TQtPrinter.PaperRectnull4587 function TQtPrinter.PaperRect(AUnits: QPrinterUnit): TRect;
4588 var
4589   R: QRectFH;
4590 begin
4591   R := QRectF_create();
4592   QPrinter_paperRect(FHandle, R, AUnits);
4593   QRectF_toRect(R, @Result);
4594   QRectF_destroy(R);
4595 end;
4596 
PrintEnginenull4597 function TQtPrinter.PrintEngine: QPrintEngineH;
4598 begin
4599   Result := QPrinter_printEngine(FHandle);
4600 end;
4601 
TQtPrinter.GetPaperSizenull4602 function TQtPrinter.GetPaperSize(AUnits: QPrinterUnit): TSize;
4603 var
4604   SizeF: QSizeFH;
4605 begin
4606   SizeF := QSizeF_create(0, 0);
4607   QPrinter_paperSize(FHandle, SizeF, AUnits);
4608   Result.cx := Round(QSizeF_width(SizeF));
4609   Result.cy := Round(QSizeF_height(SizeF));
4610   QSizeF_destroy(SizeF);
4611 end;
4612 
4613 procedure TQtPrinter.SetPaperSize(ASize: TSize; AUnits: QPrinterUnit);
4614 var
4615   SizeF: QSizeFH;
4616 begin
4617   SizeF := QSizeF_create(@ASize);
4618   try
4619     QPrinter_setPaperSize(FHandle, SizeF, AUnits);
4620   finally
4621     QSizeF_destroy(SizeF);
4622   end;
4623 end;
4624 
SupportedResolutionsnull4625 function TQtPrinter.SupportedResolutions: TPtrIntArray;
4626 begin
4627   QPrinter_supportedResolutions(FHandle, @Result);
4628 end;
4629 
4630 
4631 { TQtTimer }
4632 
4633 {------------------------------------------------------------------------------
4634   Function: TQtTimer.CreateTimer
4635   Params:  None
4636   Returns: Nothing
4637  ------------------------------------------------------------------------------}
4638 constructor TQtTimer.CreateTimer(Interval: integer;
4639   const TimerFunc: TWSTimerProc; App: QObjectH);
4640 begin
4641   inherited Create;
4642   FDeleteLater := True;
4643   FAppObject := App;
4644 
4645   FCallbackFunc := TimerFunc;
4646 
4647   TheObject := QTimer_create(App);
4648 
4649   QTimer_setInterval(QTimerH(TheObject), Interval);
4650 
4651   AttachEvents;
4652 
4653   // start timer and get ID
4654   QTimer_start(QTimerH(TheObject), Interval);
4655   FId := QTimer_timerId(QTimerH(TheObject));
4656 
4657   {$ifdef VerboseQt}
4658     WriteLn('TQtTimer.CreateTimer: Interval = ', Interval, ' ID = ', FId);
4659   {$endif}
4660 end;
4661 
4662 {------------------------------------------------------------------------------
4663   Function: TQtTimer.Destroy
4664   Params:  None
4665   Returns: Nothing
4666  ------------------------------------------------------------------------------}
4667 destructor TQtTimer.Destroy;
4668 begin
4669   {$ifdef VerboseQt}
4670     WriteLn('TQtTimer.CreateTimer: Destroy. ID = ', FId);
4671   {$endif}
4672 
4673   FCallbackFunc := nil;
4674   inherited Destroy;
4675 end;
4676 
4677 procedure TQtTimer.AttachEvents;
4678 begin
4679   FTimerHook := QTimer_hook_create(QTimerH(TheObject));
4680   QTimer_hook_hook_timeout(FTimerHook, @signalTimeout);
4681   inherited AttachEvents;
4682 end;
4683 
4684 procedure TQtTimer.DetachEvents;
4685 begin
4686   QTimer_stop(QTimerH(TheObject));
4687   if FTimerHook <> nil then
4688     QTimer_hook_destroy(FTimerHook);
4689   inherited DetachEvents;
4690 end;
4691 
4692 procedure TQtTimer.signalTimeout; cdecl;
4693 begin
4694   if Assigned(FCallbackFunc) then
4695     FCallbackFunc;
4696 end;
4697 
getTimerEnablednull4698 function TQtTimer.getTimerEnabled: Boolean;
4699 begin
4700   if TheObject <> nil then
4701     Result := QTimer_isActive(QTimerH(TheObject))
4702   else
4703     Result := False;
4704 end;
4705 
4706 procedure TQtTimer.setTimerEnabled(const AValue: Boolean);
4707 begin
4708   if (TheObject <> nil) and (getTimerEnabled <> AValue) then
4709   begin
4710     if AValue then
4711       QTimer_start(QTimerH(TheObject))
4712     else
4713       QTimer_stop(QTimerH(TheObject));
4714   end;
4715 end;
4716 
4717 {------------------------------------------------------------------------------
4718   Function: TQtTimer.EventFilter
4719   Params:  None
4720   Returns: Nothing
4721  ------------------------------------------------------------------------------}
EventFilternull4722 function TQtTimer.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
4723 begin
4724   Result := False;
4725   QEvent_accept(Event);
4726 end;
4727 
4728 { TQtIcon }
4729 
4730 constructor TQtIcon.Create;
4731 begin
4732   FHandle := QIcon_create();
4733 end;
4734 
4735 destructor TQtIcon.Destroy;
4736 begin
4737   if FHandle <> nil then
4738     QIcon_destroy(FHandle);
4739 
4740   inherited Destroy;
4741 end;
4742 
4743 procedure TQtIcon.addPixmap(pixmap: QPixmapH; mode: QIconMode = QIconNormal; state: QIconState = QIconOff);
4744 begin
4745   QIcon_addPixmap(Handle, pixmap, mode, state);
4746 end;
4747 
4748 { TQtStringList }
4749 
Getnull4750 function TQtStringList.Get(Index: Integer): string;
4751 var
4752   W: Widestring;
4753 begin
4754   QStringList_at(FHandle, @W, Index);
4755   Result := UTF16ToUTF8(W);
4756 end;
4757 
TQtStringList.GetCountnull4758 function TQtStringList.GetCount: Integer;
4759 begin
4760   Result := QStringList_size(FHandle);
4761 end;
4762 
4763 constructor TQtStringList.Create;
4764 begin
4765   inherited Create;
4766   FHandle := QStringList_create();
4767   FOwnHandle := True;
4768 end;
4769 
4770 constructor TQtStringList.Create(Source: QStringListH);
4771 begin
4772   inherited Create;
4773   FHandle := Source;
4774   FOwnHandle := False;
4775 end;
4776 
4777 destructor TQtStringList.Destroy;
4778 begin
4779   if FOwnHandle then
4780     QStringList_destroy(FHandle);
4781   inherited Destroy;
4782 end;
4783 
4784 procedure TQtStringList.Clear;
4785 begin
4786   QStringList_clear(FHandle);
4787 end;
4788 
4789 procedure TQtStringList.Delete(Index: Integer);
4790 begin
4791   QStringList_removeAt(FHandle, Index);
4792 end;
4793 
4794 procedure TQtStringList.Insert(Index: Integer; const S: string);
4795 var
4796   W: WideString;
4797 begin
4798   W := GetUtf8String(S);
4799   QStringList_insert(FHandle, Index, @W);
4800 end;
4801 
4802 { TQtCursor }
4803 
4804 constructor TQtCursor.Create;
4805 begin
4806   FHandle := QCursor_create();
4807 end;
4808 
4809 constructor TQtCursor.Create(pixmap: QPixmapH; hotX: Integer  = -1; hotY: Integer = -1);
4810 begin
4811   FHandle := QCursor_create(pixmap, hotX, hotY);
4812 end;
4813 
4814 constructor TQtCursor.Create(shape: QtCursorShape);
4815 begin
4816   FHandle := QCursor_create(shape);
4817 end;
4818 
4819 destructor TQtCursor.Destroy;
4820 begin
4821   if FHandle <> nil then
4822     QCursor_destroy(FHandle);
4823 
4824   inherited Destroy;
4825 end;
4826 
4827 { TQtWidgetPalette }
4828 
4829 procedure TQtWidgetPalette.initializeSysColors;
4830 var
4831   Palette: QPaletteH;
4832 begin
4833   FillChar(FCurrentColor, SizeOf(FCurrentColor), 0);
4834   FillChar(FCurrentColor, SizeOf(FCurrentTextColor), 0);
4835   Palette := QPalette_create();
4836   try
4837     QGUIApplication_palette(Palette);
4838     FDefaultColor := QPalette_color(Palette, QPaletteActive, FWidgetRole)^;
4839     FDefaultTextColor := QPalette_color(Palette, QPaletteActive, FTextRole)^;
4840     FDisabledColor := QPalette_color(Palette, QPaletteDisabled, FWidgetRole)^;
4841     FDisabledTextColor := QPalette_color(Palette, QPaletteDisabled, FTextRole)^;
4842   finally
4843     QPalette_destroy(Palette);
4844   end;
4845 end;
4846 
4847 constructor TQtWidgetPalette.Create(AWidgetColorRole: QPaletteColorRole;
4848   AWidgetTextColorRole: QPaletteColorRole; AWidget: QWidgetH);
4849 begin
4850   FInReload := False;
4851   FForceColor := False;
4852   FWidget := AWidget;
4853   FWidgetRole := AWidgetColorRole;
4854   FTextRole := AWidgetTextColorRole;
4855   initializeSysColors;
4856 
4857   // ugly qt mac bug
4858   {$IFDEF DARWIN}
4859   if QWidget_backgroundRole(FWidget) <> FWidgetRole then
4860   begin
4861     QWidget_setBackgroundRole(FWidget, FWidgetRole);
4862     QWidget_setForegroundRole(FWidget, FTextRole);
4863   end;
4864   {$ENDIF}
4865 
4866   FHandle := QPalette_create();
4867 end;
4868 
4869 destructor TQtWidgetPalette.Destroy;
4870 begin
4871   if FHandle <> nil then
4872     QPalette_destroy(FHandle);
4873   inherited Destroy;
4874 end;
4875 
TQtWidgetPalette.ColorChangeNeedednull4876 function TQtWidgetPalette.ColorChangeNeeded(const AColor: TQColor;
4877   const ATextRole: Boolean): Boolean;
4878 begin
4879   if ATextRole then
4880     Result := not (EqualTQColor(AColor, FDefaultTextColor) and
4881       EqualTQColor(FCurrentTextColor, FDefaultTextColor))
4882   else
4883     Result := not (EqualTQColor(AColor, FDefaultColor) and
4884       EqualTQColor(FCurrentColor, FDefaultColor));
4885 end;
4886 
4887 procedure TQtWidgetPalette.setColor(const AColor: PQColor);
4888 begin
4889   if not ColorChangeNeeded(AColor^, False) and not FInReload and not FForceColor then
4890     exit;
4891 
4892   QPalette_setColor(FHandle, QPaletteActive, FWidgetRole, AColor);
4893   QPalette_setColor(FHandle, QPaletteInActive, FWidgetRole, AColor);
4894 
4895   if EqualTQColor(AColor^, FDefaultColor) then
4896     QPalette_setColor(FHandle, QPaletteDisabled, FWidgetRole, @FDisabledColor)
4897   else
4898     QPalette_setColor(FHandle, QPaletteDisabled, FWidgetRole, AColor);
4899 
4900   QWidget_setPalette(FWidget, FHandle);
4901   FCurrentColor := AColor^;
4902 end;
4903 
4904 procedure TQtWidgetPalette.setTextColor(const AColor: PQColor);
4905 begin
4906   if not ColorChangeNeeded(AColor^, True) and not FInReload and not FForceColor then
4907     exit;
4908   QPalette_setColor(FHandle, QPaletteActive, FTextRole, AColor);
4909   QPalette_setColor(FHandle, QPaletteInActive, FTextRole, AColor);
4910   if EqualTQColor(AColor^, FDefaultTextColor) or
4911      EqualTQColor(FCurrentColor, FDefaultColor) then
4912     QPalette_setColor(FHandle, QPaletteDisabled, FTextRole, @FDisabledTextColor)
4913   else
4914     QPalette_setColor(FHandle, QPaletteDisabled, FTextRole, AColor);
4915   QWidget_setPalette(FWidget, FHandle);
4916   FCurrentTextColor := AColor^;
4917 end;
4918 
4919 procedure TQtWidgetPalette.ReloadPaletteBegin;
4920 var
4921   AOldCurrent, AOldText: TQColor;
4922 begin
4923   FInReload := True;
4924   AOldCurrent := FCurrentColor;
4925   AOldText := FCurrentTextColor;
4926   initializeSysColors;
4927   FCurrentColor := AOldCurrent;
4928   FCurrentTextColor := AOldText;
4929 end;
4930 
4931 procedure TQtWidgetPalette.ReloadPaletteEnd;
4932 begin
4933   FInReload := False;
4934 end;
4935 
4936 { TQtActionGroup }
4937 
4938 constructor TQtActionGroup.Create(const AParent: QObjectH);
4939 begin
4940   FGroupIndex := 0;
4941   Initialize(FActions);
4942   FHandle := QActionGroup_create(AParent);
4943 end;
4944 
4945 destructor TQtActionGroup.Destroy;
4946 begin
4947   if FHandle <> nil then
4948     QActionGroup_destroy(FHandle);
4949   Finalize(FActions);
4950   FActions := nil;
4951   inherited Destroy;
4952 end;
4953 
TQtActionGroup.getEnablednull4954 function TQtActionGroup.getEnabled: boolean;
4955 begin
4956   Result := QActionGroup_isEnabled(FHandle);
4957 end;
4958 
TQtActionGroup.getExclusivenull4959 function TQtActionGroup.getExclusive: boolean;
4960 begin
4961   Result := QActionGroup_isExclusive(FHandle);
4962 end;
4963 
getVisiblenull4964 function TQtActionGroup.getVisible: boolean;
4965 begin
4966   Result := QActionGroup_isVisible(FHandle);
4967 end;
4968 
4969 procedure TQtActionGroup.setEnabled(const AValue: boolean);
4970 begin
4971   QActionGroup_setEnabled(FHandle, AValue);
4972 end;
4973 
4974 procedure TQtActionGroup.setExclusive(const AValue: boolean);
4975 begin
4976   QActionGroup_setExclusive(FHandle, AValue);
4977 end;
4978 
4979 procedure TQtActionGroup.setVisible(const AValue: boolean);
4980 begin
4981   QActionGroup_setVisible(FHandle, AValue);
4982 end;
4983 
addActionnull4984 function TQtActionGroup.addAction(action: QActionH): QActionH;
4985 begin
4986   Result := QActionGroup_addAction(FHandle, action);
4987 end;
4988 
addActionnull4989 function TQtActionGroup.addAction(text: WideString): QActionH;
4990 var
4991   WStr: WideString;
4992 begin
4993   WStr := GetUTF8String(text);
4994   Result := QActionGroup_addAction(FHandle, @WStr);
4995 end;
4996 
addActionnull4997 function TQtActionGroup.addAction(icon: QIconH; text: WideString): QActionH;
4998 var
4999   WStr: WideString;
5000 begin
5001   WStr := GetUTF8String(text);
5002   Result := QActionGroup_addAction(FHandle, icon, @WStr);
5003 end;
5004 
5005 procedure TQtActionGroup.removeAction(action: QActionH);
5006 begin
5007   QActionGroup_removeAction(FHandle, action);
5008 end;
5009 
TQtActionGroup.actionsnull5010 function TQtActionGroup.actions: TQActions;
5011 var
5012   i: Integer;
5013   Arr: TPtrIntArray;
5014 begin
5015   QActionGroup_actions(FHandle, @Arr);
5016   SetLength(FActions, length(Arr));
5017   for i := 0 to High(Arr) do
5018     FActions[i] := QActionH(Arr[i]);
5019   Result := FActions;
5020 end;
5021 
checkedActionnull5022 function TQtActionGroup.checkedAction: QActionH;
5023 begin
5024   Result := QActionGroup_checkedAction(FHandle);
5025 end;
5026 
5027 procedure TQtActionGroup.setDisabled(ADisabled: Boolean);
5028 begin
5029   QActionGroup_setDisabled(FHandle, ADisabled);
5030 end;
5031 
5032 { TQtObjectDump }
5033 
5034 procedure TQtObjectDump.Iterator(ARoot: QObjectH);
5035 var
5036   i: Integer;
5037   Children: TPtrIntArray;
5038 begin
5039   QObject_children(ARoot, @Children);
5040   AddToList(ARoot);
5041   for i := 0 to High(Children) do
5042     Iterator(QObjectH(Children[i]))
5043 end;
5044 
5045 procedure TQtObjectDump.AddToList(AnObject: QObjectH);
5046 // var
5047 //  ObjName: WideString;
5048 begin
5049   if AnObject <> nil then
5050   begin
5051     // QObject_objectName(AnObject, @ObjName);
5052     if FObjList.IndexOf(AnObject) < 0 then
5053     begin
5054       FList.Add(dbghex(PtrUInt(AnObject)));
5055       FObjList.Add(AnObject);
5056     end else
5057       raise Exception.Create('TQtObjectDump: Duplicated object in list '+dbghex(PtrUInt(AnObject)));
5058   end;
5059 end;
5060 
5061 procedure TQtObjectDump.DumpObject;
5062 begin
5063   if FRoot = nil then
5064     raise Exception.Create('TQtObjectDump: Invalid FRoot '+dbghex(PtrUInt(FRoot)));
5065   Iterator(FRoot);
5066 end;
5067 
TQtObjectDump.findWidgetByNamenull5068 function TQtObjectDump.findWidgetByName(const AName: WideString): QWidgetH;
5069 var
5070   j: Integer;
5071   WS: WideString;
5072 begin
5073   Result := nil;
5074   if AName = '' then
5075     exit;
5076   for j := 0 to FObjList.Count - 1 do
5077   begin
5078     QObject_objectName(QObjectH(FObjList.Items[j]), @WS);
5079     if (WS = AName) and QObject_isWidgetType(QObjectH(FObjList.Items[j])) then
5080     begin
5081       Result := QWidgetH(FObjList.Items[j]);
5082       break;
5083     end;
5084   end;
5085 end;
5086 
IsWidgetnull5087 function TQtObjectDump.IsWidget(AnObject: QObjectH): Boolean;
5088 begin
5089   if AnObject <> nil then
5090     Result := QObject_IsWidgetType(AnObject)
5091   else
5092     Result := False;
5093 end;
5094 
GetObjectNamenull5095 function TQtObjectDump.GetObjectName(AnObject: QObjectH): WideString;
5096 begin
5097   Result := '';
5098   if AnObject = nil then
5099     exit;
5100   QObject_objectName(AnObject, @Result);
5101 end;
5102 
InheritsQtClassnull5103 function TQtObjectDump.InheritsQtClass(AnObject: QObjectH;
5104   AQtClass: WideString): Boolean;
5105 begin
5106   if (AnObject = nil) or (AQtClass = '') then
5107     Result := False
5108   else
5109     Result := QObject_inherits(AnObject, @AQtClass);
5110 end;
5111 
5112 constructor TQtObjectDump.Create(AnObject: QObjectH);
5113 begin
5114   FRoot := AnObject;
5115   FList := TStringList.Create;
5116   FObjList := TFPList.Create;
5117 end;
5118 
5119 destructor TQtObjectDump.Destroy;
5120 begin
5121   FList.Free;
5122   FObjList.Free;
5123   inherited Destroy;
5124 end;
5125 
5126 { TQtGDIObjects }
5127 
5128 constructor TQtGDIObjects.Create;
5129 begin
5130   inherited Create;
5131   {$IFDEF DebugQTGDIObjects}
5132   FMaxCount := 0;
5133   FInvalidCount := 0;
5134   {$ENDIF}
5135   FCount := 0;
5136   FSavedHandlesList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TObject));
5137   {$IFDEF DebugQTGDIObjects}
5138   DebugLn('TQtGDIObjects.Create ');
5139   {$ENDIF}
5140 end;
5141 
5142 destructor TQtGDIObjects.Destroy;
5143 begin
5144   {$IFDEF DebugQTGDIObjects}
5145   DebugLn('TQtGDIObjects.Destroy: Count (must be zero) ',dbgs(FCount),
5146     ' FMaxCount ',dbgs(FMaxCount),' FInvalidCount ',dbgs(FInvalidCount));
5147   {$ENDIF}
5148   FSavedHandlesList.Free;
5149   inherited Destroy;
5150 end;
5151 
5152 procedure TQtGDIObjects.AddGDIObject(AObject: TObject);
5153 begin
5154   if not FSavedHandlesList.HasId(AObject) then
5155   begin
5156     FSavedHandlesList.Add(AObject, AObject);
5157     inc(FCount);
5158     {$IFDEF DebugQTGDIObjects}
5159     if FMaxCount < FCount then
5160       FMaxCount := FCount;
5161     {$ENDIF}
5162   end;
5163 end;
5164 
5165 procedure TQtGDIObjects.RemoveGDIObject(AObject: TObject);
5166 begin
5167   if FSavedHandlesList.HasId(AObject) then
5168   begin
5169     FSavedHandlesList.Delete(AObject);
5170     dec(FCount);
5171   end;
5172 end;
5173 
TQtGDIObjects.IsValidGDIObjectnull5174 function TQtGDIObjects.IsValidGDIObject(AGDIObject: PtrUInt): Boolean;
5175 begin
5176   if (AGDIObject = 0) then
5177     Exit(False);
5178   Result := FSavedHandlesList.HasId(TObject(AGDIObject));
5179   {$IFDEF DebugQTGDIObjects}
5180   if not Result then
5181   begin
5182     inc(FInvalidCount);
5183     DebugLn('TQtGDIObjects.IsValidGDIObject: Invalid object ',dbgs(AGDIObject));
5184   end;
5185   {$ENDIF}
5186 end;
5187 
5188 end.
5189 
5190 
5191 
5192 
5193 
5194