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