1{%MainUnit qtint.pp}
2{ $Id$ }
3{******************************************************************************
4  All QT Winapi implementations.
5  This are the implementations of the overrides of the QT Interface for the
6  methods defined in the
7  lcl/include/winapi.inc
8
9
10  !! Keep alphabetical !!
11
12
13 ******************************************************************************
14 Implementation
15 ******************************************************************************
16
17 *****************************************************************************
18  This file is part of the Lazarus Component Library (LCL)
19
20  See the file COPYING.modifiedLGPL.txt, included in this distribution,
21  for details about the license.
22 *****************************************************************************
23}
24
25//##apiwiz##sps##   // Do not remove, no wizard declaration before this line
26
27{------------------------------------------------------------------------------
28  Function: Arc
29  Params: DC: HDC; Left,Top,Right,Bottom,angle1,angle2 : Integer
30  Returns: Boolean
31 ------------------------------------------------------------------------------}
32function TQtWidgetSet.Arc(DC: HDC; Left,Top,Right,Bottom,angle1,angle2 : Integer): Boolean;
33var
34  R: TRect;
35begin
36  {$ifdef VerboseQtWinAPI}
37    WriteLn('[WinAPI Arc] DC: ', dbghex(DC));
38  {$endif}
39  Result := IsValidDC(DC);
40
41  if Result then
42  begin
43    R := Rect(Left, Top, Right, Bottom);
44    QPainter_drawArc(TQtDeviceContext(DC).Widget, @R, Angle1, Angle2);
45  end;
46end;
47
48{------------------------------------------------------------------------------
49  Function: AngleChord
50  Params: DC: HDC; x1, y1, x2, y2, angle1, angle2: Integer
51  Returns: Boolean
52 ------------------------------------------------------------------------------}
53function TQtWidgetSet.AngleChord(DC: HDC; x1, y1, x2, y2, angle1, angle2: Integer): Boolean;
54begin
55  {$ifdef VerboseQtWinAPI}
56    WriteLn('[WinAPI AngleChord] DC: ', dbghex(DC));
57  {$endif}
58  Result := IsValidDC(DC);
59  if Result then
60    QPainter_drawChord(TQtDeviceContext(DC).Widget, x1, y1, x2 - x1, y2 - y1, Angle1, Angle2);
61end;
62
63{------------------------------------------------------------------------------
64  Function: BeginPaint
65  Params:
66  Returns:
67
68  This function is Called:
69  - Once on every OnPaint event
70 ------------------------------------------------------------------------------}
71function TQtWidgetSet.BeginPaint(Handle: hWnd; Var PS: TPaintStruct): hdc;
72var
73  Widget: TQtWidget;
74  DC: TQtDeviceContext;
75begin
76  {$ifdef VerboseQtWinAPI}
77    WriteLn('Trace:> [WinAPI BeginPaint] Handle=', dbghex(Handle));
78  {$endif}
79  Widget := TQtWidget(Handle);
80  if Widget <> nil then
81    DC := TQtDeviceContext.Create(Widget.PaintData.PaintWidget, True)
82  else
83    DC := TQtDeviceContext.Create(nil, True);
84
85  PS.hdc := HDC(DC);
86
87  if Handle<>0 then
88  begin
89    // if current handle has paintdata information,
90    // setup hdc with it
91    //DC.DebugClipRect('BeginPaint: Before');
92    if (QtVersionMajor = 4) and (QtVersionMinor > 6) then
93      QPainter_setLayoutDirection(DC.Widget, QtLayoutDirectionAuto);
94    if Widget.PaintData.ClipRegion <> nil then
95    begin
96      //Write('>>> Setting Paint ClipRegion: ');
97      //DebugRegion('PaintData.ClipRegion: ', Widget.PaintData.ClipRegion);
98      DC.setClipRegion(Widget.PaintData.ClipRegion);
99      DC.setClipping(True);
100    end;
101    if Widget.PaintData.ClipRect <> nil then
102    begin
103      New(DC.vClipRect);
104      DC.vClipRect^ := Widget.PaintData.ClipRect^;
105    end;
106  end;
107
108  Result := PS.hdc;
109
110  {$ifdef VerboseQtWinAPI}
111    WriteLn('Trace:< [WinAPI BeginPaint] Result=', dbghex(Result));
112  {$endif}
113end;
114
115function TQtWidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
116begin
117  {$ifdef VerboseQtWinAPI}
118    WriteLn('Trace:> [TQtWidgetSet.BitBlt]');
119  {$endif}
120
121  Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width,
122                       Height, ROP);
123
124  {$ifdef VerboseQtWinAPI}
125    WriteLn('Trace:< [TQtWidgetSet.BitBlt]');
126  {$endif}
127end;
128
129function TQtWidgetSet.CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer;
130begin
131  {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
132  	WriteLn('***** [WinAPI TQtWidgetSet.CallNextHookEx] missing implementation ');
133  {$endif}
134  Result := 0;
135end;
136
137function TQtWidgetSet.CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer;
138begin
139  {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
140  	WriteLn('***** [WinAPI TQtWidgetSet.CallWindowProc] missing implementation ');
141  {$endif}
142  Result := -1;
143end;
144
145{------------------------------------------------------------------------------
146  Method:  ClientToScreen
147  Params:  Handle    -
148  Returns:
149 ------------------------------------------------------------------------------}
150function TQtWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint) : Boolean;
151begin
152  Result := IsValidHandle(Handle);
153  if Result then
154    P := TQtWidget(Handle).MapToGlobal(P, True);
155end;
156
157
158function TQtWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
159begin
160  Result := Clipboard.FormatToMimeType(FormatID);
161end;
162
163function TQtWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
164  FormatID: TClipboardFormat; Stream: TStream): boolean;
165begin
166  Result := Clipboard.Getdata(ClipboardType, FormatID, Stream);
167end;
168
169function TQtWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
170  var Count: integer; var List: PClipboardFormat): boolean;
171begin
172  Result := Clipboard.GetFormats(ClipboardType, Count, List);
173end;
174
175function TQtWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
176  OnRequestProc: TClipboardRequestEvent;  FormatCount: integer;
177  Formats: PClipboardFormat): boolean;
178begin
179  Result := Clipboard.GetOwnerShip(ClipboardType, OnRequestProc, FormatCount, Formats);
180end;
181
182function TQtWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
183begin
184  Result := Clipboard.RegisterFormat(AMimeType);
185end;
186
187
188{------------------------------------------------------------------------------
189  Function: CombineRgn
190  Params:  Dest, Src1, Src2, fnCombineMode
191  Returns: longint
192
193  Combine the 2 Source Regions into the Destination Region using the specified
194  Combine Mode. The Destination must already be initialized. The Return value
195  is the Destination's Region type, or ERROR.
196
197  The Combine Mode can be one of the following:
198      RGN_AND  : Gets a region of all points which are in both source regions
199
200      RGN_COPY : Gets an exact copy of the first source region
201
202      RGN_DIFF : Gets a region of all points which are in the first source
203                 region but not in the second.(Source1 - Source2)
204
205      RGN_OR   : Gets a region of all points which are in either the first
206                 source region or in the second.(Source1 + Source2)
207
208      RGN_XOR  : Gets all points which are in either the first Source Region
209                 or in the second, but not in both.
210
211  The result can be one of the following constants
212      Error
213      NullRegion
214      SimpleRegion
215      ComplexRegion
216
217 ------------------------------------------------------------------------------}
218function TQtWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint;
219var
220  RDest,RSrc1,RSrc2: QRegionH;
221begin
222  result:=ERROR;
223
224  if not IsValidGDIObject(Dest) or not IsValidGDIObject(Src1) then
225    exit
226  else
227  begin
228    RDest := TQtRegion(Dest).FHandle;
229    RSrc1 := TQtRegion(Src1).FHandle;
230  end;
231
232  if (fnCombineMode<>RGN_COPY) and not IsValidGDIObject(Src2) then
233    exit
234  else
235    RSrc2 := TQtRegion(Src2).FHandle;
236
237  case fnCombineMode of
238    RGN_AND:
239      QRegion_intersected(RSrc1, RDest, RSrc2);
240    RGN_COPY:
241      begin
242        // union of Src1 with a null region
243        RSrc2 := QRegion_create;
244        QRegion_united(RSrc1, RDest, RSrc2);
245        QRegion_destroy(RSrc2);
246      end;
247    RGN_DIFF:
248      QRegion_subtracted(RSrc1, RDest, RSrc2);
249    RGN_OR:
250      QRegion_united(RSrc1, RDest, RSrc2);
251    RGN_XOR:
252      QRegion_xored(RSrc1, RDest, RSrc2);
253  end;
254
255  if QRegion_isEmpty(RDest) then
256    Result := NULLREGION
257  else
258  begin
259    if TQtRegion(Dest).IsPolyRegion or (TQtRegion(Dest).numRects > 0) then
260      Result := COMPLEXREGION
261    else
262      Result := SIMPLEREGION;
263  end;
264end;
265
266{------------------------------------------------------------------------------
267  Method:  TQtWidgetSet.CreateCompatibleBitmap
268  Params: HDC, Width & Height
269  Returns: HBITMAP
270
271 ------------------------------------------------------------------------------}
272function TQtWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
273var
274  QtDC: TQtDeviceContext;
275  Format: QImageFormat = QImageFormat_ARGB32;
276  ADevice: QPaintDeviceH = nil;
277  ADesktop: QDesktopWidgetH = nil;
278begin
279  {$ifdef VerboseQtWinAPI}
280    WriteLn('Trace:> [WinAPI CreateCompatibleBitmap]',
281     ' DC:', dbghex(DC),
282     ' Width:', dbgs(Width),
283     ' Height:', dbgs(Height));
284  {$endif}
285  Result := 0;
286  if IsValidDC(DC) then
287  begin
288    QtDC := TQtDeviceContext(DC);
289    case QtDC.getDepth of
290      1: Format := QImageFormat_Mono;
291      15, 16: Format := QImageFormat_RGB16;
292      24: Format := QImageFormat_RGB32;
293      32: Format := QImageFormat_ARGB32;
294    end;
295  end else
296  begin
297    ADesktop := QApplication_desktop();
298    if ADesktop <> nil then
299      ADevice := QWidget_to_QPaintDevice(ADesktop);
300    if ADevice <> nil then
301    begin
302      case QPaintDevice_depth(ADevice) of
303        1: Format := QImageFormat_Mono;
304        15, 16: Format := QImageFormat_RGB16;
305        24: Format := QImageFormat_RGB32;
306        32: Format := QImageFormat_ARGB32;
307      end;
308    end;
309  end;
310  Result := HBitmap(TQtImage.Create(nil, Width, Height, Format));
311  {$ifdef VerboseQtWinAPI}
312    WriteLn('Trace:< [WinAPI CreateCompatibleBitmap] Bitmap:', dbghex(Result));
313  {$endif}
314end;
315
316{------------------------------------------------------------------------------
317  Method:  TQtWidgetSet.CreateBitmap
318  Params:
319  Returns:
320
321  This functions is for TBitmap support.
322  Specifically it´s utilized on when a handle for a bitmap is needed
323 ------------------------------------------------------------------------------}
324function TQtWidgetSet.CreateBitmap(Width, Height: Integer;
325  Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
326var
327  Format: QImageFormat;
328  NewBits: PByte;
329  NewBitsSize: PtrUInt;
330  ARowStride, RSS: Integer;
331begin
332  {$ifdef VerboseQtWinAPI}
333    WriteLn('Trace:> [WinAPI CreateBitmap]',
334     ' Width:', dbgs(Width),
335     ' Height:', dbgs(Height),
336     ' Planes:', dbgs(Planes),
337     ' BitCount:', dbgs(BitCount),
338     ' BitmapBits: ', dbgs(BitmapBits));
339  {$endif}
340
341  // for win32 data is aligned to WORD
342  // for qt we must realign data to DWORD
343
344  case BitCount of
345    1: Format := QImageFormat_Mono;
346    15, 16: Format := QImageFormat_RGB16;
347    24: Format := QImageFormat_RGB32;
348    32: Format := QImageFormat_ARGB32;
349  else
350    Format := QImageFormat_ARGB32;
351  end;
352
353  RSS := GetBytesPerLine(Width, BitCount, rileWordBoundary);
354  if BitmapBits <> nil then
355  begin
356    ARowStride := GetBytesPerLine(Width, BitCount, rileDWordBoundary);
357    if not CopyImageData(Width, Height, RSS, BitCount, BitmapBits, Rect(0, 0, Width, Height),
358      riloBottomToTop, riloBottomToTop, rileDWordBoundary, NewBits, NewBitsSize) then
359    begin
360      // this was never tested
361      ARowStride := RSS;
362      NewBits := AllocMem(RSS * Height);
363      Move(BitmapBits^, NewBits^, RSS * Height);
364    end;
365    Result := HBitmap(TQtImage.Create(NewBits, Width, Height, ARowStride, Format, True));
366  end
367  else
368    Result := HBitmap(TQtImage.Create(nil, Width, Height, Format));
369
370  {$ifdef VerboseQtWinAPI}
371    WriteLn('Trace:< [WinAPI CreateBitmap] Bitmap:', dbghex(Result));
372  {$endif}
373end;
374
375
376{------------------------------------------------------------------------------
377  Function:  CreateBrushIndirect
378  Params:  none
379  Returns: Nothing
380 ------------------------------------------------------------------------------}
381function TQtWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
382var
383  QtBrush: TQtBrush;
384  Color: TQColor;
385begin
386  {$ifdef VerboseQtWinAPI}
387    WriteLn(Format('Trace:> [WinAPI CreateBrushIndirect]  Style: %d, Color: %8x (%s)',
388      [LogBrush.lbStyle, LogBrush.lbColor, ColorToString(LogBrush.lbColor)]));
389  {$endif}
390
391  Result := 0;
392
393  QtBrush := TQtBrush.Create(True);
394
395  try
396    case LogBrush.lbStyle of
397      BS_NULL: QtBrush.Style := QtNoBrush; // Same as BS_HOLLOW.
398      BS_SOLID: QtBrush.Style := QtSolidPattern;
399
400      BS_HATCHED: // Hatched brushes.
401      begin
402        case LogBrush.lbHatch of
403          HS_BDIAGONAL: QtBrush.Style := QtBDiagPattern;
404          HS_CROSS: QtBrush.Style := QtCrossPattern;
405          HS_DIAGCROSS: QtBrush.Style := QtDiagCrossPattern;
406          HS_FDIAGONAL: QtBrush.Style := QtFDiagPattern;
407          HS_HORIZONTAL: QtBrush.Style := QtHorPattern;
408          HS_VERTICAL: QtBrush.Style := QtVerPattern;
409        else
410          QtBrush.Style := QtSolidPattern;
411        end;
412      end;
413
414      BS_DIBPATTERN,     // A pattern brush defined by a device-independent
415             // bitmap (DIB) specification. If lbStyle is BS_DIBPATTERN, the
416             // lbHatch member contains a handle to a packed DIB.Windows 95:
417             // Creating brushes from bitmaps or DIBs larger than 8x8 pixels
418             // is not supported. If a larger bitmap is given, only a portion
419             // of the bitmap is used.
420      BS_DIBPATTERN8X8,  // Same as BS_DIBPATTERN.
421      BS_DIBPATTERNPT,   // A pattern brush defined by a device-independent
422             // bitmap (DIB) specification. If lbStyle is BS_DIBPATTERNPT, the
423             // lbHatch member contains a pointer to a packed DIB.
424      BS_PATTERN,        // Pattern brush defined by a memory bitmap.
425      BS_PATTERN8X8:     // Same as BS_PATTERN.
426      begin
427        QtBrush.setTextureImage(TQtImage(LogBrush.lbHatch).Handle);
428        QtBrush.Style := QtTexturePattern;
429      end;
430    else
431      DebugLn(Format('Unsupported Style %d',[LogBrush.lbStyle]));
432    end;
433
434    {
435      Other non-utilized Qt brushes:
436        QtDense1Pattern,
437        QtDense2Pattern,
438        QtDense3Pattern,
439        QtDense4Pattern,
440        QtDense5Pattern,
441        QtDense6Pattern,
442        QtDense7Pattern,
443        QtLinearGradientPattern,
444        QtRadialGradientPattern,
445        QtConicalGradientPattern
446    }
447
448    // set brush color
449    Color := QBrush_Color(QtBrush.FHandle)^;
450    ColorRefToTQColor(ColorToRGB(TColor(logBrush.lbColor)), Color);
451    QtBrush.setColor(@Color);
452    Result := HBRUSH(QtBrush);
453  except
454    Result := 0;
455    DebugLn('TQtWidgetSet.CreateBrushIndirect: Failed');
456  end;
457
458  {$ifdef VerboseQtWinAPI}
459    WriteLn('Trace:< [WinAPI CreateBrushIndirect] Result: ', dbghex(Result));
460  {$endif}
461end;
462
463{------------------------------------------------------------------------------
464  Function:  CreateBrushWithRadialGradient
465  Params:  none
466  Returns: Nothing
467 ------------------------------------------------------------------------------}
468function TQtWidgetSet.CreateBrushWithRadialGradient(const LogBrush: TLogRadialGradient): HBRUSH;
469var
470  QtBrush: TQtBrush;
471begin
472  Result := 0;
473
474  QtBrush := TQtBrush.CreateWithRadialGradient(LogBrush);
475  Result := HBRUSH(QtBrush);
476  if Result = 0 then
477    DebugLn('TQtWidgetSet.CreateBrushWithRadialGradient: Failed');
478end;
479
480function TQtWidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; Width, Height: Integer): Boolean;
481begin
482  Result := (Handle <> 0) and
483    QtCaret.CreateCaret(TQtWidget(Handle), Bitmap, Width, Height);
484end;
485
486{------------------------------------------------------------------------------
487  Function: CreateCompatibleDC
488  Params:  DC - handle to memory device context
489  Returns: handle to a memory device context
490
491  Creates a memory device context (DC) compatible with the specified device.
492 ------------------------------------------------------------------------------}
493function TQtWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
494begin
495  {$ifdef VerboseQtWinAPI}
496    WriteLn('[WinAPI CreateCompatibleDC] DC: ', dbghex(DC));
497  {$endif}
498  Result := HDC(TQtDeviceContext.Create(nil, True));
499end;
500
501{------------------------------------------------------------------------------
502  Function: CreateEllipticRgn
503  Params:  p1 - X position of the top-left corner
504           p2 - Y position of the top-left corner
505           p3 - X position of the bottom-right corner
506           p4 - Y position of the bottom-right corner
507  Returns: HRGN
508 ------------------------------------------------------------------------------}
509function TQtWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
510var
511  QtRegion: TQtRegion;
512begin
513  {$ifdef VerboseQtWinAPI}
514    WriteLn('[WinAPI CreateEllipticRgn] ');
515  {$endif}
516  QtRegion := TQtRegion.Create(True, p1, p2, p3, p4, QRegionEllipse);
517  Result := HRGN(QtRegion);
518end;
519
520{------------------------------------------------------------------------------
521  Function: CreateFontIndirect
522  Params:  const LogFont: TLogFont
523  Returns: HFONT
524
525  Creates a font GDIObject.
526 ------------------------------------------------------------------------------}
527function TQtWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
528begin
529  Result := CreateFontIndirectEx(LogFont, '');
530end;
531
532{------------------------------------------------------------------------------
533  Function: CreateFontIndirectEx
534  Params:  const LogFont: TLogFont
535  Returns: HFONT
536
537  Creates a font GDIObject.
538 ------------------------------------------------------------------------------}
539function TQtWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT;
540var
541  QtFont: TQtFont;
542  FamilyName: string;
543const
544  QStyleStategy: array [DEFAULT_QUALITY..CLEARTYPE_NATURAL_QUALITY] of QFontStyleStrategy = (
545 { DEFAULT_QUALITY           } QFontPreferDefault,
546 { DRAFT_QUALITY             } QFontPreferMatch,
547 { PROOF_QUALITY             } QFontPreferQuality,
548 { NONANTIALIASED_QUALITY    } QFontNoAntialias,
549 { ANTIALIASED_QUALITY       } QFontPreferAntialias,
550 { CLEARTYPE_QUALITY         } QFontPreferAntialias,
551 { CLEARTYPE_NATURAL_QUALITY } QFontPreferAntialias
552  );
553begin
554  {$ifdef VerboseQtWinAPI}
555    WriteLn('[WinAPI CreateFontIndirectEx] FontName: ' + LongFontName);
556  {$endif}
557
558  Result := 0;
559
560  QtFont := TQtFont.Create(True);
561  try
562    // -1 has different meaning - it means that font height was set using setPointSize
563    if LogFont.lfHeight <> -1 then
564      QtFont.setPixelSize(Abs(LogFont.lfHeight));
565
566    // Some values at available on Qt documentation at a table
567    // Others are guesses. The best would be to test different values for those
568    // See: http://doc.trolltech.com/4.1/qfont.html#Weight-enum
569    case LogFont.lfWeight of
570      FW_THIN       : QtFont.setWeight(10);
571      FW_EXTRALIGHT : QtFont.setWeight(15);
572      FW_LIGHT      : QtFont.setWeight(25);
573      FW_NORMAL     : QtFont.setWeight(50);
574      FW_MEDIUM     : QtFont.setWeight(55);
575      FW_SEMIBOLD   : QtFont.setWeight(63);
576      FW_BOLD       : QtFont.setWeight(75);
577      FW_EXTRABOLD  : QtFont.setWeight(80);
578      FW_HEAVY      : QtFont.setWeight(87);
579    end;
580
581    QtFont.Angle := LogFont.lfEscapement;
582
583    //LogFont.lfOrientation;
584
585    QtFont.setItalic(LogFont.lfItalic = High(Byte));
586    QtFont.setUnderline(LogFont.lfUnderline = High(Byte));
587    QtFont.setStrikeOut(LogFont.lfStrikeOut = High(Byte));
588
589    FamilyName := StrPas(LogFont.lfFaceName);
590
591    if not IsFontNameDefault(FamilyName) then
592      QtFont.setFamily(FamilyName)
593    else
594      QtFont.setFamily(GetDefaultAppFontName{%H-});
595
596    if LogFont.lfQuality <= High(QStyleStategy) then
597      QtFont.setStyleStrategy(QStyleStategy[LogFont.lfQuality]);
598    Result := HFONT(QtFont);
599  except
600    Result := 0;
601    DebugLn('TQtWidgetSet.CreateFontIndirectEx: Failed');
602  end;
603end;
604
605function TQtWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
606var
607  AIcon: TQtIcon;
608  APixmap, ATemp: QPixmapH;
609  AMask: QBitmapH;
610  {$IFDEF DARWIN}
611  AImgFmt: QImageFormat;
612  {$ENDIF}
613begin
614  Result := 0;
615  if IsValidGDIObject(IconInfo^.hbmColor) then
616  begin
617    APixmap := QPixmap_create();
618    QPixmap_fromImage(APixmap, TQtImage(IconInfo^.hbmColor).Handle);
619    {$IFDEF DARWIN}
620    AImgFmt := TQtImage(IconInfo^.hbmColor).getFormat;
621    if (AImgFmt in [QImageFormat_Mono, QImageFormat_MonoLSB,
622      QImageFormat_Indexed8, QImageFormat_RGB32]) then
623    {$ENDIF}
624    if IconInfo^.hbmMask <> 0 then
625    begin
626      ATemp := QPixmap_create();
627      QPixmap_fromImage(ATemp, TQtImage(IconInfo^.hbmMask).Handle);
628      AMask := QBitmap_create(ATemp);
629      QPixmap_setMask(APixmap, AMask);
630      QPixmap_destroy(ATemp);
631      QBitmap_destroy(AMask);
632    end;
633    if IconInfo^.fIcon then
634    begin
635      AIcon := TQtIcon.Create;
636      AIcon.addPixmap(APixmap);
637      Result := HICON(AIcon);
638    end else
639      Result := HCURSOR(TQtCursor.Create(APixmap, IconInfo^.xHotspot, IconInfo^.yHotspot));
640    QPixmap_destroy(APixmap);
641  end;
642end;
643
644{------------------------------------------------------------------------------
645  Function:  CreatePatternBrush
646  Params:  HBITMAP
647  Returns: HBRUSH
648 ------------------------------------------------------------------------------}
649
650function TQtWidgetSet.CreatePatternBrush(ABitmap: HBITMAP): HBRUSH;
651var
652  Image: QImageH;
653  QtBrush: TQtBrush;
654begin
655  {$ifdef VerboseQtWinAPI}
656    WriteLn('[WinAPI CreatePatternBrush]',' Bitmap=', dbghex(ABitmap));
657  {$endif}
658  Result := 0;
659  if ABitmap = 0 then
660    exit;
661  QtBrush := TQtBrush.Create(True);
662  Image := QImage_create(TQtImage(ABitmap).Handle);
663  try
664    QtBrush.setTextureImage(Image);
665  finally
666    QImage_destroy(Image);
667  end;
668
669  Result := HBRUSH(QtBrush);
670end;
671
672{------------------------------------------------------------------------------
673  Function:  CreatePenIndirect
674  Params:  none
675  Returns: HPEN
676 ------------------------------------------------------------------------------}
677
678function TQtWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
679var
680  QtPen: TQtPen;
681  color: TQColor;
682begin
683  Result := 0;
684  QtPen := TQtPen.Create(True);
685  with LogPen do
686  begin
687    case lopnStyle and PS_STYLE_MASK of
688      PS_SOLID: QtPen.setStyle(QtSolidLine);
689      PS_DASH: QtPen.setStyle(QtDashLine);
690      PS_DOT: QtPen.setStyle(QtDotLine);
691      PS_DASHDOT: QtPen.setStyle(QtDashDotLine);
692      PS_DASHDOTDOT: QtPen.setStyle(QtDashDotDotLine);
693      PS_NULL: QtPen.setStyle(QtNoPen);
694    else
695      QtPen.setStyle(QtSolidLine);
696    end;
697
698    if lopnWidth.X <= 0 then
699      QtPen.setCosmetic(True)
700    else
701    begin
702      QtPen.setCosmetic(False);
703      QtPen.setWidth(lopnWidth.X);
704    end;
705
706    QPen_Color(QtPen.FHandle, @Color);
707    ColorRefToTQColor(ColorToRGB(TColor(lopnColor)), Color);
708    QPen_setColor(QtPen.FHandle, @Color);
709  end;
710
711  Result := HPEN(QtPen);
712end;
713
714{------------------------------------------------------------------------------
715  Function: CreatePolygonRgn
716  Params:  none
717  Returns: HRGN
718
719 ------------------------------------------------------------------------------}
720function TQtWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN;
721var
722  QtRegion: TQtRegion;
723  QtPoints: PQtPoint;
724  i: Integer;
725  Poly: QPolygonH;
726begin
727  {$ifdef VerboseQtWinAPI}
728    WriteLn('Trace: [WinAPI CreatePolygonRgn] ');
729  {$endif}
730  GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
731  for i := 0 to NumPts - 1 do
732    QtPoints[i] := QtPoint(Points[i].x, Points[i].y);
733  Poly := QPolygon_create(NumPts, PInteger(QtPoints));
734  FreeMem(QtPoints);
735  try
736    {fillmode can be ALTERNATE or WINDING as msdn says}
737    if FillMode = ALTERNATE then
738      QtRegion := TQtRegion.Create(True, Poly, QtOddEvenFill)
739    else
740      QtRegion := TQtRegion.Create(True, Poly, QtWindingFill);
741    Result := HRGN(QtRegion);
742  finally
743    QPolygon_destroy(Poly);
744  end;
745end;
746
747{------------------------------------------------------------------------------
748  Function: CreateRectRgn
749  Params:  none
750  Returns: HRGN
751
752
753 ------------------------------------------------------------------------------}
754function TQtWidgetSet.CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN;
755var
756  QtRegion: TQtRegion;
757begin
758  QtRegion := TQtRegion.Create(True, X1, Y1, X2, Y2);
759  Result := HRGN(QtRegion);
760  {$ifdef VerboseQtWinAPI}
761    WriteLn('Trace: [WinAPI CreateRectRgn] Result: ', dbghex(Result),
762     ' QRegionH: ', dbghex(PtrInt(QtRegion.Widget)));
763  {$endif}
764end;
765
766{------------------------------------------------------------------------------
767  Procedure: DeleteCriticalSection
768  Params:  var CritSection: TCriticalSection
769  Returns: Nothing
770 ------------------------------------------------------------------------------}
771procedure TQtWidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection);
772var
773  ACritSec: System.PRTLCriticalSection;
774begin
775  ACritSec:=System.PRTLCriticalSection(CritSection);
776  System.DoneCriticalsection(ACritSec^);
777  Dispose(ACritSec);
778  CritSection:=0;
779end;
780
781{------------------------------------------------------------------------------
782  Function: DeleteDC
783  Params:  none
784  Returns: Nothing
785
786 ------------------------------------------------------------------------------}
787function TQtWidgetSet.DeleteDC(hDC: HDC): Boolean;
788begin
789  {$ifdef VerboseQtWinAPI}
790    WriteLn('[WinAPI DeleteDC] Handle: ', dbghex(hDC));
791  {$endif}
792
793  Result := False;
794  if not IsValidDC(hDC) then exit;
795
796  TQtDeviceContext(hDC).Free;
797end;
798
799{------------------------------------------------------------------------------
800  Function: DeleteObject
801  Params:  none
802  Returns: Nothing
803
804 ------------------------------------------------------------------------------}
805function TQtWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
806var
807  aObject: TObject;
808  APaintEngine: QPaintEngineH;
809  APainter: QPainterH;
810  {$ifdef VerboseQtWinAPI}
811    ObjType: string;
812  {$endif}
813begin
814  {$ifdef VerboseQtWinAPI}
815    WriteLn('Trace:> [WinAPI DeleteObject] GDIObject: ', dbghex(GDIObject));
816    ObjType := 'Unidentifyed';
817  {$endif}
818
819  Result := False;
820
821  if GDIObject = 0 then
822    Exit(True);
823
824  if not IsValidGDIObject(GDIObject) then
825    Exit;
826
827  aObject := TObject(GDIObject);
828
829  if (aObject is TQtResource) and TQtResource(aObject).FShared then
830    Exit(True);
831
832  {------------------------------------------------------------------------------
833    Font
834   ------------------------------------------------------------------------------}
835  if aObject is TQtFont then
836  begin
837    {$ifdef VerboseQtWinAPI}
838      ObjType := 'Font';
839    {$endif}
840  end
841  {------------------------------------------------------------------------------
842    Brush
843   ------------------------------------------------------------------------------}
844  else if aObject is TQtBrush then
845  begin
846    {$ifdef VerboseQtWinAPI}
847      ObjType := 'Brush';
848    {$endif}
849  end
850  {------------------------------------------------------------------------------
851    Image
852   ------------------------------------------------------------------------------}
853  else if aObject is TQtImage then
854  begin
855    {$ifdef VerboseQtWinAPI}
856      ObjType := 'Image';
857    {$endif}
858
859    // we must stop paintdevice before destroying
860
861    APaintEngine := QImage_paintEngine(TQtImage(AObject).Handle);
862
863    if (APaintEngine <> nil) and QPaintEngine_isActive(APaintEngine) then
864    begin
865      APainter := QPaintEngine_painter(APaintEngine);
866      if APainter <> nil then
867        QPainter_end(APainter);
868    end;
869  end
870  {------------------------------------------------------------------------------
871    Region
872   ------------------------------------------------------------------------------}
873  else if aObject is TQtRegion then
874  begin
875    {$ifdef VerboseQtWinAPI}
876      ObjType := 'Region';
877    {$endif}
878  end
879
880  {------------------------------------------------------------------------------
881    Pen
882   ------------------------------------------------------------------------------}
883  else if aObject is TQtPen then
884  begin
885    {$ifdef VerboseQtWinAPI}
886      ObjType := 'Pen';
887    {$endif}
888  end;
889
890  if AObject is TQtResource then
891    if TQtResource(AObject).Owner <> nil then
892    begin
893      // this is an owned (default) resource, let owner free it
894      DebugLn('WARNING: TQtWidgetSet.DeleteObject() trying to free a default resource ',dbgsName(AObject),' owner=',dbgsName(TQtResource(AObject).Owner));
895      AObject := nil;
896    end;
897
898  if AObject <> nil then
899  begin
900    //WriteLn('Delete object: ', PtrUInt(AObject));
901    FreeThenNil(AObject);
902  end;
903
904  Result := True;
905
906  {$ifdef VerboseQtWinAPI}
907    WriteLn('Trace:< [WinAPI DeleteObject] Result=', dbgs(Result), ' ObjectType=', ObjType);
908  {$endif}
909end;
910
911function TQtWidgetSet.DestroyCaret(Handle: HWND): Boolean;
912begin
913  Result := (Handle <> 0) and QtCaret.DestroyCaret;
914end;
915
916{------------------------------------------------------------------------------
917  Method:  DestroyIcon
918  Params:  Handle
919  Returns: Result of destroying
920 ------------------------------------------------------------------------------}
921
922function TQtWidgetSet.DestroyIcon(Handle: HICON): Boolean;
923begin
924  Result := (Handle <> 0) and
925            (
926              (TObject(Handle) is TQtIcon) or
927              (TObject(Handle) is TQtCursor)
928            );
929  if Result then
930    TObject(Handle).Free;
931end;
932
933{------------------------------------------------------------------------------
934  Method:  DPtoLP
935  Params:  DC: HDC; var Points; Count: Integer
936  Returns: Boolean
937 ------------------------------------------------------------------------------}
938function TQtWidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL;
939var
940  P: PPoint;
941  QtPoint: TQtPoint;
942  Matrix: QTransformH;
943  MatrixInv: QTransformH;
944  QtDC: TQtDeviceContext;
945  Inverted: Boolean;
946begin
947  {$ifdef VerboseQtWinAPI}
948    WriteLn('[WinAPI DPtoLP] ');
949  {$endif}
950
951  Result := False;
952
953  if not IsValidDC(DC) then
954    Exit;
955
956  QtDC := TQtDeviceContext(DC);
957
958  Matrix := QTransform_create;
959  MatrixInv := QTransform_create;
960  QPainter_combinedTransform(QtDC.Widget, Matrix);
961  P := @Points;
962  try
963    while Count > 0 do
964    begin
965      Dec(Count);
966      Inverted := QTransform_isInvertible(Matrix);
967      QTransform_inverted(Matrix, MatrixInv, @Inverted);
968      QtPoint.X := P^.X;
969      QtPoint.Y := P^.Y;
970      QTransform_map(MatrixInv, PQtPoint(@QtPoint), PQtPoint(@QtPoint));
971      P^.X := QtPoint.X;
972      P^.Y := QtPoint.Y;
973      Inc(P);
974    end;
975
976    Result := True;
977  finally
978    QTransform_destroy(MatrixInv);
979    QTransform_destroy(Matrix);
980  end;
981end;
982
983{------------------------------------------------------------------------------
984  Method:  DrawEdge
985  Params: DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal
986  Returns: Boolean
987 ------------------------------------------------------------------------------}
988function TQtWidgetSet.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean;
989var
990  Brush: HBRUSH;
991  ColorDark, ColorLight: TColorRef;
992  ClientRect: TRect;
993  QtDC: TQtDeviceContext;
994
995  procedure InternalDrawEdge(Outer: Boolean; const R: TRect);
996  var
997    X1, Y1, X2, Y2: Integer;
998    ColorLeftTop, ColorRightBottom: TColor;
999    EdgeQtColor: TQColor;
1000    APen, OldPen: TQtPen;
1001  begin
1002    X1 := R.Left;
1003    Y1 := R.Top;
1004    X2 := R.Right;
1005    Y2 := R.Bottom;
1006
1007    ColorLeftTop := clNone;
1008    ColorRightBottom := clNone;
1009
1010    if Outer then
1011    begin
1012      if Edge and BDR_RAISEDOUTER <> 0 then
1013      begin
1014        ColorLeftTop := ColorLight;
1015        ColorRightBottom := ColorDark;
1016      end
1017      else if Edge and BDR_SUNKENOUTER <> 0 then
1018      begin
1019        ColorLeftTop := ColorDark;
1020        ColorRightBottom := ColorLight;
1021      end;
1022    end
1023    else
1024    begin
1025      if Edge and BDR_RAISEDINNER <> 0 then
1026      begin
1027        ColorLeftTop := ColorLight;
1028        ColorRightBottom := ColorDark;
1029      end
1030      else if Edge and BDR_SUNKENINNER <> 0 then
1031      begin
1032        ColorLeftTop := ColorDark;
1033        ColorRightBottom := ColorLight;
1034      end;
1035    end;
1036
1037    if grfFlags and BF_DIAGONAL = 0 then
1038    begin
1039
1040      APen := TQtPen.Create(True);
1041      ColorRefToTQColor(TColorRef(ColorLeftTop), EdgeQtColor{%H-});
1042      APen.setColor(EdgeQtColor);
1043      OldPen := QtDC.setPen(APen);
1044
1045      if grfFlags and BF_LEFT <> 0 then
1046        QtDC.DrawLine(X1, Y1, X1, Y2);
1047      if grfFlags and BF_TOP <> 0 then
1048        QtDC.DrawLine(X1, Y1, X2, Y1);
1049
1050      QtDC.setPen(OldPen);
1051      APen.Free;
1052      APen := TQtPen.Create(True);
1053
1054      ColorRefToTQColor(TColorRef(ColorRightBottom), EdgeQtColor);
1055      APen.setColor(EdgeQtColor);
1056      OldPen := QtDC.SetPen(APen);
1057
1058      if grfFlags and BF_RIGHT <> 0 then
1059        QtDC.DrawLine(X2, Y1, X2, Y2);
1060      if grfFlags and BF_BOTTOM <> 0 then
1061        QtDC.DrawLine(X1, Y2, X2, Y2);
1062      QtDC.SetPen(OldPen);
1063      APen.Free;
1064    end
1065    else
1066    begin
1067
1068      APen := TQtPen.Create(True);
1069      ColorRefToTQColor(TColorRef(ColorLeftTop), EdgeQtColor);
1070      APen.setColor(EdgeQtColor);
1071      OldPen := QtDC.setPen(APen);
1072
1073      if (grfFlags and BF_DIAGONAL_ENDTOPLEFT = BF_DIAGONAL_ENDTOPLEFT) or
1074         (grfFlags and BF_DIAGONAL_ENDBOTTOMRIGHT = BF_DIAGONAL_ENDBOTTOMRIGHT) then
1075        QtDC.DrawLine(X1, Y1, X2, Y2)
1076      else
1077        QtDC.DrawLine(X1, Y2, X2, Y1);
1078      QtDC.setPen(OldPen);
1079      APen.Free;
1080    end;
1081  end;
1082
1083begin
1084  {$ifdef VerboseQtWinAPI}
1085    WriteLn('[WinAPI DrawEdge] ');
1086  {$endif}
1087
1088  Result := False;
1089  if not IsValidDC(DC) or IsRectEmpty(Rect) then exit;
1090
1091  QtDC := TQtDeviceContext(DC);
1092
1093  ClientRect := Rect;
1094  Dec(ClientRect.Right, 1);
1095  Dec(ClientRect.Bottom, 1);
1096  QtDC.save;
1097  try
1098    ColorDark := ColorToRGB(clBtnShadow);
1099    ColorLight := ColorToRGB(clBtnHighlight);
1100    if grfFlags and BF_FLAT <> 0 then
1101      ColorLight := clSilver;
1102    if grfFlags and BF_MONO <> 0 then
1103    begin
1104      ColorDark := TColorRef(clBlack);
1105      ColorLight := TColorRef(clWhite);
1106    end;
1107    try
1108      if Edge and (BDR_SUNKENOUTER or BDR_RAISEDOUTER) <> 0 then
1109        InternalDrawEdge(True, ClientRect);
1110      InflateRect(ClientRect, -1, -1);
1111      if grfFlags and BF_MONO = 0 then
1112      begin
1113        ColorLight := ColorToRGB(clBtnHighlight);
1114        ColorDark := ColorToRGB(clBtnShadow);
1115      end;
1116      if Edge and (BDR_SUNKENINNER or BDR_RAISEDINNER) <> 0 then
1117      begin
1118        InternalDrawEdge(False, ClientRect);
1119        InflateRect(ClientRect, -1, -1);
1120      end;
1121    finally
1122    end;
1123
1124    inc(ClientRect.Right);
1125    inc(ClientRect.Bottom);
1126
1127    if grfFlags and BF_MIDDLE <> 0 then
1128    begin
1129      Brush := CreateSolidBrush(TColorRef(clBtnFace));
1130      try
1131        FillRect(DC, ClientRect, Brush);
1132      finally
1133        DeleteObject(Brush);
1134      end;
1135    end;
1136
1137    if grfFlags and BF_ADJUST <> 0 then
1138      Rect := ClientRect;
1139
1140    Result := True;
1141  finally
1142    QtDC.Restore;
1143  end;
1144
1145end;
1146
1147{------------------------------------------------------------------------------
1148  Method: DrawFocusRect
1149  Params: DC: HDC; const Rect: TRect
1150  Returns: Boolean
1151 ------------------------------------------------------------------------------}
1152function TQtWidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean;
1153var
1154  StyleOption: QStyleOptionFocusRectH;
1155  QtDC: TQtDeviceContext;
1156begin
1157  {$ifdef VerboseQtWinAPI}
1158    WriteLn('[TQtWidgetSet.DrawFocusRect] Handle: ', dbghex(DC));
1159  {$endif}
1160  Result := False;
1161
1162  if not IsValidDC(DC) then exit;
1163
1164  QtDC := TQtDeviceContext(DC);
1165  StyleOption := QStyleOptionFocusRect_create;
1166  QtDC.save;
1167  try
1168    QStyleOption_setRect(StyleOption, @Rect);
1169    if not QtDC.getClipping then
1170      QtDC.setClipRect(Rect);
1171    QStyle_drawPrimitive(QApplication_style, QStylePE_FrameFocusRect, StyleOption, QtDC.Widget, QtDC.Parent);
1172    Result := True;
1173  finally
1174    QStyleOptionFocusRect_destroy(StyleOption);
1175    QtDC.restore;
1176  end;
1177end;
1178
1179function TQtWidgetSet.DrawFrameControl(DC: HDC; const Rect: TRect; uType,
1180  uState: Cardinal): Boolean;
1181var
1182  QtDC: TQtDeviceContext;
1183  Painter: QPainterH;
1184  Widget: QWidgetH;
1185
1186  function uStatetoQStyleState: QStyleState;
1187  begin
1188    Result := QStyleState_None;
1189    if (uState and DFCS_INACTIVE = 0) then
1190      Result := Result or QStyleState_Enabled;
1191
1192    if (uState and DFCS_PUSHED <> 0) then
1193      Result := Result or QStyleState_MouseOver or QStyleState_Sunken
1194    else
1195      Result := Result or QStyleState_Raised;
1196
1197    if (uState and DFCS_CHECKED <> 0) then
1198      Result := Result or QStyleState_On
1199    else
1200      Result := Result or QStyleState_Off;
1201
1202    if ((uState and DFCS_HOT <> 0) or (uState and DFCS_PUSHED <> 0)) then
1203      Result := Result or QStyleState_MouseOver or QStyleState_Active;
1204
1205    if (uType <> DFC_BUTTON) and
1206      ((uState and DFCS_FLAT <> 0) and not (uState and DFCS_PUSHED <> 0)) then
1207      Result := Result and not QStyleState_Raised;
1208
1209    // DFCS_TRANSPARENT = 2048;
1210    //DFCS_ADJUSTRECT = 8192;
1211    //DFCS_FLAT = 16384;
1212    //DFCS_MONO = 32768;
1213  end;
1214
1215  procedure DrawButton;
1216  var
1217    Opt: QStyleOptionButtonH;
1218    Element: QStyleControlElement;
1219    State: QStyleState;
1220    Features: QStyleOptionButtonButtonFeatures;
1221  begin
1222    State := uStatetoQStyleState;
1223    if uState and DFCS_FLAT <> 0 then
1224      Features := QStyleOptionButtonFlat
1225    else
1226      Features := QStyleOptionButtonNone;
1227    if (uState and $1F) in [DFCS_BUTTONCHECK, DFCS_BUTTON3STATE] then
1228      Element := QStyleCE_CheckBox
1229    else
1230    if (DFCS_BUTTONRADIO and uState) <> 0 then
1231      Element := QStyleCE_RadioButton
1232    else
1233    if (DFCS_BUTTONPUSH and uState) <> 0 then
1234      Element := QStyleCE_PushButton
1235    else
1236    if (DFCS_BUTTONRADIOIMAGE and uState) <> 0 then
1237      Element := QStyleCE_RadioButton
1238      //TODO: what to implement here ?
1239    else
1240    if (DFCS_BUTTONRADIOMASK and uState) <> 0 then
1241      Element := QStyleCE_RadioButton
1242      //TODO: what to implement here ?
1243    ;
1244
1245    Opt := QStyleOptionButton_create();
1246    QStyleOptionButton_setFeatures(Opt, Features);
1247    QStyleOption_setRect(Opt, @Rect);
1248    QStyleOption_setState(Opt, State);
1249    QStyle_drawControl(QApplication_style(), Element, Opt, Painter, Widget);
1250    QStyleOptionButton_destroy(Opt);
1251  end;
1252
1253  procedure DrawScrollBarArrows;
1254  var
1255    Opt: QStyleOptionH;
1256    Element: QStylePrimitiveElement;
1257    State: QStyleState;
1258  begin
1259    //TODO: DFCS_SCROLLCOMBOBOX and DFCS_SCROLLSIZEGRIP
1260    State := uStatetoQStyleState;
1261    Element := QStylePE_CustomBase;
1262    if (uState and $1F) in [DFCS_SCROLLUP] then
1263      Element := QStylePE_IndicatorArrowUp
1264    else
1265    if (uState and $1F) in [DFCS_SCROLLDOWN] then
1266      Element := QStylePE_IndicatorArrowDown
1267    else
1268    if (uState and $1F) in [DFCS_SCROLLLEFT] then
1269      Element := QStylePE_IndicatorArrowLeft
1270    else
1271    if (uState and $1F) in [DFCS_SCROLLRIGHT] then
1272      Element := QStylePE_IndicatorArrowRight;
1273
1274    if Element = QStylePE_CustomBase then
1275      exit;
1276    Opt := QStyleOption_create(QStyleOptionVersion, QStyleOptionSO_Default);
1277    QStyleOption_setRect(Opt, @Rect);
1278    QStyleOption_setState(Opt, State);
1279    QStyle_drawPrimitive(QApplication_style(), Element, Opt, Painter, Widget);
1280    QStyleOption_destroy(Opt);
1281  end;
1282
1283begin
1284  Result := False;
1285  if not IsValidDC(DC) then
1286    exit;
1287  QtDC := TQtDeviceContext(DC);
1288  Painter := QtDC.Widget;
1289  Widget := QtDC.Parent;
1290  case uType of
1291    DFC_BUTTON: DrawButton;
1292    DFC_CAPTION: ; // title bar captions
1293    DFC_MENU: ; // menu
1294    DFC_SCROLL: DrawScrollBarArrows;
1295  end;
1296end;
1297
1298{------------------------------------------------------------------------------
1299  Method:  DrawText
1300  Params:  DC, Str, Count, Rect, Flags
1301  Returns: If the string was drawn, or CalcRect run
1302
1303  if DT_CALCRECT is one of the Flags passed to this function, then:
1304
1305  * DrawText should not draw the text, but determine the size that would be required to write it.
1306  * If there are multiple lines of text, this function will keep Rect.Width fixed and
1307    expand Rect.Height to fit the text.
1308  * If there is one line of text, Rect is reduced or expanded to fit it.
1309  * The result will the height of the text.
1310 ------------------------------------------------------------------------------}
1311function TQtWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
1312  var ARect: TRect; Flags: Cardinal): Integer;
1313var
1314  WStr: WideString;
1315  R: TRect;
1316  QtDC: TQtDeviceContext;
1317  F: Integer;
1318  Pt: TPoint;
1319  ClipRect: TRect;
1320  B: Boolean;
1321  S: String;
1322  i: Integer;
1323
1324  procedure CalculateOffsetWithAngle(const AFontAngle: Integer;
1325    var TextLeft,TextTop: Integer);
1326  var
1327    OffsX, OffsY: integer;
1328    Angle: Integer;
1329    Size: TSize;
1330  begin
1331    OffsX := R.Right - R.Left;
1332    OffsY := R.Bottom - R.Top;
1333    Size.cX := OffsX;
1334    Size.cy := OffsY;
1335    Angle := AFontAngle div 10;
1336    if Angle < 0 then
1337      Angle := 360 + Angle;
1338
1339    if Angle <= 90 then
1340    begin
1341      OffsX := 0;
1342      OffsY := Trunc(Size.cx * sin(Angle * Pi / 180));
1343    end else
1344    if Angle <= 180 then
1345    begin
1346      OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180));
1347      OffsY := Trunc(Size.cx * sin(Angle * Pi / 180) +
1348         Size.cy * cos((180 - Angle) * Pi / 180));
1349    end else
1350    if Angle <= 270 then
1351    begin
1352      OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180) +
1353        Size.cy * sin((Angle - 180) * Pi / 180));
1354      OffsY := Trunc(Size.cy * sin((270 - Angle) * Pi / 180));
1355    end else
1356    if Angle <= 360 then
1357    begin
1358      OffsX := Trunc(Size.cy * sin((360 - Angle) * Pi / 180));
1359      OffsY := 0;
1360    end;
1361    TextTop := OffsY;
1362    TextLeft := OffsX;
1363  end;
1364
1365begin
1366  {$ifdef VerboseQtWinAPI}
1367    WriteLn('[WinAPI DrawText] DC: ', dbghex(DC), ' Str: ', string(Str),
1368     ' CalcRect: ', dbgs((Flags and DT_CALCRECT) = DT_CALCRECT),' ARect ',dbgs(ARect));
1369  {$endif}
1370
1371  Result := 0;
1372
1373  if not IsValidDC(DC) then
1374    Exit;
1375
1376  QtDC :=TQtDeviceContext(DC);
1377
1378  if Count >= 0 then
1379    WStr := {%H-}Copy(Str, 1, Count)
1380  else
1381    WStr := Str;
1382
1383  ClipRect := Rect(0, 0, 0, 0);
1384  B := QtDC.getClipping;
1385  if (Flags and DT_NOCLIP = DT_NOCLIP) and
1386    (Flags and DT_WORDBREAK = DT_WORDBREAK) and
1387    {if DT_CALCRECT is inlcuded we should avoid wrong calculation}
1388    (Flags and DT_CALCRECT = 0) then
1389  begin
1390    if B then
1391      ClipRect := QtDC.getClipRegion.getBoundingRect;
1392    //this is just to get same behaviour as gtk2 and win32
1393    //IMO, we should change ARect.Left and/or ARect.Top if smaller than
1394    //clip rect (map to clipRect). Then multiline text is drawn ok.
1395    //look at issue http://bugs.freepascal.org/view.php?id=17678 . zeljko.
1396    if not B or (B and ((ARect.Left < ClipRect.Left) or (ARect.Top < ClipRect.Top))) then
1397    begin
1398      {$note remove ifdef if I'm wrong about DT_WORDBREAK OBSERVATION}
1399      {$IFDEF QT_DRAWTEXT_MAP_TO_CLIPRECT}
1400      if ARect.Left < ClipRect.Left then
1401        ARect.Left := ClipRect.Left;
1402      if ARect.Top < ClipRect.Top then
1403        ARect.Top := ClipRect.Top;
1404      {$ELSE}
1405      Flags := Flags and not DT_WORDBREAK;
1406      {$ENDIF}
1407    end;
1408  end;
1409
1410  F := DTFlagsToQtFlags(Flags);
1411
1412  QtDC.Metrics.BoundingRect(@R, @ARect, F, @WStr);
1413
1414  //TODO: result should be different when DT_VCENTER or DT_BOTTOM is set
1415  Result := R.Bottom - R.Top;
1416
1417  if (Flags and DT_CALCRECT) = DT_CALCRECT then
1418  begin
1419    if (Flags and DT_WORDBREAK = DT_WORDBREAK) and
1420    ((R.Bottom - R.Top) > (ARect.Bottom - ARect.Top)) then
1421      // MSDN says do not touch rect width when we have DT_WORDBREAK flag
1422      // and new text is multiline (if R height > ARect height).See #17329.
1423    else
1424      ARect.Right := ARect.Left + R.Right - R.Left;
1425    ARect.Bottom := ARect.Top + R.Bottom - R.Top;
1426    {$ifdef VerboseQtWinAPI}
1427      WriteLn('[WinAPI DrawText] Rect=', dbgs(ARect));
1428    {$endif}
1429    Exit;
1430  end;
1431
1432  // if our Font.Orientation <> 0 we must recalculate X,Y offset
1433  // also it works only with DT_TOP DT_LEFT. Qt can handle multiline
1434  // text in this case too.
1435  Pt := Point(0, 0);
1436  if (QtDC.Font.Angle <> 0) then
1437  begin
1438    if IsRectEmpty(ClipRect) and QtDC.getClipping then
1439      ClipRect := QtDC.getClipRegion.getBoundingRect;
1440    if EqualRect(ClipRect, ARect) then
1441    begin
1442      Pt := Point(ARect.Left, ARect.Top);
1443      CalculateOffsetWithAngle(QtDC.font.Angle, Pt.X, Pt.Y);
1444    end;
1445  end;
1446
1447  // we cannot fit into rectangle, so use DT_SINGLELINE.See #17329.
1448  // http://msdn.microsoft.com/en-us/library/dd162498%28v=VS.85%29.aspx
1449  if B and
1450    (Flags and DT_NOCLIP = DT_NOCLIP) and
1451    (Flags and DT_WORDBREAK = DT_WORDBREAK) and
1452    (Flags and DT_SINGLELINE = DT_SINGLELINE) and
1453    ((R.Bottom - R.Top) >= (ARect.Bottom - ARect.Top)) then
1454  begin
1455    Flags := Flags and not DT_WORDBREAK;
1456    F := DTFlagsToQtFlags(Flags);
1457  end;
1458
1459  {Workaround for qt-4.7 QPainter bug.It's fixed in qt-4.7.4. DO NOT REMOVE}
1460  { Bug triggers when we try to paint multiline text which contains 1
1461   space. eg "Save project\nCtrl+S". In this case QPainter draws
1462   Save
1463   project (in two lines, so Ctrl+S is invisible. See issue #18631.
1464   But does not trigger with qt-4.6.XX and maybe with 4.7.0.
1465   Opened nokia issue: http://bugreports.qt.nokia.com/browse/QTBUG-17020
1466   UPDATE: it's fixed in qt-4.7.4 git and qt-4.8}
1467  if (QtVersionMajor = 4) and (QtVersionMinor = 7) and (QtVersionMicro < 4) and
1468   (Flags and DT_WORDBREAK = DT_WORDBREAK) and
1469   ((Flags and DT_VCENTER = DT_VCENTER) or (Flags and DT_CENTER = DT_CENTER))
1470    and not (Flags and DT_NOCLIP = DT_NOCLIP) and
1471    not (Flags and DT_MODIFYSTRING = DT_MODIFYSTRING) and
1472    not (Flags and DT_END_ELLIPSIS = DT_END_ELLIPSIS) then
1473  begin
1474    S := StrPas(Str);
1475    if length(S) > 0 then
1476    begin
1477      i := Pos(' ', S);
1478      if (AnsiPos(LineEnding, S) > i) and
1479        (S[length(S)] <> LineEnding) then
1480      begin
1481        Flags := Flags and not DT_WORDBREAK;
1482        F := DTFlagsToQtFlags(Flags);
1483      end;
1484    end;
1485  end;
1486
1487  if (Flags and DT_MODIFYSTRING = DT_MODIFYSTRING) and
1488  (Flags and DT_END_ELLIPSIS = DT_END_ELLIPSIS) and
1489  (Flags and DT_WORDBREAK = 0) then
1490  begin
1491    // windows are removing trailing spaces in this case
1492    // and we are doing same thing too.
1493    WStr := TrimLeft(WStr);
1494    with ARect do
1495      WStr := QtDC.Metrics.elidedText(WStr, QtElideRight, Right - Left, 0);
1496  end;
1497
1498  QtDC.DrawText(ARect.Left + Pt.X, ARect.Top + Pt.Y, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, F, @WStr);
1499end;
1500
1501{------------------------------------------------------------------------------
1502  Method:   Ellipse
1503  Params:   X1, Y1, X2, Y2
1504  Returns:  Nothing
1505
1506  Use Ellipse to draw a filled circle or ellipse.
1507 ------------------------------------------------------------------------------}
1508function TQtWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
1509var
1510  R: TRect;
1511begin
1512  if not IsValidDC(DC) then Exit(False);
1513  R := NormalizeRect(Rect(X1, Y1, X2, Y2));
1514  if IsRectEmpty(R) then Exit(True);
1515  TQtDeviceContext(DC).drawEllipse(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
1516  Result := True;
1517end;
1518
1519function TQtWidgetSet.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean;
1520begin
1521  {maybe we can put creating of scrollbar here instead of SetScrollInfo() }
1522  Result := False;
1523  {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
1524    WriteLn('***** [WinAPI TQtWidgetSet.EnableScrollbar] missing implementation ');
1525  {$endif}
1526end;
1527
1528function TQtWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
1529begin
1530  {$ifdef VerboseQtWinAPI}
1531    WriteLn('[WinAPI EnableWindow] ');
1532  {$endif}
1533  Result := False;
1534  if HWND <> 0 then
1535  begin
1536    Result := not TQtWidget(hwnd).getEnabled;
1537    TQtWidget(hWnd).setEnabled(bEnable);
1538  end;
1539end;
1540
1541{------------------------------------------------------------------------------
1542  Function: EndPaint
1543  Params:
1544  Returns:
1545
1546 ------------------------------------------------------------------------------}
1547function TQtWidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
1548begin
1549  {$ifdef VerboseQtWinAPI}
1550    WriteLn('[WinAPI EndPaint] Handle: ', dbghex(Handle),
1551     ' PS.HDC: ', dbghex(PS.HDC));
1552  {$endif}
1553
1554  Result := 1;
1555
1556  if IsValidDC(PS.HDC) and (TObject(PS.HDC) is TQtDeviceContext) then
1557  begin
1558    {$ifdef VerboseQtWinAPI}
1559      WriteLn('Freeing resources');
1560    {$endif}
1561    TQtDeviceContext(PS.HDC).Free;
1562  end;
1563end;
1564
1565{------------------------------------------------------------------------------
1566  Procedure: EnterCriticalSection
1567  Params:  var CritSection: TCriticalSection
1568  Returns: Nothing
1569 ------------------------------------------------------------------------------}
1570procedure TQtWidgetSet.EnterCriticalSection(var CritSection: TCriticalSection);
1571var
1572  ACritSec: System.PRTLCriticalSection;
1573begin
1574  ACritSec:=System.PRTLCriticalSection(CritSection);
1575  System.EnterCriticalsection(ACritSec^);
1576end;
1577
1578function TQtWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
1579  lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
1580var
1581  i: integer;
1582  Desktop: QDesktopWidgetH;
1583begin
1584  Desktop := QApplication_desktop();
1585  Result := True;
1586  for i := 0 to QDesktopWidget_numScreens(Desktop) - 1 do
1587  begin
1588    Result := Result and lpfnEnum(i + 1, 0, nil, dwData);
1589    if not Result then break;
1590  end;
1591end;
1592
1593
1594function CharsetToQtCharSet(const ALCLCharset: Byte): QFontDatabaseWritingSystem;
1595begin
1596  Result := QFontDatabaseAny;
1597  case ALCLCharset of
1598    SYMBOL_CHARSET: Result := QFontDatabaseSymbol;
1599    FCS_ISO_8859_1 .. FCS_ISO_8859_4,
1600    FCS_ISO_8859_9,FCS_ISO_8859_10,
1601    FCS_ISO_8859_15,
1602    EASTEUROPE_CHARSET: Result := QFontDatabaseLatin;
1603    FCS_ISO_8859_5,
1604    RUSSIAN_CHARSET: Result := QFontDatabaseCyrillic;
1605    FCS_ISO_8859_6,
1606    ARABIC_CHARSET: Result := QFontDatabaseArabic;
1607    FCS_ISO_8859_7,
1608    GREEK_CHARSET: Result := QFontDatabaseGreek;
1609    FCS_ISO_8859_8,
1610    HEBREW_CHARSET: Result := QFontDatabaseHebrew;
1611    SHIFTJIS_CHARSET: Result := QFontDatabaseJapanese;
1612    HANGEUL_CHARSET: Result := QFontDatabaseKorean;
1613    GB2312_CHARSET: Result := QFontDatabaseSimplifiedChinese;
1614    CHINESEBIG5_CHARSET: Result := QFontDatabaseTraditionalChinese;
1615    THAI_CHARSET: Result := QFontDatabaseThai;
1616  end;
1617end;
1618
1619function QtCharsetToCharset(AWritingSystem: QFontDatabaseWritingSystem;
1620  AList: TFPList): Byte;
1621begin
1622  Result := DEFAULT_CHARSET;
1623  case AWritingSystem of
1624    QFontDatabaseAny:
1625    begin
1626      Result := FCS_ISO_10646_1;
1627      AList.Add(TObject(PtrUInt(Result)));
1628    end;
1629    QFontDatabaseSymbol:
1630    begin
1631      Result := SYMBOL_CHARSET;
1632      AList.Add(TObject(PtrUInt(Result)));
1633    end;
1634    QFontDatabaseThai:
1635    begin
1636      Result := THAI_CHARSET;
1637      AList.Add(TObject(PtrUInt(Result)));
1638    end;
1639    QFontDatabaseTraditionalChinese:
1640    begin
1641      Result := CHINESEBIG5_CHARSET;
1642      AList.Add(TObject(PtrUInt(Result)));
1643    end;
1644    QFontDatabaseSimplifiedChinese:
1645    begin
1646      Result := GB2312_CHARSET;
1647      AList.Add(TObject(PtrUInt(Result)));
1648    end;
1649    QFontDatabaseKorean:
1650    begin
1651      Result := HANGEUL_CHARSET;
1652      AList.Add(TObject(PtrUInt(Result)));
1653    end;
1654    QFontDatabaseJapanese:
1655    begin
1656      Result := SHIFTJIS_CHARSET;
1657      AList.Add(TObject(PtrUInt(Result)));
1658    end;
1659    QFontDatabaseHebrew:
1660    begin
1661      Result := HEBREW_CHARSET;
1662      AList.Add(TObject(PtrUInt(Result)));
1663      AList.Add(TObject(PtrUInt(FCS_ISO_8859_8)));
1664    end;
1665    QFontDatabaseGreek:
1666    begin
1667      Result := GREEK_CHARSET;
1668      AList.Add(TObject(PtrUInt(Result)));
1669      AList.Add(TObject(PtrUInt(FCS_ISO_8859_7)));
1670    end;
1671    QFontDatabaseArabic:
1672    begin
1673      Result := ARABIC_CHARSET;
1674      AList.Add(TObject(PtrUInt(Result)));
1675    end;
1676    QFontDatabaseCyrillic:
1677    begin
1678      Result := RUSSIAN_CHARSET;
1679      AList.Add(TObject(PtrUInt(Result)));
1680      AList.Add(TObject(PtrUInt(FCS_ISO_8859_5)));
1681    end;
1682    QFontDatabaseLatin:
1683    begin
1684      Result := FCS_ISO_10646_1;
1685      AList.Add(TObject(PtrUInt(Result)));
1686      AList.Add(TObject(PtrUInt(ANSI_CHARSET)));
1687      AList.Add(TObject(PtrUInt(FCS_ISO_8859_1)));
1688      AList.Add(TObject(PtrUInt(FCS_ISO_8859_2)));
1689      AList.Add(TObject(PtrUInt(FCS_ISO_8859_3)));
1690      AList.Add(TObject(PtrUInt(FCS_ISO_8859_4)));
1691      AList.Add(TObject(PtrUInt(FCS_ISO_8859_9)));
1692      AList.Add(TObject(PtrUInt(FCS_ISO_8859_10)));
1693      AList.Add(TObject(PtrUInt(FCS_ISO_8859_15)));
1694      AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET)));
1695    end;
1696  end;
1697end;
1698
1699{------------------------------------------------------------------------------
1700  Function: EnumFontFamiliesEx
1701  Params:
1702    hdc
1703        [in] Handle to the device context.
1704    lpLogfont
1705        [in] Pointer to a LOGFONT structure that contains information about the
1706        fonts to enumerate. The function examines the following members.
1707
1708        Member 	Description
1709        lfCharset 	If set to DEFAULT_CHARSET, the function enumerates all fonts
1710                    in all character sets. If set to a valid character set value,
1711                    the function enumerates only fonts in the specified character
1712                    set.
1713        lfFaceName 	If set to an empty string, the function enumerates one font
1714                    in each available typeface name. If set to a valid typeface
1715                    name, the function enumerates all fonts with the
1716                    specified name.
1717
1718        lfPitchAndFamily 	Must be set to zero for all language versions of
1719                          the operating system.
1720
1721    lpEnumFontFamExProc
1722        [in] Pointer to the application definedcallback function. For more
1723             information, see the EnumFontFamExProc function.
1724    lParam
1725        [in] Specifies an applicationdefined value. The function passes this value
1726             to the callback function along with font information.
1727    dwFlags
1728        This parameter is not used and must be zero.
1729
1730  Returns:
1731
1732  The return value is the last value returned by the callback function.
1733  This value depends on which font families are available for the
1734  specified device.
1735
1736 ------------------------------------------------------------------------------}
1737function TQtWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
1738var
1739  EnumLogFont: TEnumLogFontEx;
1740  Metric: TNewTextMetricEx;
1741  FontList: TStringList;
1742  FontType: Integer;
1743  FontDB: QFontDatabaseH;
1744  i: Integer;
1745  y: Integer;
1746  AStyle: String;
1747  StylesCount: Integer;
1748  StylesList: QStringListH;
1749  ScriptList: QStringListH;
1750  CharsetList: TFPList;
1751
1752  function QtGetFontFamiliesDefault(var List:TStringList;
1753    const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny):integer;
1754  var
1755    StrLst: QStringlistH;
1756    WStr: WideString;
1757    j: integer;
1758  begin
1759    Result := -1;
1760    StrLst := QStringList_create;
1761    try
1762      QFontDatabase_families(FontDB, StrLst, AWritingSystem);
1763      Result := QStringList_size(StrLst);
1764      for j := 0 to Result - 1 do
1765      begin
1766        QStringList_at(StrLst, @WStr, j);
1767        List.Add(WStr{%H-});
1768      end;
1769    finally
1770      QStringList_destroy(StrLst);
1771    end;
1772  end;
1773
1774  function QtGetFontFamilies(var List: TStringList;
1775    const APitch: Byte;
1776    const AFamilyName: String;
1777    const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny): Integer;
1778  var
1779    StrLst: QStringlistH;
1780    NewList: QStringListH;
1781    WStr: WideString;
1782    j: integer;
1783  begin
1784    Result := -1;
1785    StrLst := QStringList_create();
1786    NewList := QStringList_create();
1787
1788    try
1789      QFontDatabase_families(FontDB, StrLst, AWritingSystem);
1790      for j := 0 to QStringList_size(StrLst) - 1 do
1791      begin
1792        QStringList_at(StrLst, @WStr, j);
1793        if APitch <> DEFAULT_PITCH then
1794        begin
1795          case APitch of
1796            FIXED_PITCH, MONO_FONT:
1797            begin
1798              if QFontDatabase_isFixedPitch(FontDB, @WStr) then
1799                QStringList_append(NewList, @WStr);
1800            end;
1801            VARIABLE_PITCH:
1802            begin
1803              if QFontDatabase_isScalable(FontDB, @WStr) then
1804                QStringList_append(NewList, @WStr);
1805            end;
1806          end;
1807        end else
1808          QStringList_append(NewList, @WStr);
1809      end;
1810
1811      if AFamilyName <> '' then
1812      begin
1813        for j := QStringList_size(NewList) - 1 downto 0 do
1814        begin
1815          QStringList_at(NewList, @WStr, j);
1816          if UTF16ToUTF8(WStr) <> AFamilyName then
1817            QStringList_removeAt(NewList, j);
1818        end;
1819      end;
1820      for j := 0 to QStringList_size(NewList) - 1 do
1821      begin
1822        QStringList_at(NewList, @WStr, j);
1823        List.Add(WStr{%H-});
1824      end;
1825      Result := List.Count;
1826    finally
1827      QStringList_destroy(StrLst);
1828      QStringList_destroy(NewList);
1829    end;
1830  end;
1831
1832  function GetStyleAt(AIndex: Integer): String;
1833  var
1834    WStr: WideString;
1835  begin
1836    Result := '';
1837    if (AIndex >= 0) and (AIndex < QStringList_size(StylesList)) then
1838    begin
1839      QStringList_at(StylesList, @WStr, AIndex);
1840      Result := {%H-}WStr;
1841    end;
1842  end;
1843
1844  function GetWritingSystems(AFontName: String; AList: QStringListH;
1845    ACharsetList: TFPList): Boolean;
1846  var
1847    WStr: WideString;
1848    Arr: TPtrIntArray;
1849    j: Integer;
1850  begin
1851    Result := False;
1852    QStringList_clear(AList);
1853    if Assigned(CharSetList) then
1854      CharSetList.Clear;
1855    WStr := {%H-}AFontName;
1856    QFontDatabase_writingSystems(FontDB, @Arr, @WStr);
1857    Result := length(Arr) > 0;
1858    for j := 0 to High(Arr) do
1859    begin
1860      if Assigned(ACharsetList) then
1861        QtCharsetToCharset(QFontDatabaseWritingSystem(Arr[j]), ACharsetList);
1862      QFontDatabase_writingSystemName(@WStr, QFontDatabaseWritingSystem(Arr[j]));
1863      QStringList_append(AList, @WStr);
1864    end;
1865  end;
1866
1867  function FillLogFontA(AFontName: String; var ALogFontA: TLogFontA;
1868    var AMetric: TNewTextMetricEx; var AFontType: Integer;
1869    out AStyle: String): Integer;
1870  var
1871    Font: QFontH;
1872    WStr: WideString;
1873  begin
1874    WStr := {%H-}AFontName;
1875    Font := QFont_create(@WStr);
1876    ALogFontA.lfItalic := Byte(QFont_italic(Font));
1877    ALogFontA.lfWeight := QFont_weight(Font);
1878    ALogFontA.lfHeight := QFont_pointSize(Font);
1879    ALogFontA.lfUnderline := Byte(QFont_underline(Font));
1880    ALogFontA.lfStrikeOut := Byte(QFont_strikeOut(Font));
1881
1882    if QFont_styleStrategy(Font) = QFontPreferBitmap then
1883      AFontType := AFontType  or RASTER_FONTTYPE;
1884    if QFont_styleStrategy(Font) = QFontPreferDevice then
1885      AFontType := AFontType  or DEVICE_FONTTYPE;
1886
1887    if not (QFont_styleStrategy(Font) = QFontPreferDefault) then
1888      AFontType := AFontType and not TRUETYPE_FONTTYPE;
1889
1890    QStringList_clear(StylesList);
1891    QFontDatabase_styles(FontDB, StylesList, @WStr);
1892    AStyle := '';
1893    Result := QStringList_size(StylesList);
1894
1895    if Result > 0 then
1896      AStyle := GetStyleAt(0);
1897    // fill script and charset list
1898    GetWritingSystems(AFontName, ScriptList, CharsetList);
1899
1900    QFont_destroy(Font);
1901  end;
1902
1903begin
1904  {$ifdef VerboseQtWinAPI}
1905  WriteLn('[WinAPI EnumFontFamiliesEx] Charset=',lpLogFont^.lfCharSet,
1906  ' face ',lpLogFont^.lfFaceName,' pitchAndFamily=',lpLogFont^.lfPitchAndFamily);
1907  {$endif}
1908  Result := 0;
1909  Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
1910  FontDB := QFontDatabase_create();
1911  try
1912    if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and
1913       (lpLogFont^.lfFaceName= '') and
1914       (lpLogFont^.lfPitchAndFamily = 0) then
1915    begin
1916      FontType := 0;
1917      FontList := TStringList.create;
1918      try
1919        if QtGetFontFamiliesDefault(FontList) > 0 then
1920        begin
1921          for i := 0 to FontList.Count - 1 do
1922          begin
1923            EnumLogFont.elfLogFont.lfFaceName := FontList[i];
1924            Result := Callback(EnumLogFont, Metric, FontType, LParam);
1925          end;
1926        end;
1927      finally
1928        FontList.free;
1929      end;
1930    end else
1931    begin
1932      Result := 0;
1933      FontType := TRUETYPE_FONTTYPE;
1934      FontList := TStringList.create;
1935      StylesList := QStringList_create();
1936      ScriptList := QStringList_create();
1937      CharsetList := TFPList.Create;
1938      try
1939        if QtGetFontFamilies(FontList, lpLogFont^.lfPitchAndFamily,
1940          lpLogFont^.lfFaceName, CharsetToQtCharSet(lpLogFont^.lfCharSet)) > 0 then
1941        begin
1942          StylesList := QStringList_create();
1943          for i := 0 to FontList.Count - 1 do
1944          begin
1945            EnumLogFont.elfLogFont.lfFaceName := FontList[i];
1946            EnumLogFont.elfLogFont.lfPitchAndFamily := lpLogFont^.lfPitchAndFamily;
1947            EnumLogFont.elfFullName := FontList[i];
1948
1949            StylesCount := FillLogFontA(FontList[i], EnumLogFont.elfLogFont, Metric, FontType,
1950              AStyle);
1951            EnumLogFont.elfStyle := AStyle;
1952            if CharSetList.Count > 0 then
1953              EnumLogFont.elfLogFont.lfCharSet := {%H-}PtrUInt(CharsetList.Items[0]);
1954            Result := Callback(EnumLogFont, Metric, FontType, LParam);
1955            for y := 1 to StylesCount - 1 do
1956            begin
1957              AStyle := GetStyleAt(y);
1958              EnumLogFont.elfStyle := AStyle;
1959              Result := Callback(EnumLogFont, Metric, FontType, LParam);
1960            end;
1961            for y := 1 to CharsetList.Count - 1 do
1962            begin
1963              EnumLogFont.elfLogFont.lfCharSet := {%H-}PtrUInt(CharsetList.Items[y]);
1964              Result := Callback(EnumLogFont, Metric, FontType, LParam);
1965            end;
1966          end;
1967        end;
1968      finally
1969        FontList.free;
1970        QStringList_destroy(StylesList);
1971        CharSetList.Free;
1972      end;
1973    end;
1974  finally
1975    QFontDatabase_destroy(FontDB);
1976  end;
1977end;
1978
1979
1980{------------------------------------------------------------------------------
1981  Function: ExcludeClipRect
1982  Params:  none
1983  Returns: Nothing
1984
1985 ------------------------------------------------------------------------------}
1986function TQtWidgetSet.ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer;
1987var
1988  Region: QRegionH;
1989  ClipRegion: QRegionH;
1990  ExRegion: QRegionH;
1991  QtDC: TQtDeviceContext;
1992  R: TRect;
1993begin
1994  {$ifdef VerboseQtWinAPI}
1995    WriteLn('[WinAPI ExcludeClipRect]');
1996  {$endif}
1997
1998  Result := ERROR;
1999  if not IsValidDC(DC) then Exit;
2000
2001  QtDC := TQtDeviceContext(DC);
2002
2003  {ExcludeClipRect on X11 paint engine is pretty slow with complex regions
2004   eg. setting clipRegion with hundreds of rects (usually created by
2005   calling ExcludeClipRect for many children on widget) dramatically kills
2006   performance of our application.
2007   To get rid of it we are using trick from webkit. If numRects is over
2008   25 then create an new rect region with boundsRect of NewRegion.
2009   see issue http://bugs.freepascal.org/view.php?id=19698.
2010   If you want accurate ExcludeClipRect use graphicssystem Raster or
2011   see comment in TQtWidgetSet.ExtSelectClipRgn}
2012  ExRegion := QRegion_create(Left, Top, Right - Left, Bottom - Top, QRegionRectangle);
2013  Region := QRegion_create;
2014  ClipRegion := QRegion_create;
2015  try
2016    QPainter_clipRegion(QtDC.Widget, ClipRegion);
2017    QRegion_subtracted(ClipRegion, Region, ExRegion);
2018
2019    // only for X11 paintEngine.
2020    if (QPaintEngine_type(QtDC.PaintEngine) = QPaintEngineX11) and
2021      not QRegion_isEmpty(Region) and
2022      (QRegion_numRects(Region) > 25) then
2023    begin
2024      QRegion_boundingRect(Region, @R);
2025      QRegion_setRects(Region, @R, 1);
2026    end;
2027
2028    QtDC.setClipRegion(Region);
2029    QtDC.setClipping(True);
2030    if QRegion_isEmpty(Region) then
2031      Result := NULLREGION
2032    else
2033    if QRegion_numRects(Region) = 1 then
2034      Result := SIMPLEREGION
2035    else
2036      Result := COMPLEXREGION;
2037
2038  finally
2039    QRegion_destroy(ClipRegion);
2040    QRegion_destroy(Region);
2041    QRegion_destroy(ExRegion);
2042  end;
2043end;
2044
2045function TQtWidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord;
2046  const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN;
2047var
2048  QtPen: TQtPen;
2049  color: TQColor;
2050begin
2051  Result := 0;
2052  QtPen := TQtPen.Create(True);
2053  QtPen.IsExtPen := True;
2054
2055  case dwPenStyle and PS_STYLE_MASK of
2056    PS_SOLID: QtPen.setStyle(QtSolidLine);
2057    PS_DASH: QtPen.setStyle(QtDashLine);
2058    PS_DOT: QtPen.setStyle(QtDotLine);
2059    PS_DASHDOT: QtPen.setStyle(QtDashDotLine);
2060    PS_DASHDOTDOT: QtPen.setStyle(QtDashDotDotLine);
2061    PS_USERSTYLE: QtPen.setStyle(QtCustomDashLine);
2062    PS_NULL: QtPen.setStyle(QtNoPen);
2063  end;
2064
2065  QtPen.setCosmetic((dwPenStyle and PS_TYPE_MASK) = PS_COSMETIC);
2066  if (dwPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC then
2067  begin
2068    QtPen.setWidth(dwWidth);
2069    case dwPenStyle and PS_JOIN_MASK of
2070      PS_JOIN_ROUND: QtPen.setJoinStyle(QtRoundJoin);
2071      PS_JOIN_BEVEL: QtPen.setJoinStyle(QtBevelJoin);
2072      PS_JOIN_MITER: QtPen.setJoinStyle(QtMiterJoin);
2073    end;
2074
2075    case dwPenStyle and PS_ENDCAP_MASK of
2076      PS_ENDCAP_ROUND: QtPen.setCapStyle(QtRoundCap);
2077      PS_ENDCAP_SQUARE: QtPen.setCapStyle(QtSquareCap);
2078      PS_ENDCAP_FLAT: QtPen.setCapStyle(QtFlatCap);
2079    end;
2080  end;
2081
2082  if (dwPenStyle and PS_STYLE_MASK) = PS_USERSTYLE then
2083    QtPen.setDashPattern(lpStyle, dwStyleCount);
2084
2085  QPen_Color(QtPen.FHandle, @Color);
2086  ColorRefToTQColor(ColorToRGB(TColor(lplb.lbColor)), Color);
2087  QPen_setColor(QtPen.FHandle, @Color);
2088
2089  Result := HPEN(QtPen);
2090end;
2091
2092function TQtWidgetSet.ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer;
2093var
2094  Clip: HRGN = 0;
2095  Tmp : hRGN;
2096  DCOrigin: TPoint;
2097  QtWidget: TQtWidget = nil;
2098  QtDC: TQtDeviceContext;
2099  QtRgn: TQtRegion;
2100  R: TRect;
2101begin
2102  {$ifdef VerboseQtWinAPI}
2103    WriteLn('[WinAPI TQtWidgetSet.ExtSelectClipRGN]');
2104  {$endif}
2105  if not IsValidDC(DC) then
2106  begin
2107    Result := ERROR;
2108    exit;
2109  end else
2110    Result := SIMPLEREGION;
2111
2112  QtDC := TQtDeviceContext(DC);
2113
2114  if Assigned(QtDC.Parent) then
2115    QtWidget := QtObjectFromWidgetH(QtDC.Parent);
2116
2117  if Assigned(QtWidget) or
2118    (not Assigned(QtWidget) and Assigned(QtDC.vImage)) then
2119  begin
2120    // there is no clipping region in the DC
2121    case Mode of
2122      RGN_COPY: Result := SelectClipRGN(DC, RGN);
2123      RGN_OR,
2124      RGN_XOR,
2125      RGN_AND:
2126        begin
2127          // as MSDN says only RGN_COPY allows NULL RGN param.
2128          if not IsValidGDIObject(RGN) then
2129          begin
2130            Result := ERROR;
2131            exit;
2132          end;
2133          // get existing clip
2134          QtRgn := QtDC.getClipRegion;
2135
2136          if (QtRgn = nil) or (QtRgn.GetRegionType = NULLREGION) then
2137          begin
2138            Result := SelectClipRGN(DC, RGN);
2139            exit;
2140          end;
2141
2142          // get transformation
2143          GetWindowOrgEx(DC, @DCOrigin);
2144          R := QtRgn.getBoundingRect;
2145          Clip := CreateRectRGN(0, 0, R.Right - R.Left, R.Bottom - R.Top);
2146          TQtRegion(Clip).translate(DCOrigin.X, DCOrigin.Y);
2147
2148          // create target clip
2149          Tmp := CreateEmptyRegion;
2150          // combine
2151          Result := CombineRGN(Tmp, Clip, RGN, Mode);
2152          // commit
2153          SelectClipRGN(DC, Tmp);
2154          // clean up
2155          DeleteObject(Clip);
2156          DeleteObject(Tmp);
2157        end;
2158      RGN_DIFF:
2159      begin
2160        // when substracting we must have active clipregion
2161        // with all of its rects.
2162        QtRgn := QtDC.getClipRegion;
2163        if (QtRgn = nil) or (QtRgn.GetRegionType = NULLREGION) then
2164        begin
2165          Result := SelectClipRGN(DC, RGN);
2166          exit;
2167        end;
2168
2169        Tmp := CreateEmptyRegion;
2170        Result := CombineRGN(Tmp, HRGN(QtRgn), RGN, MODE);
2171
2172        // X11 paintEngine comment only !
2173        // we'll NOT reset num of rects here (performance problem) like we do
2174        // in ExcludeClipRect, because this function must be correct,
2175        // if someone want accurate ExcludeClipRect with X11 then
2176        // use code from intfbasewinapi.inc TWidgetSet.ExcludeClipRect()
2177        // which calls this function and then combineRgn.
2178        SelectClipRGN(DC, Tmp);
2179        DeleteObject(Tmp);
2180      end;
2181    end;
2182  end
2183  else
2184    Result := inherited ExtSelectClipRGN(DC, RGN, Mode);
2185end;
2186
2187{------------------------------------------------------------------------------
2188  Function: ExtTextOut
2189  Params:  none
2190  Returns: Nothing
2191
2192
2193 ------------------------------------------------------------------------------}
2194function TQtWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
2195  Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
2196var
2197  WStr: WideString;
2198  QtDC: TQtDeviceContext absolute DC;
2199  R, R1: TRect;
2200  Pt: TPoint;
2201  ALayout: QtLayoutDirection;
2202  B: Boolean;
2203
2204  procedure DoDrawCharByChar(const AClipped: Boolean);
2205  var
2206    CurX, CharLen: Integer;
2207    CurCount: LongInt;
2208    CurDx: PInteger;
2209    CurStr: PChar;
2210    W: WideString;
2211  begin
2212    CurDx := Dx;
2213    CurStr := Str;
2214    CurCount := Count;
2215    CurX := X;
2216    while CurCount > 0 do
2217    begin
2218      CharLen := UTF8CodepointSize(CurStr);
2219      W := {%H-}Copy(CurStr, 1, CharLen);
2220      if AClipped then
2221        QtDC.drawText(CurX, Y, Rect^.Right - Rect^.Left, Rect^.Bottom - Rect^.Top,
2222                      QtTextDontClip, @W)
2223      else
2224        QtDC.drawText(CurX, Y, @W);
2225      inc(CurX, CurDx^);
2226      inc(CurDx);
2227      inc(CurStr, CharLen);
2228      dec(CurCount, CharLen);
2229    end;
2230  end;
2231
2232begin
2233  {$ifdef VerboseQtWinAPI}
2234    WriteLn('[WinAPI ExtTextOut]');
2235  {$endif}
2236
2237  Result := False;
2238
2239  if not IsValidDC(DC) then Exit;
2240
2241  B := False;
2242  if ((Options and (ETO_OPAQUE + ETO_CLIPPED)) <> 0) and (Rect = nil) then
2243  begin
2244    if Count >= 0 then
2245      WStr := {%H-}Copy(Str, 1, Count)
2246    else
2247      WStr := Str;
2248
2249    R := QtDC.getClipRegion.getBoundingRect;
2250    QtDC.font.Metrics.boundingRect(@R1, @R, 0, @WStr);
2251    B := True;
2252    Rect := @R1;
2253  end;
2254
2255  if ((Options and ETO_OPAQUE) <> 0) and (Rect <> nil) then
2256  begin
2257    // Qt-4.8 bug
2258    if (QtVersionMajor = 4) and (QtVersionMinor = 8) and (QtVersionMicro < 3) and
2259      QPaintEngine_testDirty(QtDC.PaintEngine, QPaintEngineDirtyBrushOrigin) then
2260    begin
2261      // couldn't find way to fix it.
2262    end;
2263    if B then
2264      QtDC.fillRect(X, Y, Rect^.Right - Rect^.Left, Rect^.Bottom - Rect^.Top)
2265    else
2266      QtDC.fillRect(Rect^.Left, Rect^.Top, Rect^.Right - Rect^.Left, Rect^.Bottom - Rect^.Top);
2267  end else
2268  if ((Options and ETO_OPAQUE) = 0) and (Rect <> nil) and (QtDC.getBKMode = OPAQUE) then
2269  begin
2270    // Qt-4.8 bug
2271    {$warning workaround for Qt-4.8.XX bug (test with 4.8.3 release) !}
2272    if (QtVersionMajor = 4) and (QtVersionMinor = 8) and (QtVersionMicro < 3) and
2273      QPaintEngine_testDirty(QtDC.PaintEngine, QPaintEngineDirtyBrushOrigin) then
2274    begin
2275      R := Rect^;
2276      QtDC.font.Metrics.boundingRect(@R1, @R, QtTextSingleLine, @WStr);
2277      if Options and ETO_CLIPPED = 0 then
2278        Pt := Point(Rect^.Left - X, Rect^.Top - Y)
2279      else
2280        Pt := Point(0, 0);
2281      QtDC.fillRect(Rect^.Left - Pt.X, Rect^.Top - Pt.Y + 1, Rect^.Right - Rect^.Left + Pt.X,
2282        R1.Bottom - R1.Top + Pt.Y, QtDC.BackgroundBrush.FHandle);
2283    end;
2284  end;
2285
2286  if Str <> nil then
2287  begin
2288    ALayout := QPainter_layoutDirection(QtDC.Widget);
2289    if Options and ETO_RTLREADING <> 0 then
2290      QPainter_setLayoutDirection(QtDC.Widget, QtRightToLeft);
2291    if Count >= 0 then
2292      WStr := {%H-}Copy(Str, 1, Count)
2293    else
2294      WStr := Str;
2295
2296    if (Options and ETO_CLIPPED <> 0) then
2297    begin
2298      QtDC.save;
2299      try
2300        QtDC.setClipRect(Rect^);
2301        if Dx <> nil then
2302          DoDrawCharByChar(True)
2303        else
2304          QtDC.drawText(X, Y, Rect^.Right - Rect^.Left, Rect^.Bottom - Rect^.Top,
2305            QtTextDontClip, @WStr);
2306      finally
2307        QtDC.Restore;
2308      end;
2309    end else
2310    begin
2311      if Dx <> nil then
2312        DoDrawCharByChar(False)
2313      else
2314        QtDC.drawText(X, Y, @WStr);
2315    end;
2316    if Options and ETO_RTLREADING <> 0 then
2317      QPainter_setLayoutDirection(QtDC.Widget, ALayout);
2318  end;
2319
2320  Result := True;
2321end;
2322
2323{------------------------------------------------------------------------------
2324  Function: FillRect
2325  Params:  none
2326  Returns: Nothing
2327
2328
2329 ------------------------------------------------------------------------------}
2330function TQtWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean;
2331begin
2332  Result := False;
2333
2334  {$ifdef VerboseQtWinAPI}
2335    DebugLn('[WinAPI FillRect Rect=', dbgs(Rect),' Brush=', dbghex(Brush));
2336  {$endif}
2337
2338  if not IsValidDC(DC) then
2339    exit;
2340  if not IsValidGdiObject(Brush) then
2341    exit;
2342
2343  TQtDeviceContext(DC).fillRect(@Rect, TQtBrush(Brush).FHandle);
2344  Result := True;
2345end;
2346
2347{------------------------------------------------------------------------------
2348  Function: FillRgn
2349  Params:  DC: HDC; RegionHnd: HRGN; hbr: HBRUSH
2350  Returns: Boolean
2351
2352 ------------------------------------------------------------------------------}
2353function TQtWidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool;
2354var
2355  OldRgn: TQtRegion;
2356  R: TRect;
2357  hasClipping: Boolean;
2358  QtDC: TQtDeviceContext;
2359  APath: QPainterPathH;
2360  APolyFH: QPolygonFH;
2361begin
2362  {$ifdef VerboseQtWinAPI}
2363    DebugLn('[WinAPI FillRgn Rgn=', dbgs(RegionHnd),' Brush=', dbghex(hbr));
2364  {$endif}
2365
2366  Result := False;
2367
2368  if not IsValidDC(DC) then exit;
2369
2370  QtDC := TQtDeviceContext(DC);
2371
2372  HasClipping := QtDC.getClipping;
2373  QtDC.save;
2374
2375  if HasClipping then
2376    OldRgn := TQtRegion.Create(True)
2377  else
2378    OldRgn := nil;
2379  try
2380    if HasClipping then
2381      QPainter_clipRegion(QtDC.Widget, OldRgn.FHandle);
2382
2383    if SelectClipRgn(DC, RegionHnd) <> ERROR then
2384    begin
2385      if TQtRegion(RegionHnd).IsPolyRegion then
2386      begin
2387        APath := QPainterPath_create();
2388        APolyFH := QPolygonF_create(TQtRegion(RegionHnd).Polygon);
2389        try
2390          QPainterPath_addPolygon(APath, APolyFH);
2391          QPainter_fillPath(QtDC.Widget, APath, TQtBrush(hbr).FHandle);
2392        finally
2393          QPainterPath_destroy(APath);
2394          QPolygonF_destroy(APolyFH);
2395        end;
2396      end else
2397      begin
2398        R := TQtRegion(RegionHnd).getBoundingRect;
2399        QtDC.fillRect(@R, TQtBrush(hbr).FHandle);
2400      end;
2401      if HasClipping then
2402        SelectClipRgn(DC, HRGN(OldRgn));
2403      Result := True;
2404    end;
2405  finally
2406    if HasClipping then
2407      OldRgn.Free;
2408    QtDC.restore;
2409  end;
2410end;
2411
2412{------------------------------------------------------------------------------
2413  Function: Frame3D
2414  Params:  none
2415  Returns: Nothing
2416
2417  Draws a 3d border in Qt native style.
2418 ------------------------------------------------------------------------------}
2419function TQtWidgetSet.Frame3d(DC: HDC; var ARect: TRect;
2420  const FrameWidth: integer; const Style: TBevelCut): Boolean;
2421var
2422  QtDC: TQtDeviceContext;
2423  AWidget: HWND;
2424  ATransparent: Boolean;
2425begin
2426  {$ifdef VerboseQtWinAPI}
2427    DebugLn('[TQtWidgetSet.Frame3d Rect=', dbgs(ARect));
2428  {$endif}
2429
2430  Result := False;
2431
2432  if not IsValidDC(DC) then exit;
2433
2434  QtDC := TQtDeviceContext(DC);
2435
2436  // issue #26491, draw opaque TCustomPanel if csOpaque is setted up in control style
2437  // otherwise use brush and painter backgroundmode settings.
2438  ATransparent := True;
2439  if (QtDC.Parent <> nil) and QObject_isWidgetType(QtDC.Parent) then
2440  begin
2441    AWidget := HwndFromWidgetH(QtDC.Parent);
2442    if (AWidget <> 0) and Assigned(TQtWidget(AWidget).LCLObject) then
2443    begin
2444      ATransparent := not (csOpaque in TQtWidget(AWidget).LCLObject.ControlStyle);
2445      // issue #26607
2446      if ATransparent and (TQtWidget(AWidget).LCLObject is TCustomPanel) and
2447        (TQtWidget(AWidget).LCLObject.Color <> clDefault) and
2448        not TCustomPanel(TQtWidget(AWidget).LCLObject).ParentColor then
2449          ATransparent := False;
2450    end;
2451  end;
2452
2453  case Style of
2454    bvNone: ;
2455    bvLowered: QtDC.qDrawWinPanel(ARect.Left, ARect.Top,
2456      ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, ATransparent, nil, True, FrameWidth);
2457    bvRaised: QtDC.qDrawWinPanel(ARect.Left, ARect.Top,
2458      ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, ATransparent, nil, False, FrameWidth);
2459    bvSpace: QtDC.qDrawPlainRect(ARect.Left, ARect.Top,
2460      ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, nil, FrameWidth);
2461  end;
2462
2463  InflateRect(ARect, -FrameWidth, -FrameWidth);
2464  Result := True;
2465end;
2466
2467{------------------------------------------------------------------------------
2468  Function: FrameRect
2469  Params:  none
2470  Returns: Nothing
2471 ------------------------------------------------------------------------------}
2472function TQtWidgetSet.FrameRect(DC: HDC; const ARect: TRect;
2473  hBr: HBRUSH): Integer;
2474var
2475  AColor: PQColor;
2476begin
2477  Result := 0;
2478
2479  if not IsValidDC(DC) then Exit;
2480
2481  if IsValidGDIObject(hBr) then
2482    AColor := TQtBrush(HBR).getColor
2483  else
2484    AColor := nil;
2485
2486  TQtDeviceContext(DC).qDrawPLainRect(ARect.Left, ARect.Top,
2487    ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, AColor);
2488  Result := 1;
2489end;
2490
2491function TQtWidgetSet.GetActiveWindow: HWND;
2492var
2493  Widget: QWidgetH;
2494  W: TQtWidget;
2495  SubW: TQtWidget;
2496  Area: QMdiAreaH;
2497begin
2498  Result := 0;
2499  Widget := QApplication_activeWindow;
2500  {return modal if activeWindow is nil issue #33409}
2501  if Widget = nil then
2502    Widget := QApplication_activeModalWidget;
2503  if Widget = nil then
2504    Widget := QApplication_activePopupWidget;
2505  if Assigned(Widget) then
2506  begin
2507    W := QtObjectFromWidgetH(Widget);
2508    if Assigned(W) and IsValidHandle(HWND(W)) then
2509    begin
2510      if (TQtWidget(W) is TQtMainWindow) and (TQtMainWindow(W).MDIAreaHandle <> nil) then
2511      begin
2512        Area := QMdiAreaH(TQtMainWindow(W).MDIAreaHandle.Widget);
2513        SubW := QtObjectFromWidgetH(QMdiArea_activeSubWindow(Area));
2514        if SubW <> nil then
2515          Result := HWND(SubW)
2516        else
2517          Result := HWND(W);
2518      end else
2519        Result := HWND(W);
2520    end;
2521  end;
2522end;
2523
2524
2525{------------------------------------------------------------------------------
2526  Method:  TQtWidgetSet.GetBitmapBits
2527  Params:  none
2528  Returns:
2529
2530 ------------------------------------------------------------------------------}
2531function TQtWidgetSet.GetBitmapBits(Bitmap: HBITMAP; Count: Longint;  Bits: Pointer): Longint;
2532var
2533  Image: QImageH;
2534begin
2535  {$ifdef VerboseQtWinAPI}
2536    WriteLn('[WinAPI GetBitmapBits]',' Bitmap=', dbghex(Bitmap),' Count=',Count);
2537  {$endif}
2538
2539  Result := 0;
2540
2541  if (Bitmap = 0) or (Count <= 0) then
2542    Exit;
2543
2544  Image := QImage_create(TQtImage(Bitmap).Handle);
2545  try
2546    Result := (QImage_width(Image) * QImage_height(Image) * QImage_depth(Image) + 7) div 8;
2547    if Count < Result then
2548      Result := Count;
2549    if Result > 0 then
2550      Move(QImage_bits(Image)^, Bits^, Result);
2551  finally
2552    QImage_destroy(Image);
2553  end;
2554end;
2555
2556function TQtWidgetSet.GetBkColor(DC: HDC): TColorRef;
2557var
2558  QtDC: TQtDeviceContext;
2559begin
2560  Result := CLR_INVALID;
2561  if not IsValidDC(DC) then Exit;
2562  QtDC := TQtDeviceContext(DC);
2563  Result := QtDC.GetBkColor;
2564end;
2565
2566function TQtWidgetSet.GetCapture: HWND;
2567var
2568  w: QWidgetH;
2569  Widget: TQtWidget;
2570  {$IFDEF MSWINDOWS}
2571  AWin: HWND;
2572  {$ENDIF}
2573begin
2574  {$IFDEF MSWINDOWS}
2575  AWin := Windows.GetCapture;
2576  if AWin <> 0 then
2577    w := QWidget_find(AWin)
2578  else
2579    w := nil;
2580
2581  if (w = nil) and (QApplication_mouseButtons() > 0) then
2582    w := QApplication_focusWidget()
2583  else
2584    if (w <> QWidget_mouseGrabber) and (QWidget_mouseGrabber <> nil) then
2585      w := QWidget_mouseGrabber;
2586
2587  {$ELSE}
2588  w := QWidget_mouseGrabber();
2589  {$ENDIF}
2590
2591  if w <> nil then
2592  begin
2593    // Capture widget can be child of complex control. In any case we should return TQtWidget as result.
2594    // So we will look for parent while not found apropriate LCL handle.
2595    Widget := GetFirstQtObjectFromWidgetH(w);
2596    {$IFDEF MSWINDOWS}
2597    if Widget <> nil then
2598    begin
2599      if Widget is TQtCustomControl then
2600        Widget := TQtCustomControl(Widget).Viewport;
2601    end;
2602    {$ENDIF}
2603    Result := HWND(Widget);
2604  end
2605  else
2606    Result := 0;
2607  {$ifdef VerboseQtWinAPI}
2608  WriteLn('[WinAPI GetCapture] Capture = ', Result);
2609  {$endif}
2610end;
2611
2612function TQtWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
2613begin
2614  Result := QtCaret.GetCaretPos(lpPoint);
2615end;
2616
2617function TQtWidgetSet.GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean;
2618begin
2619  ShowHideOnFocus := QtCaret.GetQtCaretRespondToFocus;
2620  Result := True;
2621end;
2622
2623{------------------------------------------------------------------------------
2624  Function: GetClientBounds
2625  Params: handle:
2626          Result:
2627  Returns: true on success
2628
2629  Returns the client bounds of a control. The client bounds is the rectangle of
2630  the inner area of a control, where the child controls are visible. The
2631  coordinates are relative to the control's left and top.
2632 ------------------------------------------------------------------------------}
2633function TQtWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
2634begin
2635  {$ifdef VerboseQtWinAPI}
2636    WriteLn('[WinAPI GetClientBounds]');
2637  {$endif}
2638  if Handle = 0 then
2639    Exit(False);
2640  ARect := TQtWidget(handle).getClientBounds;
2641  Result := True;
2642end;
2643
2644{------------------------------------------------------------------------------
2645  Function: GetClientRect
2646  Params: handle:
2647          Result:
2648  Returns: true on success
2649
2650  Returns the client bounds of a control. The client bounds is the rectangle of
2651  the inner area of a control, where the child controls are visible. The
2652  coordinates are relative to the control's left and top.
2653 ------------------------------------------------------------------------------}
2654function TQtWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
2655begin
2656  {$ifdef VerboseQtWinAPI}
2657    WriteLn('[WinAPI GetClientRect]');
2658  {$endif}
2659  if Handle = 0 then
2660    Exit(False);
2661  GetClientBounds(Handle, ARect);
2662  OffsetRect(ARect, -ARect.Left, -ARect.Top);
2663
2664  Result := True;
2665end;
2666
2667{------------------------------------------------------------------------------
2668  Function: GetClipBox
2669  Params: dc, lprect
2670  Returns: Integer
2671
2672  Returns the smallest rectangle which includes the entire current
2673  Clipping Region, or if no Clipping Region is set, the current
2674  dimensions of the Drawable.
2675
2676  The result can be one of the following constants
2677      Error
2678      NullRegion
2679      SimpleRegion
2680      ComplexRegion
2681 ------------------------------------------------------------------------------}
2682function TQtWidgetSet.GetClipBox(DC: hDC; lpRect: PRect): Longint;
2683var
2684  ARegion: QRegionH;
2685  Pt: TPoint;
2686begin
2687  Result := NULLREGION;
2688  if lpRect <> nil then
2689    lpRect^ := Rect(0,0,0,0);
2690
2691  if not IsValidDC(DC) then
2692    Result := ERROR;
2693
2694  if Result <> ERROR then
2695  with TQtDeviceContext(DC) do
2696  begin
2697    {$ifdef VerboseQtWinAPI}
2698      Writeln('TQtWidgetSet.GetClipBox FastClip=',
2699       ((vClipRect <> nil) and not vClipRectDirty) );
2700    {$endif}
2701
2702    // the most correct way to get a clipbox if through
2703    // region.boundingrect, but it's slower.
2704
2705    // TODO: remove "and false" below when vClipRectDirty is implemented
2706    //       it should be "true" when user set a custom clip rect
2707    //       and "false" on beginpaint
2708    if (vClipRect<>nil) and not vClipRectDirty and false then
2709      lpRect^ := vClipRect^
2710    else
2711    if getClipping then
2712    begin
2713      ARegion := QRegion_Create;
2714      try
2715        QPainter_clipRegion(Widget, ARegion);
2716        GetWindowOrgEx(DC, @Pt);
2717        if (Pt.X <> 0) or (Pt.Y <> 0) then
2718          SetWindowOrgEx(DC, Pt.X, Pt.Y, @Pt);
2719        QRegion_boundingRect(ARegion, lpRect);
2720      finally
2721        QRegion_destroy(ARegion);
2722      end;
2723      Result := SIMPLEREGION;
2724    end
2725    else
2726      if vImage <> nil then
2727      begin
2728        lpRect^ := Rect(0, 0, vImage.width, vImage.height);
2729        Result := SIMPLEREGION;
2730      end;
2731    {$ifdef VerboseQtWinAPI}
2732    WriteLn('TQtWidgetSet.GetClipBox Rect=', dbgs(lprect^));
2733    {$endif}
2734  end;
2735end;
2736
2737{------------------------------------------------------------------------------
2738  Function: GetClipRGN
2739  Params: dc, rgn
2740  Returns: Integer
2741
2742  Returns a copy of the current Clipping Region.
2743
2744  The result can be one of the following constants
2745     0 = no clipping set
2746     1 = ok
2747    -1 = error
2748 ------------------------------------------------------------------------------}
2749function TQtWidgetSet.GetClipRGN(DC : hDC; RGN : hRGN): Longint;
2750begin
2751  {$ifdef VerboseQtWinAPI}
2752    Writeln('Trace: [WinAPI GetClipRgn]',
2753     ' DC: ', dbghex(DC),
2754     ' RGN: ', dbghex(Rgn));
2755    if RGN<>0 then
2756      WriteLn(' QRegionH=', PtrInt(TQtRegion(Rgn).Widget))
2757    else
2758      WriteLn(' Rgn=0');
2759  {$endif}
2760  // it assumes that clipregion object has been created some other place
2761  Result := -1;
2762  if not IsValidDC(DC) then
2763    exit;
2764  if Rgn = 0 then
2765    exit;
2766  if not TQtDeviceContext(DC).getClipping then
2767    Result := 0
2768  else
2769  begin
2770    // if our TQtRegion contains widget then
2771    // first destroy it because QPainter creates
2772    // new reference.
2773    if TQtRegion(Rgn).FHandle <> nil then
2774    begin
2775      QRegion_destroy(TQtRegion(Rgn).FHandle);
2776      TQtRegion(Rgn).FHandle := QRegion_create;
2777    end;
2778    QPainter_clipRegion(TQtDeviceContext(DC).Widget, TQtRegion(Rgn).FHandle);
2779    Result := 1;
2780  end;
2781end;
2782
2783function TQtWidgetSet.GetCmdLineParamDescForInterface: string;
2784  function b(const s: string): string;
2785  begin
2786    Result:=BreakString(s,75,22)+LineEnding+LineEnding;
2787  end;
2788begin
2789  Result:=
2790     b(rsqtOptionNoGrab)
2791    +b(rsqtOptionDoGrab)
2792    +b(rsqtOptionSync)
2793    +b(rsqtOptionStyle)
2794    +b(rsqtOptionStyleSheet)
2795    +b(rsqtOptionGraphicsStyle)
2796    +b(rsqtOptionSession)
2797    +b(rsqtOptionWidgetCount)
2798    +b(rsqtOptionReverse)
2799    {$IFDEF HASX11}
2800    +b(rsqtOptionX11Display)
2801    +b(rsqtOptionX11Geometry)
2802    +b(rsqtOptionX11Font)
2803    +b(rsqtOptionX11BgColor)
2804    +b(rsqtOptionX11FgColor)
2805    +b(rsqtOptionX11BtnColor)
2806    +b(rsqtOptionX11Name)
2807    +b(rsqtOptionX11Title)
2808    +b(rsqtOptionX11Visual)
2809    +b(rsqtOptionX11NCols)
2810    +b(rsqtOptionX11CMap)
2811    +b(rsqtOptionX11IM)
2812    +b(rsqtOptionX11InputStyle)
2813    +b(rsqtOptionDisableAccurateFrame)
2814    {$ENDIF}
2815    ;
2816end;
2817
2818{------------------------------------------------------------------------------
2819  Method: GetCurrentObject
2820  Params:
2821    DC - A handle to the DC
2822    uObjectType - The object type to be queried
2823  Returns: If the function succeeds, the return value is a handle to the specified object.
2824    If the function fails, the return value is NULL.
2825 ------------------------------------------------------------------------------}
2826
2827function TQtWidgetSet.GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ;
2828var
2829  QtDC: TQtDeviceContext absolute DC;
2830begin
2831  Result := 0;
2832  if not QtWidgetSet.IsValidDC(DC) then
2833    Exit;
2834  case uObjectType of
2835    OBJ_BITMAP: Result := HGDIOBJ(QtDC.vImage);
2836    OBJ_BRUSH: Result := HGDIOBJ(QtDC.vBrush);
2837    OBJ_FONT: Result := HGDIOBJ(QtDC.vFont);
2838    OBJ_PEN: Result := HGDIOBJ(QtDC.vPen);
2839  end;
2840end;
2841
2842{------------------------------------------------------------------------------
2843  Function: GetCursorPos
2844  Params:  lpPoint: The cursorposition
2845  Returns: True if succesful
2846
2847 ------------------------------------------------------------------------------}
2848function TQtWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
2849var
2850  vPoint: TQtPoint;
2851begin
2852  QCursor_pos(@vPoint);
2853
2854  lpPoint.x := vPoint.x;
2855  lpPoint.y := vPoint.y;
2856
2857  Result := True;
2858end;
2859
2860{------------------------------------------------------------------------------
2861  Function: GetDC
2862  Params:  hWnd is any widget.
2863  Returns: Nothing
2864
2865  This function is Called:
2866  - Once on app startup with hWnd = 0
2867  - Twice for every TLabel on the TCustomLabel.CalcSize function
2868 ------------------------------------------------------------------------------}
2869function TQtWidgetSet.GetDC(hWnd: HWND): HDC;
2870var
2871  Widget: TQtWidget;
2872begin
2873  {$ifdef VerboseQtWinAPI}
2874    WriteLn('Trace:> [WinAPI GetDC] hWnd: ', dbghex(hWnd));
2875  {$endif}
2876
2877  if QtWidgetSet.IsValidHandle(hWnd) then
2878  begin
2879    Widget := TQtWidget(hWnd);
2880    Result := Widget.Context;
2881    if Result = 0 then
2882    begin
2883      {issue #28106}
2884      Result := HDC(TQtDeviceContext.Create(Widget.Widget, False));
2885      {can be destroyed via ReleaseDC()}
2886      TQtDeviceContext(Result).UserDC := True;
2887    end;
2888  end else
2889    Result := HDC(QtScreenContext);
2890
2891  {$ifdef VerboseQtWinAPI}
2892    WriteLn('Trace:< [WinAPI GetDC] Result: ', dbghex(Result));
2893  {$endif}
2894end;
2895
2896function TQtWidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC;
2897  WindowHandle: HWND; var OriginDiff: TPoint): boolean;
2898var
2899  QtDC: TQtDeviceContext absolute PaintDC;
2900  Matrix: QTransformH;
2901  P: TPoint;
2902begin
2903  {$ifdef VerboseQtWinAPI}
2904    WriteLn('[WinAPI GetDCOriginRelativeToWindow] PaintDC ' + dbghex(PaintDC));
2905  {$endif}
2906  Result := IsValidDC(PaintDC);
2907  if not Result then
2908    exit;
2909  Matrix := QPainter_transform(QtDC.Widget);
2910  OriginDiff := Point(0, 0);
2911  P := Point(0, 0);
2912  if WindowHandle <> 0 then
2913    P := TQtWidget(WindowHandle).getClientOffset;
2914  if Matrix <> nil then
2915  begin
2916    OriginDiff.X := Round(QTransform_Dx(Matrix)) - P.X;
2917    OriginDiff.Y := Round(QTransform_Dy(Matrix)) - P.Y;
2918  end;
2919end;
2920
2921{------------------------------------------------------------------------------
2922  Function: GetDeviceCaps
2923  Params: DC: HDC; Index: Integer
2924  Returns: Integer
2925
2926 ------------------------------------------------------------------------------}
2927function TQtWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
2928var
2929  QtDC: TQtDeviceContext;
2930  PaintDevice: QPaintDeviceH;
2931  PaintEngine: QPaintEngineH;
2932begin
2933  {$ifdef VerboseQtWinAPI}
2934    WriteLn('[WinAPI GetDeviceCaps] DC ' + dbghex(DC));
2935  {$endif}
2936
2937  Result := 0;
2938  if DC = 0 then
2939    DC := HDC(QtScreenContext);
2940
2941  if not IsValidDC(DC) then exit;
2942
2943  QtDC := TQtDeviceContext(DC);
2944
2945  PaintEngine := QtDC.PaintEngine;
2946  if PaintEngine = nil then
2947    exit;
2948  PaintDevice := QPaintEngine_paintDevice(PaintEngine);
2949
2950  case Index of
2951    HORZSIZE:
2952      Result := QPaintDevice_widthMM(PaintDevice);
2953    VERTSIZE:
2954      Result := QPaintDevice_heightMM(PaintDevice);
2955    HORZRES:
2956      Result := QPaintDevice_width(PaintDevice);
2957    BITSPIXEL:
2958      Result := QPaintDevice_depth(PaintDevice);
2959    PLANES:
2960      Result := 1;
2961    SIZEPALETTE:
2962      Result := QPaintDevice_numColors(PaintDevice);
2963    LOGPIXELSX:
2964      Result := QPaintDevice_logicalDpiX(PaintDevice);
2965    LOGPIXELSY:
2966      Result := QPaintDevice_logicalDpiY(PaintDevice);
2967    VERTRES:
2968      Result := QPaintDevice_height(PaintDevice);
2969    NUMRESERVED:
2970      Result := 0;
2971    else
2972      Result := 0;
2973  end;
2974end;
2975
2976function TQtWidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;
2977begin
2978  Result := 0;
2979  {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
2980    WriteLn('***** [WinAPI TQtWidgetSet.GetDIBits] missing implementation ');
2981  {$endif}
2982end;
2983
2984{------------------------------------------------------------------------------
2985  Function: GetDoubleClickTime
2986  Params: none
2987  Returns:
2988
2989 ------------------------------------------------------------------------------}
2990function TQtWidgetSet.GetDoubleClickTime: UINT;
2991begin
2992  Result := QApplication_doubleClickInterval;
2993end;
2994
2995{------------------------------------------------------------------------------
2996  Function: GetFocus
2997  Params:  None
2998  Returns: Nothing
2999
3000 ------------------------------------------------------------------------------}
3001function TQtWidgetSet.GetFocus: HWND;
3002var
3003  W: QWidgetH;
3004 {$ifdef VerboseFocus}
3005 Obj: TQtWidget;
3006 {$endif}
3007begin
3008  Result := 0;
3009  W := QApplication_FocusWidget();
3010  if W <> nil then
3011  begin
3012    Result := HwndFromWidgetH(W);
3013    if IsValidHandle(Result) then
3014    begin
3015      if TQtWidget(Result).getOwner <> nil then
3016        Result := HWND(TQtWidget(Result).getOwner);
3017    end;
3018    {$ifdef VerboseFocus}
3019    Obj := TQtWidget(Result);
3020    WriteLn('TQtWidgetSet.GetFocus: WidgetH=',dbghex(ptruint(W)), ' QtWidget=', dbgsname(Obj));
3021    if Obj<>nil then
3022      WriteLn(' LclObject=', dbgsname(Obj.LCLObject))
3023    else
3024      WriteLn;
3025    {$endif}
3026  end;
3027end;
3028
3029function TQtWidgetSet.GetKeyState(nVirtKey: Integer): Smallint;
3030const
3031  StateDown    = SmallInt($FF80);
3032  {StateToggled = SmallInt($0001);}
3033begin
3034  Result := 0;
3035
3036  {$IFDEF MSWINDOWS}
3037  if (nVirtKey = VK_CONTROL) or (nVirtKey = VK_MENU) or
3038    (nVirtKey = VK_LCONTROL) or (nVirtKey = VK_LMENU) then
3039  begin
3040    if (GetWinKeyState(VK_RMENU) < 0) and
3041      (GetWinKeyState(VK_LCONTROL) < 0) then
3042      exit;
3043  end;
3044  {$ENDIF}
3045
3046  case nVirtKey of
3047    VK_LSHIFT:   nVirtKey := VK_SHIFT;
3048    VK_LCONTROL: nVirtKey := VK_CONTROL;
3049    VK_LMENU:    nVirtKey := VK_MENU;
3050  end;
3051
3052  // where to track toggle state?
3053  case nVirtKey of
3054    VK_LBUTTON:
3055      if (QApplication_mouseButtons and QtLeftButton) > 0 then
3056        Result := Result or StateDown;
3057    VK_RBUTTON:
3058      if (QApplication_mouseButtons and QtRightButton) > 0 then
3059        Result := Result or StateDown;
3060    VK_MBUTTON:
3061      if (QApplication_mouseButtons and QtMidButton) > 0 then
3062        Result := Result or StateDown;
3063    VK_XBUTTON1:
3064      if (QApplication_mouseButtons and QtXButton1) > 0 then
3065        Result := Result or StateDown;
3066    VK_XBUTTON2:
3067      if (QApplication_mouseButtons and QtXButton2) > 0 then
3068        Result := Result or StateDown;
3069    VK_MENU:
3070      if (QApplication_keyboardModifiers and QtAltModifier) > 0 then
3071        Result := Result or StateDown;
3072    VK_SHIFT:
3073      if (QApplication_keyboardModifiers and QtShiftModifier) > 0 then
3074        Result := Result or StateDown;
3075    VK_CONTROL:
3076      if (QApplication_keyboardModifiers and QtControlModifier) > 0 then
3077        Result := Result or StateDown;
3078    VK_LWIN, VK_RWIN:
3079      if (QApplication_keyboardModifiers and QtMetaModifier) > 0 then
3080        Result := Result or StateDown;
3081    VK_LCL_CAPSLOCK, VK_NUMLOCK:
3082    begin
3083      {$IFDEF MSWINDOWS}
3084      Result := GetWinKeyState(nVirtKey);
3085      {$ELSE}
3086      {$IFDEF HASX11}
3087      if GetKeyLockState(nVirtKey) then
3088        Result := StateDown;
3089      {$ENDIF}
3090      {$ENDIF}
3091    end;
3092   {$ifdef VerboseQtWinAPI}
3093    else
3094      DebugLn('TQtWidgetSet.GetKeyState TODO ', DbgSVKCode(Word(nVirtkey)));
3095   {$endif}
3096  end;
3097end;
3098
3099function TQtWidgetSet.GetMapMode(DC: HDC): Integer;
3100begin
3101  if IsValidDC(DC) then
3102    Result := TQtDeviceContext(DC).vMapMode
3103  else
3104    Result := 0;
3105end;
3106
3107function TQtWidgetSet.GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
3108var
3109  Desktop: QDesktopWidgetH;
3110begin
3111  Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo)) or (Monitor = 0);
3112  if not Result then Exit;
3113  Desktop := QApplication_desktop();
3114  Dec(Monitor);
3115  // Note: Monitor is PtrUInt and is always >= 0.
3116  Result := Monitor < PtrUInt(QDesktopWidget_numScreens(Desktop));
3117  if not Result then Exit;
3118  QDesktopWidget_screenGeometry(Desktop, @lpmi^.rcMonitor, Monitor);
3119  QDesktopWidget_availableGeometry(Desktop, @lpmi^.rcWork, Monitor);
3120  if PtrUInt(QDesktopWidget_primaryScreen(Desktop)) = Monitor then
3121    lpmi^.dwFlags := MONITORINFOF_PRIMARY
3122  else
3123    lpmi^.dwFlags := 0;
3124end;
3125
3126{------------------------------------------------------------------------------
3127  Method:  TQtWidgetSet.GetDeviceSize
3128  Params:  none
3129  Returns: True if successful
3130
3131  Return the size of a device
3132 ------------------------------------------------------------------------------}
3133function TQtWidgetSet.GetDeviceSize(DC: HDC; var P: TPoint): Boolean;
3134begin
3135  {$ifdef VerboseQtWinAPI}
3136    WriteLn('[WinAPI GetDeviceSize]');
3137  {$endif}
3138
3139  Result := False;
3140
3141  P.X := 0;
3142  P.Y := 0;
3143
3144  if not IsValidDC(DC) then Exit;
3145
3146  if (TObject(DC) is TQtDeviceContext) then
3147    P := TQtDeviceContext(DC).getDeviceSize;
3148
3149  Result := True;
3150end;
3151
3152{------------------------------------------------------------------------------
3153  Method:  TQtWidgetSet.GetObject
3154  Params:  none
3155  Returns: The size written to the buffer
3156
3157  Necessary for TBitmap support
3158 ------------------------------------------------------------------------------}
3159function TQtWidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
3160const
3161  QtPenStyleToWinStyleMap: array[QtPenStyle] of UINT =
3162  (
3163 { QtNoPen          } PS_NULL,
3164 { QtSolidLine      } PS_SOLID,
3165 { QtDashLine       } PS_DASH,
3166 { QtDotLine        } PS_DOT,
3167 { QtDashDotLine    } PS_DASHDOT,
3168 { QtDashDotDotLine } PS_DASHDOTDOT,
3169 { QtCustomDashLine } PS_USERSTYLE
3170  );
3171var
3172  aObject: TObject;
3173  AFont: TQtFont absolute aObject;
3174  APen: TQtPen absolute aObject;
3175  ABrush: TQtBrush absolute aObject;
3176  BitmapSection : TDIBSECTION;
3177  ALogFont: PLogFont absolute Buf;
3178  ALogPen: PLogPen absolute Buf;
3179  AExtLogPen: PExtLogPen absolute Buf;
3180  ALogBrush: PLogBrush absolute Buf;
3181  Dashes: TQRealArray;
3182  i: integer;
3183  PaintDevice: QPaintDeviceH;
3184  {$ifdef VerboseQtWinAPI}
3185    ObjType: string;
3186  {$endif}
3187begin
3188  {$ifdef VerboseQtWinAPI}
3189    WriteLn('Trace:> [WinAPI GetObject] GDIObj: ' + dbghex(GDIObj));
3190    ObjType := '';
3191  {$endif}
3192
3193  Result := 0;
3194
3195  if not IsValidGDIObject(GDIObj) then
3196  begin
3197    {$ifdef VerboseQtWinAPI}
3198      WriteLn('Trace:< [WinAPI GetObject] Invalid GDI Object');
3199    {$endif}
3200
3201    Exit;
3202  end;
3203
3204  aObject := TObject(GDIObj);
3205
3206  {------------------------------------------------------------------------------
3207    Font
3208   ------------------------------------------------------------------------------}
3209  if aObject is TQtFont then
3210  begin
3211    if Buf = nil then
3212      Result := SizeOf(TLogFont)
3213    else
3214    if BufSize >= SizeOf(TLogFont) then
3215    begin
3216      Result := SizeOf(TLogFont);
3217
3218      FillChar(ALogFont^, SizeOf(ALogFont^), 0);
3219      if AFont.getPixelSize = -1 then
3220      begin
3221        PaintDevice := QWidget_to_QPaintDevice(QApplication_desktop);
3222        if PaintDevice <> nil then
3223          ALogFont^.lfHeight := MulDiv(AFont.getPointSize, QPaintDevice_logicalDpiX(PaintDevice), 72)
3224        else
3225          ALogFont^.lfHeight := AFont.getPointSize;
3226      end else
3227        ALogFont^.lfHeight := AFont.getPixelSize;
3228      ALogFont^.lfEscapement := AFont.Angle;
3229      case AFont.getWeight of
3230        10: ALogFont^.lfWeight := FW_THIN;
3231        15: ALogFont^.lfWeight := FW_EXTRALIGHT;
3232        25: ALogFont^.lfWeight := FW_LIGHT;
3233        50: ALogFont^.lfWeight := FW_NORMAL;
3234        55: ALogFont^.lfWeight := FW_MEDIUM;
3235        63: ALogFont^.lfWeight := FW_SEMIBOLD;
3236        75: ALogFont^.lfWeight := FW_BOLD;
3237        80: ALogFont^.lfWeight := FW_EXTRABOLD;
3238        87: ALogFont^.lfWeight := FW_HEAVY;
3239      end;
3240
3241      ALogFont^.lfItalic := Ord(AFont.getItalic) * High(Byte);
3242      ALogFont^.lfUnderline := Ord(AFont.getUnderline) * High(Byte);
3243      ALogFont^.lfStrikeOut := Ord(AFont.getStrikeOut) * High(Byte);
3244      ALogFont^.lfCharSet := DEFAULT_CHARSET;
3245      case AFont.getStyleStategy of
3246        QFontPreferMatch: ALogFont^.lfQuality := DRAFT_QUALITY;
3247        QFontPreferQuality: ALogFont^.lfQuality := PROOF_QUALITY;
3248        QFontNoAntialias: ALogFont^.lfQuality := NONANTIALIASED_QUALITY;
3249        QFontPreferAntialias: ALogFont^.lfQuality := ANTIALIASED_QUALITY;
3250      else
3251        ALogFont^.lfQuality := DEFAULT_QUALITY;
3252      end;
3253      ALogFont^.lfFaceName := AFont.getFamily;
3254    end;
3255  end
3256  {------------------------------------------------------------------------------
3257    Pen
3258   ------------------------------------------------------------------------------}
3259  else
3260  if aObject is TQtPen then
3261  begin
3262    if not APen.IsExtPen then
3263    begin
3264      if Buf = nil then
3265        Result := SizeOf(TLogPen)
3266      else
3267      if BufSize >= SizeOf(TLogPen) then
3268      begin
3269        Result := SizeOf(TLogPen);
3270        TQColorToColorRef(APen.getColor, ALogPen^.lopnColor);
3271        if APen.getCosmetic then
3272          ALogPen^.lopnWidth := Point(1, 0)
3273        else
3274          ALogPen^.lopnWidth := Point(APen.getWidth, 0);
3275        ALogPen^.lopnStyle := QtPenStyleToWinStyleMap[APen.getStyle];
3276      end;
3277    end
3278    else
3279    begin
3280      i := SizeOf(TExtLogPen);
3281      if APen.getStyle = QtCustomDashLine then
3282      begin
3283        Dashes := APen.getDashPattern;
3284        inc(i, (Length(Dashes) - 1) * SizeOf(DWord));
3285      end
3286      else
3287        Dashes := nil;
3288      if Buf = nil then
3289        Result := i
3290      else
3291      if BufSize >= i then
3292      begin
3293        Result := i;
3294        AExtLogPen^.elpPenStyle := QtPenStyleToWinStyleMap[APen.getStyle];
3295
3296        if not APen.getCosmetic then
3297        begin
3298          AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_GEOMETRIC;
3299
3300          case APen.getJoinStyle of
3301            QtMiterJoin: AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_MITER;
3302            QtBevelJoin: AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_BEVEL;
3303            QtRoundJoin: AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_ROUND;
3304          end;
3305
3306          case APen.getCapStyle of
3307            QtFlatCap: AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_FLAT;
3308            QtSquareCap: AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_SQUARE;
3309            QtRoundCap: AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_ROUND;
3310          end;
3311
3312          AExtLogPen^.elpWidth := APen.getWidth;
3313        end
3314        else
3315          AExtLogPen^.elpWidth := 1;
3316
3317        AExtLogPen^.elpBrushStyle := BS_SOLID;
3318        TQColorToColorRef(APen.getColor, AExtLogPen^.elpColor);
3319        AExtLogPen^.elpHatch := 0;
3320
3321        AExtLogPen^.elpNumEntries := Length(Dashes);
3322        if AExtLogPen^.elpNumEntries > 0 then
3323        begin
3324          for i := 0 to AExtLogPen^.elpNumEntries - 1 do
3325            PDword(@AExtLogPen^.elpStyleEntry)[i] := Trunc(Dashes[i]);
3326        end
3327        else
3328          AExtLogPen^.elpStyleEntry[0] := 0;
3329      end;
3330    end;
3331  end
3332  {------------------------------------------------------------------------------
3333    Region
3334   ------------------------------------------------------------------------------}
3335  else
3336  if aObject is TQtRegion then
3337  begin
3338    {TODO: implement Region}
3339    {$ifdef VerboseQtWinAPI}
3340      ObjType := 'Region';
3341    {$endif}
3342  end else
3343  {------------------------------------------------------------------------------
3344    Brush
3345   ------------------------------------------------------------------------------}
3346  if aObject is TQtBrush then
3347  begin
3348    if Buf = nil then
3349      Result := SizeOf(TLogBrush)
3350    else
3351    if BufSize >= SizeOf(TLogBrush) then
3352    begin
3353      Result := SizeOf(TLogBrush);
3354      TQColorToColorRef(ABrush.getColor^, ALogBrush^.lbColor);
3355      ABrush.GetLbStyle(ALogBrush^.lbStyle, ALogBrush^.lbHatch);
3356    end;
3357  end
3358  {------------------------------------------------------------------------------
3359    Image
3360   ------------------------------------------------------------------------------}
3361  else
3362  if aObject is TQtImage then
3363  begin
3364    {$ifdef VerboseQtWinAPI}
3365      ObjType := 'Image';
3366    {$endif}
3367
3368    if Buf = nil then
3369      Result := SizeOf(TDIBSECTION)
3370    else
3371    begin
3372      BitmapSection.dsOffset := 0;
3373      FillChar(BitmapSection, SizeOf(TDIBSECTION), 0);
3374
3375      with TQtImage(aObject) do
3376      begin
3377        {dsBM - BITMAP}
3378        BitmapSection.dsBm.bmType := $4D42;
3379        BitmapSection.dsBm.bmWidth := width;
3380        BitmapSection.dsBm.bmHeight := height;
3381        BitmapSection.dsBm.bmWidthBytes := bytesPerLine;
3382        BitmapSection.dsBm.bmPlanes := 1;//Does Bitmap Format support more?
3383        BitmapSection.dsBm.bmBitsPixel := depth;
3384        BitmapSection.dsBm.bmBits := bits;
3385
3386        {dsBmih - BITMAPINFOHEADER}
3387        BitmapSection.dsBmih.biSize := 40;
3388        BitmapSection.dsBmih.biWidth := BitmapSection.dsBm.bmWidth;
3389        BitmapSection.dsBmih.biHeight := BitmapSection.dsBm.bmHeight;
3390        BitmapSection.dsBmih.biPlanes := BitmapSection.dsBm.bmPlanes;
3391        BitmapSection.dsBmih.biBitCount := BitmapSection.dsBm.bmBitsPixel;
3392
3393        BitmapSection.dsBmih.biCompression := 0;
3394
3395        BitmapSection.dsBmih.biSizeImage := numBytes;
3396        BitmapSection.dsBmih.biXPelsPerMeter := dotsPerMeterX;
3397        BitmapSection.dsBmih.biYPelsPerMeter := dotsPerMeterY;
3398
3399        BitmapSection.dsBmih.biClrUsed := 0;
3400        BitmapSection.dsBmih.biClrImportant := 0;
3401      end;
3402
3403      if BufSize >= SizeOf(BitmapSection) then
3404      begin
3405        PDIBSECTION(Buf)^ := BitmapSection;
3406        Result := SizeOf(TDIBSECTION);
3407      end
3408      else if BufSize > 0 then
3409      begin
3410        Move(BitmapSection, Buf^, BufSize);
3411        Result := BufSize;
3412      end;
3413    end;
3414  end;
3415
3416  {$ifdef VerboseQtWinAPI}
3417    WriteLn('Trace:< [WinAPI GetObject] Result=', dbgs(Result), ' ObjectType=', ObjType);
3418  {$endif}
3419end;
3420
3421function TQtWidgetSet.GetParent(Handle : HWND): HWND;
3422var
3423  QtWidget: TQtWidget;
3424begin
3425  {$ifdef VerboseQtWinAPI}
3426  writeln('Trace:> [WinAPI GetParent] Handle: ' + dbghex(Handle));
3427  {$endif}
3428  Result := 0;
3429  if Handle = 0 then
3430    exit;
3431
3432  QtWidget := TQtWidget(Handle);
3433
3434  Result := HwndFromWidgetH(QtWidget.GetParent);
3435
3436  {$ifdef VerboseQtWinAPI}
3437  writeln('Trace:< [WinAPI GetParent] : ' + dbghex(Result));
3438  {$endif}
3439end;
3440
3441function TQtWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer;
3442begin
3443  if Handle<>0 then
3444    result := TQtWidget(Handle).Props[str]
3445  else
3446    result := nil;
3447end;
3448
3449function TQtWidgetSet.GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
3450var
3451  R: TRect;
3452begin
3453  {$ifdef VerboseQtWinAPI}
3454  writeln('Trace:> [WinAPI GetRgnBox] Handle: ' + dbghex(RGN));
3455  {$endif}
3456  Result := SIMPLEREGION;
3457  if lpRect <> nil then
3458    lpRect^ := Rect(0,0,0,0);
3459  if not IsValidGDIObject(RGN) then
3460    Result := ERROR
3461  else
3462  begin
3463    Result := TQtRegion(RGN).GetRegionType;
3464    if not (Result in [ERROR, NULLREGION]) and (lpRect <> nil) then
3465    begin
3466      R := TQtRegion(RGN).getBoundingRect;
3467      with lpRect^ do
3468      begin
3469        Left   := R.Left;
3470        Top    := R.Top;
3471        Right  := R.Left + R.Right;
3472        Bottom := R.Top + R.Bottom;
3473      end;
3474    end;
3475  end;
3476end;
3477
3478function TQtWidgetSet.GetROP2(DC: HDC): Integer;
3479var
3480  QtDC: TQtDeviceContext absolute DC;
3481begin
3482  {$ifdef VerboseQtWinAPI}
3483  writeln('> TQtWidgetSet.GetROP2() DC ',dbghex(DC));
3484  {$endif}
3485  Result := R2_COPYPEN;
3486  if not IsValidDC(DC) then
3487    exit;
3488  Result := QtDC.Rop2;
3489  {$ifdef VerboseQtWinAPI}
3490  writeln('< TQtWidgetSet.GetROP2() DC ',dbghex(DC),' Result ',Result);
3491  {$endif}
3492end;
3493
3494function TQtWidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
3495var
3496  w: TQtWidget;
3497  ScrollBar: TQtScrollBar;
3498  ASize: TSize;
3499begin
3500	{$ifdef VerboseQtWinAPI}
3501  writeln('Trace:> [WinAPI GetScrollBarSize] Handle: ' + dbghex(Handle),' BarKind: ',BarKind);
3502  {$endif}
3503  Result := 0;
3504  if Handle = 0 then exit;
3505
3506  w := TQtWidget(Handle);
3507
3508  {$IFDEF QTSCROLLABLEFORMS}
3509  if (w is TQtMainWindow) and Assigned(TQtMainWindow(w).ScrollArea) then
3510    w := TQtMainWindow(w).ScrollArea;
3511  {$ENDIF}
3512  if w is TQtAbstractScrollArea then
3513  begin
3514    if BarKind in [SB_VERT, SM_CXVSCROLL, SM_CYVSCROLL] then
3515      ScrollBar := TQtAbstractScrollArea(w).verticalScrollBar
3516    else
3517      ScrollBar := TQtAbstractScrollArea(w).horizontalScrollBar;
3518  end else
3519  if w is TQtScrollBar then
3520    ScrollBar := TQtScrollBar(w)
3521  else
3522    ScrollBar := nil;
3523  if ScrollBar <> nil then
3524  begin
3525    if ScrollBar.getOrientation = QtVertical then
3526    begin
3527      if not ScrollBar.testAttribute(QtWA_Mapped) then
3528      begin
3529        ScrollBar.sizeHint(@ASize);
3530        Result := ASize.cx;
3531      end else
3532        Result := ScrollBar.getWidth;
3533    end else
3534    begin
3535      if not ScrollBar.testAttribute(QtWA_Mapped) then
3536      begin
3537        ScrollBar.sizeHint(@ASize);
3538        Result := ASize.cy;
3539      end else
3540        Result := ScrollBar.getHeight;
3541    end;
3542  end;
3543end;
3544
3545function TQtWidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
3546var
3547  w: TQtWidget;
3548  ScrollBar: TQtScrollBar;
3549begin
3550	{$ifdef VerboseQtWinAPI}
3551  writeln('Trace:> [WinAPI GetScrollBarVisible] Handle: ' + dbghex(Handle),' SBStyle: ',SBStyle);
3552  {$endif}
3553  Result := False;
3554  if Handle = 0 then exit;
3555
3556  w := TQtWidget(Handle);
3557
3558  {TODO: find out what to do with TCustomForm descendants }
3559  {$IFDEF QTSCROLLABLEFORMS}
3560  if (w is TQtMainWindow) and Assigned(TQtMainWindow(w).ScrollArea) then
3561    w := TQtMainWindow(w).ScrollArea;
3562  {$ENDIF}
3563
3564  if w is TQtAbstractScrollArea then
3565  begin
3566    if SBStyle = SB_VERT then
3567      ScrollBar := TQtAbstractScrollArea(w).verticalScrollBar
3568    else
3569      ScrollBar := TQtAbstractScrollArea(w).horizontalScrollBar;
3570  end else
3571  if w is TQtScrollBar then
3572    ScrollBar := TQtScrollBar(w)
3573  else
3574    ScrollBar := nil;
3575
3576  if ScrollBar <> nil then
3577    Result := ScrollBar.getVisible;
3578end;
3579
3580{------------------------------------------------------------------------------
3581  Function: GetScrollInfo
3582  Params: BarFlag
3583           SB_CTL Retrieves the parameters for a scroll bar control. The hwnd
3584           parameter must be the handle to the scroll bar control.
3585           SB_HORZ Retrieves the parameters for the window's standard horizontal
3586           scroll bar.
3587           SB_VERT Retrieves the parameters for the window's standard vertical
3588           scroll bar.
3589
3590          ScrollInfo returns TScrollInfo structure.
3591
3592  Returns: boolean
3593
3594 ------------------------------------------------------------------------------}
3595function TQtWidgetSet.GetScrollInfo(Handle: HWND; BarFlag: Integer;
3596  Var ScrollInfo: TScrollInfo): Boolean;
3597var
3598  QtScrollBar: TQtScrollBar;
3599begin
3600  Result := False;
3601
3602  if Handle = 0 then exit;
3603
3604  if (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) or
3605   (csFreeNotification in TQtWidget(Handle).LCLObject.ComponentState) then
3606    exit;
3607
3608  QtScrollBar := nil;
3609
3610  if not TQtWidget(Handle).LCLObject.InheritsFrom(TCustomScrollBar) then
3611  begin
3612    {$IFDEF QTSCROLLABLEFORMS}
3613    if (TQtWidget(Handle) is TQtMainWindow) and Assigned(TQtMainWindow(Handle).ScrollArea) then
3614    begin
3615      case BarFlag of
3616        SB_HORZ: QtScrollBar := TQtMainWindow(Handle).ScrollArea.horizontalScrollBar;
3617        SB_VERT: QtScrollBar := TQtMainWindow(Handle).ScrollArea.verticalScrollBar;
3618      end;
3619    end else
3620    {$ENDIF}
3621    if (TQtWidget(Handle) is TQtAbstractScrollArea) then
3622    begin
3623      case BarFlag of
3624        SB_HORZ: QtScrollBar := TQtAbstractScrollArea(Handle).horizontalScrollBar;
3625        SB_VERT: QtScrollBar := TQtAbstractScrollArea(Handle).verticalScrollBar;
3626      end;
3627    end else
3628      Result := False;
3629  end
3630  else
3631    QtScrollBar := TQtScrollBar(TScrollBar(TQtWidget(Handle).LCLObject).Handle);
3632
3633  if Assigned(QtScrollBar) then
3634  begin
3635    // POS
3636    if (ScrollInfo.fMask and SIF_POS) <> 0 then
3637    begin
3638      // if QtScrollBar.ChildOfComplexWidget = ccwAbstractScrollArea then
3639      if QtScrollBar.SliderPressed then
3640        ScrollInfo.nPos := QtScrollBar.getSliderPosition
3641      else
3642        ScrollInfo.nPos := QtScrollBar.getValue;
3643    end;
3644
3645    // RANGE
3646    if (ScrollInfo.fMask and SIF_RANGE) <> 0 then
3647    begin
3648      ScrollInfo.nMin:= QtScrollBar.getMin;
3649      ScrollInfo.nMax:= QtScrollBar.getMax + QtScrollBar.getPageStep;
3650    end;
3651    // PAGE
3652    if (ScrollInfo.fMask and SIF_PAGE) <> 0 then
3653      ScrollInfo.nPage := QtScrollBar.getPageStep;
3654
3655    // TRACKPOS
3656    if (ScrollInfo.fMask and SIF_TRACKPOS) <> 0 then
3657      ScrollInfo.nTrackPos := QtScrollBar.getSliderPosition;
3658
3659    Result := True;
3660  end;
3661end;
3662
3663function TQtWidgetSet.GetStockObject(Value: Integer): THandle;
3664begin
3665  {$ifdef VerboseQtWinAPI}
3666    WriteLn('Trace:> [WinAPI GetStockObject] Value: ', Value);
3667  {$endif}
3668
3669  Result := 0;
3670
3671  case Value of
3672    BLACK_BRUSH:         // Black brush.
3673      Result := FStockBlackBrush;
3674    DKGRAY_BRUSH:        // Dark gray brush.
3675      Result := FStockDKGrayBrush;
3676    GRAY_BRUSH:          // Gray brush.
3677      Result := FStockGrayBrush;
3678    LTGRAY_BRUSH:        // Light gray brush.
3679      Result := FStockLtGrayBrush;
3680    NULL_BRUSH:          // Null brush (equivalent to HOLLOW_BRUSH).
3681      Result := FStockNullBrush;
3682    WHITE_BRUSH:         // White brush.
3683      Result := FStockWhiteBrush;
3684
3685    BLACK_PEN:           // Black pen.
3686      Result := FStockBlackPen;
3687    NULL_PEN:            // Null pen.
3688      Result := FStockNullPen;
3689    WHITE_PEN:           // White pen.
3690      Result := FStockWhitePen;
3691
3692    {System font. By default, Windows uses the system font to draw menus,
3693     dialog box controls, and text. In Windows versions 3.0 and later,
3694     the system font is a proportionally spaced font; earlier versions of
3695     Windows used a monospace system font.}
3696    DEFAULT_GUI_FONT, SYSTEM_FONT:
3697      begin
3698
3699        If FStockSystemFont <> 0 then
3700        begin
3701          DeleteObject(FStockSystemFont);
3702          FStockSystemFont := 0;
3703        end;
3704
3705        If FStockSystemFont = 0 then
3706          FStockSystemFont := CreateDefaultFont;
3707        Result := FStockSystemFont;
3708      end;
3709
3710  {$ifdef VerboseQtWinAPI}
3711    else
3712    WriteLn('[WinAPI GetStockObject] UNHANDLED Value: ', Value);
3713  {$endif}
3714  end;
3715  {$ifdef VerboseQtWinAPI}
3716    WriteLn('Trace:< [WinAPI GetStockObject] Value: ', Value);
3717  {$endif}
3718end;
3719
3720{------------------------------------------------------------------------------
3721  Function: TQtWidgetSet.GetSysColor
3722  Params:   index to the syscolors array
3723  Returns:  RGB value
3724
3725 ------------------------------------------------------------------------------}
3726function TQtWidgetSet.GetSysColor(nIndex: Integer): DWORD;
3727
3728  function GetColor(Group: QPaletteColorGroup; Role: QPaletteColorRole; ClassName: PAnsiChar = nil): TColor;
3729  var
3730    Handle: QPaletteH;
3731    QColor: PQColor;
3732    QC: QColorH;
3733  begin
3734    Handle := QPalette_create;
3735    if ClassName = nil then
3736      QApplication_palette(Handle)
3737    else
3738      QApplication_palette(Handle, ClassName);
3739
3740    QColor := QPalette_color(Handle, Group, Role);
3741    QC := QColor_create(QColor);
3742    try
3743      Result := (QColor_red(QC) and $00FF) or ((QColor_green(QC) and $00FF) shl 8) or ((QColor_blue(QC) and $00FF) shl 16);
3744    finally
3745      QColor_destroy(QC);
3746    end;
3747
3748    QPalette_destroy(Handle);
3749  end;
3750
3751begin
3752  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then
3753  begin
3754    {$ifdef VerboseQtWinAPI}
3755      WriteLn('Trace:Unknown lcl system color: [TQtWidgetSet.GetSysColor]');
3756    {$endif}
3757    Result := 0;
3758    Exit;
3759  end;
3760
3761  if FCachedColors[nIndex] = nil then
3762  begin
3763    case nIndex of
3764      COLOR_SCROLLBAR               : Result:=GetColor(QPaletteActive,   QPaletteButton);
3765      COLOR_BACKGROUND              : Result:=GetColor(QPaletteActive,   QPaletteWindow);
3766      COLOR_WINDOW                  : Result:=GetColor(QPaletteInActive, QPaletteBase);
3767      COLOR_WINDOWFRAME             : Result:=GetColor(QPaletteActive,   QPaletteShadow);
3768      COLOR_WINDOWTEXT              : Result:=GetColor(QPaletteActive,   QPaletteWindowText);
3769      COLOR_ACTIVEBORDER            : Result:=GetColor(QPaletteActive,   QPaletteWindow);
3770      COLOR_INACTIVEBORDER          : Result:=GetColor(QPaletteInactive, QPaletteWindow);
3771      COLOR_APPWORKSPACE            : Result:=GetColor(QPaletteActive,   QPaletteWindow);
3772      COLOR_HIGHLIGHT               : Result:=GetColor(QPaletteActive,   QPaletteHighlight);
3773      COLOR_HIGHLIGHTTEXT           : Result:=GetColor(QPaletteActive,   QPaletteHighlightedText);
3774      COLOR_BTNFACE                 : Result:=GetColor(QPaletteActive,   QPaletteButton);
3775      COLOR_BTNSHADOW               : Result:=GetColor(QPaletteActive,   QPaletteDark);
3776      COLOR_GRAYTEXT                : Result:=GetColor(QPaletteDisabled,   QPaletteText);
3777      COLOR_BTNTEXT                 : Result:=GetColor(QPaletteActive,   QPaletteButtonText);
3778      COLOR_BTNHIGHLIGHT            : Result:=GetColor(QPaletteActive,   QPaletteLight);
3779      COLOR_3DDKSHADOW              : Result:=GetColor(QPaletteActive,   QPaletteShadow);
3780      COLOR_3DLIGHT                 : Result:=GetColor(QPaletteActive,   QPaletteMidlight);
3781      COLOR_INFOTEXT                : Result:=GetColor(QPaletteInActive, QPaletteToolTipText);
3782      COLOR_INFOBK                  : Result:=GetColor(QPaletteInActive, QPaletteToolTipBase);
3783      COLOR_HOTLIGHT                : Result:=GetColor(QPaletteActive,   QPaletteLight);
3784
3785      // qt does not provide any methods to retrieve titlebar colors
3786    {$IFNDEF MSWINDOWS}
3787      COLOR_ACTIVECAPTION           : Result:=GetColor(QPaletteActive,   QPaletteHighlight);
3788      COLOR_INACTIVECAPTION         : Result:=GetColor(QPaletteInActive, QPaletteHighlight);
3789      COLOR_CAPTIONTEXT             : Result:=GetColor(QPaletteActive,   QPaletteHighlightedText);
3790      COLOR_INACTIVECAPTIONTEXT     : Result:=GetColor(QPaletteInactive, QPaletteHighlightedText);
3791      COLOR_GRADIENTACTIVECAPTION   : Result:=GetColor(QPaletteActive,   QPaletteBase);
3792      COLOR_GRADIENTINACTIVECAPTION : Result:=GetColor(QPaletteInactive, QPaletteBase);
3793    {$ELSE}
3794      COLOR_ACTIVECAPTION           : Result:=Windows.GetSysColor(COLOR_ACTIVECAPTION);
3795      COLOR_INACTIVECAPTION         : Result:=Windows.GetSysColor(COLOR_INACTIVECAPTION);
3796      COLOR_CAPTIONTEXT             : Result:=Windows.GetSysColor(COLOR_CAPTIONTEXT);
3797      COLOR_INACTIVECAPTIONTEXT     : Result:=Windows.GetSysColor(COLOR_INACTIVECAPTIONTEXT);
3798      COLOR_GRADIENTACTIVECAPTION   : Result:=Windows.GetSysColor(COLOR_GRADIENTACTIVECAPTION);
3799      COLOR_GRADIENTINACTIVECAPTION : Result:=Windows.GetSysColor(COLOR_GRADIENTINACTIVECAPTION);
3800    {$ENDIF}
3801      COLOR_MENU                    : Result:=GetColor(QPaletteActive,   QPaletteButton, 'QMenu');
3802      COLOR_MENUTEXT                : Result:=GetColor(QPaletteActive,   QPaletteButtonText, 'QMenu');
3803      COLOR_MENUHILIGHT             : Result:=GetColor(QPaletteDisabled, QPaletteHighlight, 'QMenu');
3804      COLOR_MENUBAR                 : Result:=GetColor(QPaletteActive,   QPaletteButton, 'QMenu');
3805      COLOR_FORM                    : Result:=GetColor(QPaletteActive,   QPaletteWindow);
3806    else
3807      Result:=0;
3808    end;
3809    FCachedColors[nIndex] := getMem(SizeOf(LongWord));
3810    FCachedColors[nIndex]^ := Result;
3811  end
3812  else
3813    Result := FCachedColors[nIndex]^;
3814end;
3815
3816function TQtWidgetSet.GetSysColorBrush(nIndex: Integer): HBrush;
3817
3818  function GetBrush(Group: QPaletteColorGroup; Role: QPaletteColorRole; ClassName: PAnsiChar = nil): HBrush;
3819  var
3820    Handle: QPaletteH;
3821  begin
3822    Handle := QPalette_create;
3823    if ClassName = nil then
3824      QApplication_palette(Handle)
3825    else
3826      QApplication_palette(Handle, ClassName);
3827    if FSysColorBrushes[nIndex] = 0 then
3828      Result := HBrush(TQtBrush.Create(False))
3829    else
3830      Result := FSysColorBrushes[nIndex];
3831    TQtBrush(Result).FHandle := QBrush_create(QPalette_brush(Handle, Group, Role));
3832    TQtBrush(Result).FShared := True;
3833
3834    QPalette_destroy(Handle);
3835  end;
3836
3837  function GetSolidBrush(AColor: TColor): HBrush;
3838  var
3839    Color: TQColor;
3840  begin
3841    if FSysColorBrushes[nIndex] = 0 then
3842      Result := HBrush(TQtBrush.Create(True))
3843    else
3844      Result := FSysColorBrushes[nIndex];
3845    Color := QBrush_Color(TQtBrush(Result).FHandle)^;
3846    ColorRefToTQColor(ColorToRGB(AColor), Color);
3847    QBrush_setColor(TQtBrush(Result).FHandle, @Color);
3848    TQtBrush(Result).FShared := True;
3849  end;
3850
3851begin
3852  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then
3853  begin
3854    Result := 0;
3855    Exit;
3856  end;
3857
3858  if (FSysColorBrushes[nIndex] = 0) or
3859    (
3860    (FSysColorBrushes[nIndex] <> 0) and
3861    (TQtBrush(FSysColorBrushes[nIndex]).FHandle = nil)
3862    ) then
3863  begin
3864    case nIndex of
3865      COLOR_SCROLLBAR               : Result:=GetBrush(QPaletteActive,   QPaletteButton);
3866      COLOR_BACKGROUND              : Result:=GetBrush(QPaletteActive,   QPaletteWindow);
3867      COLOR_WINDOW                  : Result:=GetBrush(QPaletteInActive, QPaletteBase);
3868      COLOR_WINDOWFRAME             : Result:=GetBrush(QPaletteActive,   QPaletteShadow);
3869      COLOR_WINDOWTEXT              : Result:=GetBrush(QPaletteActive,   QPaletteWindowText);
3870      COLOR_ACTIVEBORDER            : Result:=GetBrush(QPaletteActive,   QPaletteWindow);
3871      COLOR_INACTIVEBORDER          : Result:=GetBrush(QPaletteInactive, QPaletteWindow);
3872      COLOR_APPWORKSPACE            : Result:=GetBrush(QPaletteActive,   QPaletteWindow);
3873      COLOR_HIGHLIGHT               : Result:=GetBrush(QPaletteActive,   QPaletteHighlight);
3874      COLOR_HIGHLIGHTTEXT           : Result:=GetBrush(QPaletteActive,   QPaletteHighlightedText);
3875      COLOR_BTNFACE                 : Result:=GetBrush(QPaletteActive,   QPaletteButton);
3876      COLOR_BTNSHADOW               : Result:=GetBrush(QPaletteActive,   QPaletteDark);
3877      COLOR_GRAYTEXT                : Result:=GetBrush(QPaletteActive,   QPaletteText);
3878      COLOR_BTNTEXT                 : Result:=GetBrush(QPaletteActive,   QPaletteButtonText);
3879      COLOR_BTNHIGHLIGHT            : Result:=GetBrush(QPaletteActive,   QPaletteLight);
3880      COLOR_3DDKSHADOW              : Result:=GetBrush(QPaletteActive,   QPaletteShadow);
3881      COLOR_3DLIGHT                 : Result:=GetBrush(QPaletteActive,   QPaletteMidlight);
3882      COLOR_INFOTEXT                : Result:=GetBrush(QPaletteInActive, QPaletteToolTipText);
3883      COLOR_INFOBK                  : Result:=GetBrush(QPaletteInActive, QPaletteToolTipBase);
3884      COLOR_HOTLIGHT                : Result:=GetBrush(QPaletteActive,   QPaletteLight);
3885
3886      // qt does not provide any methods to retrieve titlebar colors
3887    {$IFNDEF MSWINDOWS}
3888      COLOR_ACTIVECAPTION           : Result:=GetBrush(QPaletteActive,   QPaletteHighlight);
3889      COLOR_INACTIVECAPTION         : Result:=GetBrush(QPaletteInActive, QPaletteHighlight);
3890      COLOR_CAPTIONTEXT             : Result:=GetBrush(QPaletteActive,   QPaletteHighlightedText);
3891      COLOR_INACTIVECAPTIONTEXT     : Result:=GetBrush(QPaletteInactive, QPaletteHighlightedText);
3892      COLOR_GRADIENTACTIVECAPTION   : Result:=GetBrush(QPaletteActive,   QPaletteBase);
3893      COLOR_GRADIENTINACTIVECAPTION : Result:=GetBrush(QPaletteInactive, QPaletteBase);
3894    {$ELSE}
3895      COLOR_ACTIVECAPTION           : Result:=GetSolidBrush(Windows.GetSysColor(COLOR_ACTIVECAPTION));
3896      COLOR_INACTIVECAPTION         : Result:=GetSolidBrush(Windows.GetSysColor(COLOR_INACTIVECAPTION));
3897      COLOR_CAPTIONTEXT             : Result:=GetSolidBrush(Windows.GetSysColor(COLOR_CAPTIONTEXT));
3898      COLOR_INACTIVECAPTIONTEXT     : Result:=GetSolidBrush(Windows.GetSysColor(COLOR_INACTIVECAPTIONTEXT));
3899      COLOR_GRADIENTACTIVECAPTION   : Result:=GetSolidBrush(Windows.GetSysColor(COLOR_GRADIENTACTIVECAPTION));
3900      COLOR_GRADIENTINACTIVECAPTION : Result:=GetSolidBrush(Windows.GetSysColor(COLOR_GRADIENTINACTIVECAPTION));
3901    {$ENDIF}
3902      COLOR_MENU                    : Result:=GetBrush(QPaletteActive,   QPaletteButton, 'QMenu');
3903      COLOR_MENUTEXT                : Result:=GetBrush(QPaletteActive,   QPaletteButtonText, 'QMenu');
3904      COLOR_MENUHILIGHT             : Result:=GetBrush(QPaletteDisabled, QPaletteHighlight, 'QMenu');
3905      COLOR_MENUBAR                 : Result:=GetBrush(QPaletteActive,   QPaletteButton, 'QMenu');
3906      COLOR_FORM                    : Result:=GetBrush(QPaletteActive,   QPaletteWindow);
3907    else
3908      Result:=0;
3909    end;
3910    FSysColorBrushes[nIndex] := Result;
3911  end
3912  else
3913    Result := FSysColorBrushes[nIndex];
3914end;
3915
3916{------------------------------------------------------------------------------
3917  Function: GetSystemMetrics
3918  Params:
3919  Returns: Nothing
3920
3921
3922 ------------------------------------------------------------------------------}
3923function TQtWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
3924var
3925  R: TRect;
3926begin
3927  {$ifdef VerboseQtWinAPI}
3928    WriteLn(Format('Trace:> [TQtWidgetSet.GetSystemMetrics] %d', [nIndex]));
3929  {$endif}
3930  Result := 0;
3931  case nIndex of
3932    SM_ARRANGE:
3933      begin
3934        {$ifdef VerboseQtWinAPI}
3935          WriteLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_ARRANGE          ');
3936        {$endif}
3937      end;
3938    SM_CLEANBOOT:
3939      begin
3940        {$ifdef VerboseQtWinAPI}
3941          WriteLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CLEANBOOT          ');
3942        {$endif}
3943      end;
3944    SM_CMONITORS:
3945      Result := QDesktopWidget_numScreens(QApplication_desktop());
3946    SM_CMOUSEBUTTONS:
3947      begin
3948        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CMOUSEBUTTONS    ');
3949      end;
3950    SM_CXBORDER, SM_CYBORDER:
3951      begin
3952        //The height of a window border, in pixels
3953        Result := GetPixelMetric(QStylePM_DefaultFrameWidth, nil, nil);
3954      end;
3955    SM_CXCURSOR:
3956      begin
3957        Result := 32; // recomended in docs
3958      end;
3959    SM_CYCURSOR:
3960      begin
3961        Result := 32; // recomended in docs
3962      end;
3963    SM_CXDOUBLECLK:
3964      begin
3965        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXDOUBLECLK      ');
3966      end;
3967    SM_CYDOUBLECLK:
3968      begin
3969        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYDOUBLECLK      ');
3970      end;
3971    SM_CXDRAG,
3972    SM_CYDRAG: QApplication_startDragDistance();
3973    SM_CXEDGE:
3974      begin
3975        Result := 2;
3976      end;
3977    SM_CYEDGE:
3978      begin
3979        Result := 2;
3980      end;
3981    SM_CXFIXEDFRAME:
3982      begin
3983        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXFIXEDFRAME     ');
3984      end;
3985    SM_CYFIXEDFRAME:
3986      begin
3987        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYFIXEDFRAME     ');
3988      end;
3989    SM_CXHTHUMB,
3990    SM_CYVTHUMB:
3991      begin
3992        Result := GetPixelMetric(QStylePM_ScrollBarSliderMin, nil, nil);
3993      end;
3994    SM_CXICON,
3995    SM_CYICON:
3996      begin
3997        Result := 32;
3998      end;
3999    SM_CXICONSPACING:
4000      begin
4001        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXICONSPACING    ');
4002      end;
4003    SM_CYICONSPACING:
4004      begin
4005        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYICONSPACING    ');
4006      end;
4007    SM_CXMAXIMIZED:
4008      begin
4009        QDesktopWidget_availableGeometry(QApplication_desktop(), @R,
4010          QDesktopWidget_primaryScreen(QApplication_desktop()));
4011        Result := R.Right - R.Left;
4012      end;
4013    SM_CYMAXIMIZED:
4014      begin
4015        QDesktopWidget_availableGeometry(QApplication_desktop(), @R,
4016          QDesktopWidget_primaryScreen(QApplication_desktop()));
4017        Result := R.Bottom - R.Top;
4018      end;
4019    SM_CXMAXTRACK:
4020      begin
4021        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXMAXTRACK       ');
4022      end;
4023    SM_CYMAXTRACK:
4024      begin
4025        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYMAXTRACK       ');
4026      end;
4027    SM_CXMENUCHECK:
4028      begin
4029        Result := GetPixelMetric(QStylePM_IndicatorWidth, nil, nil);
4030      end;
4031    SM_CYMENUCHECK:
4032      begin
4033        Result := GetPixelMetric(QStylePM_IndicatorHeight, nil, nil);
4034      end;
4035    SM_CXMENUSIZE,
4036    SM_CYMENUSIZE:
4037      begin
4038        Result := GetPixelMetric(QStylePM_TitleBarHeight, nil, nil) -
4039          (GetPixelMetric(QStylePM_DefaultFrameWidth, nil, nil) * 2);
4040      end;
4041    SM_CXMIN,
4042    SM_CYMIN: Result := 0;
4043    SM_CXMINIMIZED:
4044      begin
4045        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXMINIMIZED      ');
4046      end;
4047    SM_CYMINIMIZED:
4048      begin
4049        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYMINIMIZED      ');
4050      end;
4051    SM_CXMINSPACING:
4052      begin
4053        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXMINSPACING     ');
4054      end;
4055    SM_CYMINSPACING:
4056      begin
4057        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYMINSPACING     ');
4058      end;
4059    SM_CXMINTRACK:
4060      begin
4061        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXMINTRACK       ');
4062      end;
4063    SM_CYMINTRACK:
4064      begin
4065        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYMINTRACK       ');
4066      end;
4067    SM_CXFULLSCREEN,
4068    SM_CXSCREEN:
4069      begin
4070        QDesktopWidget_screenGeometry(QApplication_desktop(), @R, QDesktopWidget_primaryScreen(QApplication_desktop()));
4071        Result := R.Right - R.Left;
4072      end;
4073    SM_CYFULLSCREEN,
4074    SM_CYSCREEN:
4075      begin
4076        QDesktopWidget_screenGeometry(QApplication_desktop(), @R, QDesktopWidget_primaryScreen(QApplication_desktop()));
4077        Result := R.Bottom - R.Top;
4078      end;
4079    SM_CXSIZE:
4080      begin
4081        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXSIZE           ');
4082      end;
4083    SM_CYSIZE:
4084      begin
4085        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYSIZE           ');
4086      end;
4087    SM_CXSIZEFRAME,
4088    SM_CYSIZEFRAME:
4089      begin
4090        Result := GetPixelMetric(QStylePM_MDIFrameWidth, nil, nil);
4091      end;
4092    SM_CXSMICON,
4093    SM_CYSMICON:
4094      begin
4095        Result := GetPixelMetric(QStylePM_SmallIconSize, nil, nil);
4096      end;
4097    SM_CXSMSIZE:
4098      begin
4099        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CXSMSIZE         ');
4100      end;
4101    SM_CYSMSIZE:
4102      begin
4103        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYSMSIZE         ');
4104      end;
4105    SM_XVIRTUALSCREEN:
4106      begin
4107        Result := QWidget_x(QApplication_desktop);
4108      end;
4109    SM_YVIRTUALSCREEN:
4110      begin
4111        Result := QWidget_y(QApplication_desktop);
4112      end;
4113    SM_CXVIRTUALSCREEN:
4114      begin
4115        Result := QWidget_width(QApplication_desktop);
4116      end;
4117    SM_CYVIRTUALSCREEN:
4118      begin
4119        Result := QWidget_height(QApplication_desktop);
4120      end;
4121    SM_CXVSCROLL,
4122    SM_CYVSCROLL,
4123    SM_CXHSCROLL,
4124    SM_CYHSCROLL:
4125      begin
4126        Result := GetPixelMetric(QStylePM_ScrollBarExtent, nil, nil);
4127      end;
4128    SM_CYCAPTION:
4129      begin
4130        Result := GetPixelMetric(QStylePM_TitleBarHeight, nil, nil);
4131      end;
4132    SM_CYKANJIWINDOW:
4133      begin
4134        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYKANJIWINDOW    ');
4135      end;
4136    SM_CYMENU:
4137      begin
4138        Result := GetMenuHeight;
4139      end;
4140    SM_CYSMCAPTION:
4141      begin
4142        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_CYSMCAPTION      ');
4143      end;
4144    SM_DBCSENABLED:
4145      begin
4146        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_DBCSENABLED      ');
4147      end;
4148    SM_DEBUG:
4149      begin
4150        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_DEBUG            ');
4151      end;
4152    SM_MENUDROPALIGNMENT:
4153      begin
4154        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_MENUDROPALIGNMENT');
4155      end;
4156    SM_MIDEASTENABLED:
4157      begin
4158        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_MIDEASTENABLED   ');
4159      end;
4160    SM_MOUSEPRESENT:
4161      begin
4162        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_MOUSEPRESENT     ');
4163      end;
4164    SM_MOUSEWHEELPRESENT:
4165      begin
4166        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_MOUSEWHEELPRESENT');
4167      end;
4168    SM_NETWORK:
4169      begin
4170        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_NETWORK          ');
4171      end;
4172    SM_PENWINDOWS:
4173      begin
4174        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_PENWINDOWS       ');
4175      end;
4176    SM_SECURE:
4177      begin
4178        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_SECURE           ');
4179      end;
4180    SM_SHOWSOUNDS:
4181      begin
4182        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_SHOWSOUNDS       ');
4183      end;
4184    SM_SLOWMACHINE:
4185      begin
4186        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_SLOWMACHINE      ');
4187      end;
4188    SM_SWAPBUTTON:
4189      begin
4190        //DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_SWAPBUTTON       ');
4191      end;
4192    SM_SWSCROLLBARSPACING:
4193      begin
4194        Result := 0;
4195        if (QStyle_styleHint(QApplication_style(),
4196          QStyleSH_ScrollView_FrameOnlyAroundContents) <> 0) then
4197        Result := QStyle_pixelMetric(QApplication_style(),
4198          QStylePM_ScrollView_ScrollBarSpacing, nil, nil);
4199      end;
4200    SM_LCLMAXIMIZEDWIDTH:
4201      begin
4202        Result := GetSystemMetrics(SM_CXMAXIMIZED);
4203      end;
4204    SM_LCLMAXIMIZEDHEIGHT:
4205      begin
4206        Result := GetSystemMetrics(SM_CYMAXIMIZED) - 1 -
4207          (GetSystemMetrics(SM_CYCAPTION) - (GetSystemMetrics(SM_CYSIZEFRAME) * 2));
4208      end;
4209    SM_LCLHasFormAlphaBlend:
4210      Result := 1;
4211  end;
4212end;
4213
4214{------------------------------------------------------------------------------
4215  Function: GetTextColor
4216  Params:  DC     - A device context
4217  Returns: TColorRef
4218
4219  Gets the Font Color currently assigned to the Device Context
4220 ------------------------------------------------------------------------------}
4221function TQtWidgetSet.GetTextColor(DC: HDC) : TColorRef;
4222var
4223  Color: TQColor;
4224  QtDC: TQtDeviceContext;
4225begin
4226  {$ifdef VerboseQtWinAPI}
4227    WriteLn('[WinAPI GetTextColor]');
4228  {$endif}
4229
4230  Result := 0;
4231
4232  if IsValidDC(DC) then
4233  begin
4234    QtDC := TQtDeviceContext(DC);
4235    ColorRefToTQColor(TColorRef(QtDC.vTextColor), Color{%H-});
4236    TQColorToColorRef(Color, Result);
4237  end;
4238end;
4239
4240{------------------------------------------------------------------------------
4241  Function: GetTextExtentExPoint
4242  Params: http://msdn.microsoft.com/en-us/library/dd144935%28VS.85%29.aspx
4243  Returns: True on success
4244 ------------------------------------------------------------------------------}
4245function TQtWidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; Count,
4246  MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize
4247  ): Boolean;
4248var
4249  i: Integer;
4250  w: Integer;
4251  AStr: WideString;
4252  Accu: Integer;
4253begin
4254  Result := False;
4255  if not IsValidDC(DC) then Exit;
4256  with TQtDeviceContext(DC) do
4257  begin
4258    if Str = nil then
4259      AStr := ''
4260    else
4261      AStr := Str;
4262    Size.cx := 0;
4263    Size.cY := Font.Metrics.Height;
4264    if (AStr = '') then
4265    begin
4266      if MaxCount <> nil then
4267        MaxCount^ := 0;
4268      if PartialWidths <> nil then
4269      begin
4270        for i := 0 to Count - 1 do
4271          PartialWidths[i] := 0;
4272      end;
4273      exit(True);
4274    end;
4275    if PartialWidths = nil then
4276    begin
4277      if MaxCount <> nil then
4278      begin
4279        Size.cx := Font.Metrics.width(@AStr);
4280        Accu := 0;
4281        if MaxWidth <= 0 then
4282          MaxCount^ := 0
4283        else
4284          for i := 0 to Count - 1 do
4285          begin
4286            W := QFontMetrics_charWidth(Font.Metrics.FHandle, @AStr, i);
4287            Accu := Accu + W;
4288            if Accu <= MaxWidth then
4289              MaxCount^ := i + 1
4290            else
4291              break;
4292          end;
4293      end;
4294    end else
4295    begin
4296      if MaxCount <> nil then
4297        MaxCount^ := 0;
4298      for i := 0 to Count - 1 do
4299      begin
4300        w := QFontMetrics_charWidth(Font.Metrics.FHandle, @AStr, i);
4301        Inc(Size.cx, w);
4302        if MaxCount <> nil then
4303        begin
4304          if Size.cx <= MaxWidth then
4305          begin
4306            inc(MaxCount^);
4307            PartialWidths[i] := Size.cx;
4308          end else
4309          begin
4310            Dec(Size.cx, w);
4311            break;
4312          end;
4313        end else
4314          PartialWidths[i] := Size.cx;
4315      end;
4316    end;
4317  end;
4318  Result := True;
4319end;
4320
4321{------------------------------------------------------------------------------
4322  Function: GetTextExtentPoint
4323  Params:  none
4324  Returns: Nothing
4325 ------------------------------------------------------------------------------}
4326function TQtWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
4327var
4328  WStr: WideString;
4329  QtDC: TQtDeviceContext absolute DC;
4330begin
4331  {$ifdef VerboseQtWinAPI}
4332    WriteLn('[WinAPI GetTextExtentPoint]');
4333  {$endif}
4334
4335  Result := IsValidDC(DC);
4336
4337  if not Result then
4338    exit;
4339
4340  Size.cx := 0;
4341  Size.cy := 0;
4342  if (Count <= 0) or (Str = nil) or (StrPas(Str) = '') then
4343    exit;
4344  WStr := Str;
4345  Size.cx := QtDC.Metrics.width(@WStr, Count);
4346  Size.cy := QtDC.Metrics.height;
4347
4348  Result := True;
4349end;
4350
4351{------------------------------------------------------------------------------
4352  Function: GetTextMetrics
4353  Params:  DC     - A device context with a font selected
4354           TM     - The structure to receive the font information
4355  Returns: If successfull
4356 ------------------------------------------------------------------------------}
4357function TQtWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
4358var
4359  QtFontMetrics: TQtFontMetrics;
4360  FontFamily: WideString;
4361  QtDC: TQtDeviceContext absolute DC;
4362  FontWeight: Integer;
4363begin
4364  {$ifdef VerboseQtWinAPI}
4365    WriteLn('[WinAPI GetTextMetrics]');
4366  {$endif}
4367
4368  Result := IsValidDC(DC);
4369
4370  if Result then
4371  begin
4372    QtFontMetrics := QtDC.Metrics;
4373    TM.tmHeight := QtFontMetrics.height;
4374    TM.tmAscent := QtFontMetrics.ascent;
4375    TM.tmDescent := QtFontMetrics.descent;
4376    TM.tmInternalLeading := 0;
4377    TM.tmExternalLeading := QtFontMetrics.leading;
4378    {this is due qt bug in fontmetrics::averageCharWidth() under Mac
4379     http://trolltech.com/developer/task-tracker/index_html?method=entry&id=169440 }
4380    {$IFDEF DARWIN}
4381    if (QtVersionMajor = 4) and (QtVersionMinor >= 6) then
4382      TM.tmAveCharWidth := QtFontMetrics.averageCharWidth
4383    else
4384      TM.tmAveCharWidth := QtFontMetrics.charWidth('x',0);
4385    {$ELSE}
4386    TM.tmAveCharWidth := QtFontMetrics.averageCharWidth;
4387    {$ENDIF}
4388
4389    TM.tmMaxCharWidth := QtFontMetrics.maxWidth;
4390    FontWeight := QtDC.font.getWeight;
4391    case FontWeight of
4392      25: TM.tmWeight := FW_LIGHT;
4393      50: TM.tmWeight := FW_NORMAL;
4394      63: TM.tmWeight := FW_SEMIBOLD;
4395      75: TM.tmWeight := FW_BOLD;
4396      87: TM.tmWeight := FW_HEAVY;
4397      else
4398        TM.tmWeight := Round(FontWeight * 9.5);
4399    end;
4400    TM.tmOverhang := 0;
4401    TM.tmDigitizedAspectX := 0;
4402    TM.tmDigitizedAspectY := 0;
4403    TM.tmFirstChar := 'a';
4404    TM.tmLastChar := 'z';
4405    TM.tmDefaultChar := 'x';
4406    TM.tmBreakChar := '?';
4407    TM.tmItalic := Ord(QtDC.Font.getItalic);
4408    TM.tmUnderlined := Ord(QtDC.Font.getUnderline);
4409    TM.tmStruckOut := Ord(QtDC.Font.getStrikeOut);
4410
4411    QtDC.font.family(@FontFamily);
4412
4413    { Defaults to a TrueType font.
4414      Note that the meaning of the FIXED_PITCH constant is the opposite of
4415      the name implies, according to MSDN docs. Just a small inconsistency
4416      on Windows API that we have to mimic. }
4417    if QtDC.font.fixedPitch then
4418      TM.tmPitchAndFamily := TRUETYPE_FONTTYPE
4419    else
4420      TM.tmPitchAndFamily := FIXED_PITCH or TRUETYPE_FONTTYPE;
4421
4422    TM.tmCharSet := DEFAULT_CHARSET;
4423  end;
4424end;
4425
4426function TQtWidgetSet.GetViewPortExtEx(DC: HDC; Size: PSize): Integer;
4427var
4428  R: TRect;
4429begin
4430  if IsValidDC(DC) and (Size <> nil) then
4431  begin
4432    QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
4433    Size^.cx := R.Right - R.Left;
4434    Size^.cy := R.Bottom - R.Top;
4435    Result := Integer(True);
4436  end else
4437    Result := Integer(False);
4438end;
4439
4440function TQtWidgetSet.GetViewPortOrgEx(DC: HDC; P: PPoint): Integer;
4441var
4442  R: TRect;
4443begin
4444  if IsValidDC(DC) and (P <> nil) then
4445  begin
4446    QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
4447    P^ := R.TopLeft;
4448    Result := Integer(True);
4449  end else
4450    Result := Integer(False);
4451end;
4452
4453function TQtWidgetSet.GetWindowExtEx(DC: HDC; Size: PSize): Integer;
4454var
4455  R: TRect;
4456begin
4457  if IsValidDC(DC) and (Size <> nil) then
4458  begin
4459    QPainter_Window(TQtDeviceContext(DC).Widget, @R);
4460    Size^.cx := R.Right - R.Left;
4461    Size^.cy := R.Bottom - R.Top;
4462    Result := Integer(True);
4463  end else
4464    Result := Integer(False);
4465end;
4466
4467function TQtWidgetSet.GetWindowLong(Handle : hwnd; int: Integer): PtrInt;
4468begin
4469  Result := 0;
4470  {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
4471    WriteLn('***** [WinAPI TQtWidgetSet.GetWindowLong] missing implementation ');
4472  {$endif}
4473end;
4474
4475{------------------------------------------------------------------------------
4476  Method:  GetWindowOrgEx
4477  Params:  DC    -
4478  Returns:
4479 ------------------------------------------------------------------------------}
4480function TQtWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
4481var
4482  Matrix: QTransformH;
4483begin
4484  {$ifdef VerboseQtWinAPI}
4485    WriteLn('Trace: > [WinAPI GetWindowOrgEx]');
4486  {$endif}
4487  Result := 0;
4488  if not IsValidDC(DC) and (P<>nil) then
4489  begin
4490    {$ifdef VerboseQtWinAPI}
4491      WriteLn('Trace: < [WinAPI GetWindowOrgEx] No valid DC or P is nil');
4492    {$endif}
4493    exit;
4494  end;
4495
4496  Matrix := QPainter_transform(TQtDeviceContext(DC).Widget);
4497  if Matrix <> nil then
4498  begin
4499    P^.X := -Trunc(QTransform_Dx(Matrix));
4500    P^.Y := -Trunc(QTransform_Dy(Matrix));
4501    Result := 1;
4502  end;
4503  {$ifdef VerboseQtWinAPI}
4504    WriteLn('Trace: < [WinAPI GetWindowOrgEx] Result=', dbgs(p^));
4505  {$endif}
4506end;
4507
4508
4509{------------------------------------------------------------------------------
4510  Method:  GetWindowRect
4511  Params:  Handle - handle of window
4512           Rect   - record for window coordinates
4513  Returns: if the function succeeds, the return value is nonzero; if the
4514           function fails, the return value is zero
4515
4516  Retrieves the dimensions of the bounding rectangle of the specified window.
4517 ------------------------------------------------------------------------------}
4518function TQtWidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer;
4519var
4520  APos: TQtPoint;
4521  R, AFrame: TRect;
4522  AForm: TCustomForm;
4523begin
4524  {$ifdef VerboseQtWinAPI}
4525    WriteLn('[WinAPI GetWindowRect]');
4526  {$endif}
4527
4528  Result := 0;
4529  if not IsValidHandle(Handle) then
4530    exit;
4531
4532  if (TQtWidget(Handle) is TQtMainWindow) and Assigned(TQtWidget(Handle).LCLObject) and
4533    (TQtWidget(Handle).LCLObject.Parent = nil) and
4534    not TQtMainWindow(Handle).FirstPaintEvent
4535    {$IFDEF HASX11}and (QtWidgetSet.GetDummyWidgetFrame <> Rect(0, 0, 0, 0)){$ENDIF} then
4536  begin
4537    AForm := TCustomForm(TQtWidget(Handle).LCLObject);
4538    if not (AForm.FormStyle in [fsMDIChild, fsSplash]) and (AForm.BorderStyle <> bsNone) and
4539      not IsFormDesign(AForm) then
4540    begin
4541      {$IFDEF HASX11}
4542      R := AForm.BoundsRect;
4543      AFrame := QtWidgetSet.GetDummyWidgetFrame;
4544      // apply frame size to lcl form.
4545      R.Right += AFrame.Left + AFrame.Right;
4546      R.Bottom += AFrame.Top + AFrame.Bottom;
4547      ARect := R; //this is now real size under x11 even on unmapped window :)
4548      exit(-1);
4549      {$ELSE}
4550      QWidget_winID(TQtWidget(Handle).Widget);
4551      {$ENDIF}
4552    end;
4553  end;
4554
4555  APos := QtPoint(0,0);
4556  QWidget_mapToGlobal(TQtWidget(Handle).Widget, @APos, @APos);
4557
4558  R := TQtWidget(Handle).getFrameGeometry;
4559  ARect := Bounds(APos.X,APos.Y,R.Right-R.Left,R.Bottom-R.Top);
4560  Result := -1;
4561end;
4562
4563{------------------------------------------------------------------------------
4564  Function: GetWindowRelativePosition
4565  Params:  Handle : HWND;
4566  Returns: true on success
4567
4568  returns the current widget Left, Top, relative to the client origin of its
4569  parent. Top level form returns 0,0 when we use accurate frames.
4570 ------------------------------------------------------------------------------}
4571function TQtWidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left,
4572  Top: Integer): boolean;
4573var
4574  R: TRect;
4575begin
4576  {$ifdef VerboseQtWinAPI}
4577    WriteLn('[WinAPI GetWindowRelativePosition]');
4578  {$endif}
4579  if Handle = 0 then
4580    Exit(False);
4581  R := TQtWidget(Handle).getFrameGeometry;
4582  Left := R.Left;
4583  Top := R.Top;
4584  Result := True;
4585end;
4586
4587{------------------------------------------------------------------------------
4588  Function: GetWindowSize
4589  Params:  Handle : hwnd;
4590  Returns: true on success
4591
4592  Returns the current widget Width and Height
4593 ------------------------------------------------------------------------------}
4594function TQtWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer
4595  ): boolean;
4596var
4597  ASize: TSize;
4598begin
4599  {$ifdef VerboseQtWinAPI}
4600    WriteLn('[WinAPI GetWindowSize]');
4601  {$endif}
4602  if Handle = 0 then
4603    Exit(False);
4604
4605  ASize := TQtWidget(Handle).getSize;
4606  Height := ASize.cy;
4607  Width := ASize.cx;
4608
4609  Result := True;
4610
4611  // Here we should convert top level lcl window coordinaties to qt coord
4612  // Due to borders and etc
4613  // ?
4614end;
4615
4616{------------------------------------------------------------------------------
4617  Function: GradientFill
4618  Params: DC - DeviceContext to perform on
4619          Vertices - array of Points W/Color & Alpha
4620          NumVertices - Number of Vertices
4621          Meshes - array of Triangle or Rectangle Meshes,
4622                   each mesh representing one Gradient Fill
4623          NumMeshes - Number of Meshes
4624          Mode - Gradient Type, either Triangle,
4625                 Vertical Rect, Horizontal Rect
4626
4627  Returns: true on success
4628
4629  Performs multiple Gradient Fills, either a Three way Triangle Gradient,
4630  or a two way Rectangle Gradient, each Vertex point also supports optional
4631  Alpha/Transparency for more advanced Gradients.
4632 ------------------------------------------------------------------------------}
4633function TQtWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
4634  NumVertices: Longint; Meshes: Pointer; NumMeshes: Longint; Mode: Longint
4635  ): Boolean;
4636
4637  function DoFillTriangle: Boolean; inline;
4638  begin
4639    Result := (Mode and GRADIENT_FILL_TRIANGLE) = GRADIENT_FILL_TRIANGLE;
4640  end;
4641
4642  function DoFillVRect: Boolean; inline;
4643  begin
4644    Result := (Mode and GRADIENT_FILL_RECT_V) = GRADIENT_FILL_RECT_V;
4645  end;
4646
4647  function VertexToColor(AVertex: tagTRIVERTEX): TQColor;
4648  var
4649    TheAlpha: Byte;
4650  begin
4651    TheAlpha := AVertex.Alpha shr 8;
4652    if TheAlpha = 0 then
4653      TheAlpha := 255;
4654    with AVertex do
4655      QColor_fromRgb(@Result, Red shr 8, Green shr 8, Blue shr 8, TheAlpha);
4656  end;
4657
4658  function FillTriMesh(Mesh: tagGradientTriangle) : Boolean;
4659  var
4660    V1, V2, V3: tagTRIVERTEX;
4661    C1, C2, C3: TQColor;
4662    Grad: QConicalGradientH;
4663    Brush: QBrushH;
4664    Triangle: QPolygonH;
4665    R: TRect;
4666    Painter: QPainterH;
4667    Rgn: QRegionH;
4668  begin
4669    with Mesh do
4670    begin
4671      Result :=
4672        (Vertex1 < Cardinal(NumVertices)) and
4673        (Vertex2 < Cardinal(NumVertices)) and
4674        (Vertex3 < Cardinal(NumVertices));
4675
4676      if (Vertex1 = Vertex2) or
4677        (Vertex1 = Vertex3) or
4678        (Vertex2 = Vertex3) or not Result then
4679        Exit;
4680
4681      V1 := Vertices[Vertex1];
4682      V2 := Vertices[Vertex2];
4683      V3 := Vertices[Vertex3];
4684
4685      Painter := TQtDeviceContext(DC).Widget;
4686      QPainter_save(Painter);
4687      Triangle := QPolygon_create(3);
4688      QPolygon_setPoint(Triangle, 0, V1.X, V1.Y);
4689      QPolygon_setPoint(Triangle, 1, V2.X, V2.Y);
4690      QPolygon_setPoint(Triangle, 2, V3.X, V3.Y);
4691      QPolygon_boundingRect(Triangle, @R);
4692
4693      Dec(R.Bottom);
4694      Dec(R.Right);
4695
4696      Rgn := QRegion_create(@R);
4697
4698      // make our poly clip region , so gradient center is at real center
4699      QPainter_setClipRegion(Painter, Rgn, QtIntersectClip);
4700
4701      Grad := QConicalGradient_create(R.Right div 2, R.Bottom div 2, 90);
4702      C1 := VertexToColor(V1);
4703      C2 := VertexToColor(V2);
4704      C3 := VertexToColor(V3);
4705
4706      QGradient_setColorAt(Grad, 0.0, @C1); // open
4707      QGradient_setColorAt(Grad, 0.33, @C2); // left corner
4708      QGradient_setColorAt(Grad, 0.66, @C3); // right corner
4709      QGradient_setColorAt(Grad, 1.0, @C1); // close
4710
4711
4712      Brush := QBrush_create(Grad);
4713      QPainter_setPen(Painter, QtNoPen);
4714      QPainter_setBrush(Painter, Brush);
4715
4716      // move center point down, so we remove reflections of C2 and C3
4717      // TODO: C1 reflection is still visible
4718      QPainter_setBrushOrigin(Painter, 0, R.Bottom div 5);
4719      QPainter_drawPolygon(Painter, Triangle);
4720
4721      //TODO: now me must make it look "softer" because reflection look of
4722      // first color is ugly.
4723
4724      QBrush_destroy(Brush);
4725      QPolygon_destroy(Triangle);
4726      QGradient_destroy(Grad);
4727      QRegion_destroy(Rgn);
4728      QPainter_restore(Painter);
4729
4730    end;
4731  end;
4732
4733  function FillRectMesh(Mesh: tagGradientRect) : boolean;
4734  var
4735    TL,BR: tagTRIVERTEX;
4736    StartColor, EndColor, SwapColor: TQColor;
4737    Swap: Longint;
4738    SwapColors: Boolean;
4739    Grad: QGradientH;
4740    Brush: QBrushH;
4741  begin
4742    with Mesh do
4743    begin
4744      Result :=
4745        (UpperLeft < Cardinal(NumVertices)) and
4746        (LowerRight < Cardinal(NumVertices));
4747      if (LowerRight = UpperLeft) or not Result then
4748        Exit;
4749
4750      TL := Vertices[UpperLeft];
4751      BR := Vertices[LowerRight];
4752      SwapColors := (BR.Y < TL.Y) and (BR.X < TL.X);
4753      if BR.X < TL.X then
4754      begin
4755        Swap := BR.X;
4756        BR.X := TL.X;
4757        TL.X := Swap;
4758      end;
4759      if BR.Y < TL.Y then
4760      begin
4761        Swap := BR.Y;
4762        BR.Y := TL.Y;
4763        TL.Y := Swap;
4764      end;
4765      StartColor := VertexToColor(TL);
4766      EndColor := VertexToColor(BR);
4767      if SwapColors then
4768      begin
4769        SwapColor := StartColor;
4770        StartColor := EndColor;
4771        EndColor := SwapColor;
4772      end;
4773      if DoFillVRect then
4774        Grad := QLinearGradient_create(TL.X, TL.Y, TL.X, BR.Y)
4775      else
4776        Grad := QLinearGradient_create(TL.X, TL.Y, BR.X, TL.Y);
4777      QGradient_setColorAt(Grad, 0, @StartColor);
4778      QGradient_setColorAt(Grad, 1, @EndColor);
4779      Brush := QBrush_create(Grad);
4780      TQtDeviceContext(DC).fillRect(TL.X, TL.Y, BR.X - TL.X, BR.Y - TL.Y, Brush);
4781      QGradient_destroy(Grad);
4782      QBrush_destroy(Brush);
4783    end;
4784  end;
4785
4786const
4787  MeshSize: Array[Boolean] of Integer = (
4788    SizeOf(tagGradientRect), SizeOf(tagGradientTriangle));
4789var
4790  i : Integer;
4791begin
4792  {$ifdef VerboseQtWinAPI}
4793    WriteLn('***** [WinAPI TQtWidgetSet.GradientFill] ');
4794  {$endif}
4795
4796  //Currently Alpha blending is ignored... Ideas anyone?
4797  Result := (Meshes <> nil) and (NumMeshes >= 1) and (NumVertices >= 2)
4798            and (Vertices <> nil);
4799  if Result and DoFillTriangle then
4800    Result := NumVertices >= 3;
4801  if Result then
4802  begin
4803    Result := False;
4804
4805    //Sanity Checks For Vertices Size vs. Count
4806    if MemSize(Vertices) < PtrUInt(SizeOf(tagTRIVERTEX)*NumVertices) then
4807      exit;
4808
4809    //Sanity Checks For Meshes Size vs. Count
4810    if MemSize(Meshes) < PtrUInt(MeshSize[DoFillTriangle]*NumMeshes) then
4811      exit;
4812
4813    for I := 0 to NumMeshes - 1 do
4814    begin
4815      if DoFillTriangle then
4816      begin
4817        if not FillTriMesh(PGradientTriangle(Meshes)[I]) then
4818          exit;
4819      end
4820      else
4821      begin
4822        if not FillRectMesh(PGradientRect(Meshes)[I]) then
4823          exit;
4824      end;
4825    end;
4826    Result := True;
4827  end;
4828end;
4829
4830function TQtWidgetSet.HideCaret(hWnd: HWND): Boolean;
4831begin
4832  Result := (hWnd <> 0) and QtCaret.HideCaret(TQtWidget(hWnd));
4833end;
4834
4835{------------------------------------------------------------------------------
4836  Procedure: InitializeCriticalSection
4837  Params: var CritSection: TCriticalSection
4838  Returns:
4839 ------------------------------------------------------------------------------}
4840procedure TQtWidgetSet.InitializeCriticalSection(var CritSection: TCriticalSection);
4841var
4842  ACritSec: System.PRTLCriticalSection;
4843begin
4844  New(ACritSec);
4845  System.InitCriticalSection(ACritSec^);
4846  CritSection:=TCriticalSection(ACritSec);
4847end;
4848
4849function TQtWidgetSet.InitStockFont(AFont: TObject; AStockFont: TStockFont
4850  ): Boolean;
4851var
4852  Font: TFont absolute AFont;
4853  AMenu: QMenuH;
4854  QtFont: QFontH;
4855  AName: WideString;
4856begin
4857  Result := False;
4858  if AStockFont = sfMenu then
4859  begin
4860    AName := 'MenuTitle';
4861    AMenu := QMenu_create(@AName, nil);
4862    try
4863      QtFont := QWidget_font(AMenu);
4864      QFont_family(QtFont, @AName);
4865      Font.Name := AName{%H-};
4866      {$ifdef darwin}
4867      // issue #34625
4868      if QFont_pointSize(QtFont) > 0 then
4869        Font.Height := -Round(QFont_pointSizeF(QtFont))
4870      else
4871        Font.Height := QFont_pixelSize(QtFont);
4872      {$else}
4873      if QFont_pointSize(QtFont) > 0 then
4874        Font.Size := QFont_pointSize(QtFont)
4875      else
4876        Font.Height := QFont_pixelSize(QtFont);
4877      {$endif}
4878      if QFont_bold(QtFont) then
4879        Font.Style := Font.Style + [fsBold];
4880      if QFont_italic(QtFont) then
4881        Font.Style := Font.Style + [fsItalic];
4882      if QFont_underline(QtFont) then
4883        Font.Style := Font.Style + [fsUnderline];
4884      if QFont_strikeOut(QtFont) then
4885        Font.Style := Font.Style + [fsStrikeOut];
4886      Font.Color := clMenuText;
4887      Result := True;
4888    finally
4889      QWidget_destroy(AMenu);
4890    end;
4891  end else
4892  begin
4893    QtFont := QFont_create;
4894    try
4895      if AStockFont = sfHint then
4896        QToolTip_font(QtFont)
4897      else
4898        QApplication_font(QtFont);
4899      QFont_family(QtFont, @AName);
4900      Font.Name := AName{%H-};
4901      {$ifdef darwin}
4902      // issue #34625
4903      if QFont_pointSize(QtFont) > 0 then
4904        Font.Height := -Round(QFont_pointSizeF(QtFont))
4905      else
4906        Font.Height := QFont_pixelSize(QtFont);
4907      {$else}
4908      if QFont_pointSize(QtFont) > 0 then
4909        Font.Size := QFont_pointSize(QtFont)
4910      else
4911        Font.Height := QFont_pixelSize(QtFont);
4912      {$endif}
4913      if QFont_bold(QtFont) then
4914        Font.Style := Font.Style + [fsBold];
4915      if QFont_italic(QtFont) then
4916        Font.Style := Font.Style + [fsItalic];
4917      if QFont_underline(QtFont) then
4918        Font.Style := Font.Style + [fsUnderline];
4919      if QFont_strikeOut(QtFont) then
4920        Font.Style := Font.Style + [fsStrikeOut];
4921
4922      {comment font.color for check if hintfont works correct}
4923      if AStockFont = sfHint then
4924        Font.Color := clInfoText;
4925
4926      Result := True;
4927    finally
4928      QFont_destroy(QtFont);
4929    end;
4930  end;
4931end;
4932
4933function TQtWidgetSet.IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer;
4934var
4935  QtDC: TQtDeviceContext absolute dc;
4936  IntersectRgn, Rgn: QRegionH;
4937begin
4938  {$ifdef VerboseQtWinAPI}
4939    WriteLn('[WinAPI TQtWidgetSet.IntersectClipRect] L ',Left,' T ',Top,' R ',Right,' B ',Bottom);
4940  {$endif}
4941  Result := ERROR;
4942  if not IsValidDC(DC) then exit;
4943
4944  IntersectRgn := QRegion_create(Left, Top, Right - Left, Bottom - Top);
4945  try
4946    if QtDC.getClipping then
4947    begin
4948      Rgn := QRegion_create;
4949      try
4950        QPainter_clipRegion(QtDC.Widget, Rgn);
4951        if QRegion_isEmpty(Rgn) then
4952          QtDC.setClipRegion(IntersectRgn)
4953        else
4954          QtDC.setClipRegion(IntersectRgn, QtIntersectClip);
4955        QtDC.setClipping(True);
4956        // recreate Rgn
4957        QRegion_destroy(Rgn);
4958        Rgn := QRegion_create;
4959        QPainter_clipRegion(QtDC.Widget, Rgn);
4960        Result := QtDC.GetRegionType(Rgn);
4961      finally
4962        QRegion_destroy(Rgn);
4963      end;
4964    end else
4965    begin
4966      QtDC.setClipRegion(InterSectRgn);
4967      QtDC.setClipping(True);
4968      Result := QtDC.GetRegionType(InterSectRgn);
4969    end;
4970  finally
4971    QRegion_destroy(IntersectRgn);
4972  end;
4973end;
4974
4975function TQtWidgetSet.IsIconic(Handle: HWND): boolean;
4976begin
4977  Result := False;
4978  if IsValidHandle(Handle) then
4979    Result := TQtWidget(Handle).isMinimized;
4980end;
4981
4982function TQtWidgetSet.IsWindow(handle: HWND): boolean;
4983begin
4984  Result := IsValidHandle(Handle);
4985end;
4986
4987function TQtWidgetSet.IsWindowEnabled(Handle: HWND): boolean;
4988begin
4989  Result := False;
4990  if IsValidHandle(Handle) then
4991    Result := TQtWidget(Handle).getEnabled and TQtWidget(Handle).getVisible;
4992end;
4993
4994function TQtWidgetSet.IsWindowVisible(Handle: HWND): boolean;
4995begin
4996  Result := False;
4997  if IsValidHandle(Handle) then
4998    Result := TQtWidget(Handle).getVisible;
4999end;
5000
5001function TQtWidgetSet.IsZoomed(Handle: HWND): boolean;
5002begin
5003  Result := False;
5004  if IsValidHandle(Handle) then
5005    Result := TQtWidget(Handle).isMaximized;
5006end;
5007
5008{------------------------------------------------------------------------------
5009  Function: InvalidateRect
5010  Params: aHandle:
5011          Rect:
5012          bErase:
5013  Returns:
5014
5015 ------------------------------------------------------------------------------}
5016function TQtWidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect; bErase: Boolean): Boolean;
5017var
5018  Pt: TPoint;
5019begin
5020  {$ifdef VerboseQtWinAPI}
5021    WriteLn('[WinAPI InvalidateRect]');
5022  {$endif}
5023  if AHandle = 0 then
5024    exit(False);
5025  if Rect <> nil then
5026  begin
5027    with TQtWidget(aHandle).getClientOffset do
5028      OffsetRect(Rect^, x, y);
5029
5030    {$IFDEF QTSCROLLABLEFORMS}
5031    if (TQtWidget(AHandle) is TQtMainWindow) and Assigned(TQtMainWindow(AHandle).ScrollArea) then
5032    begin
5033      Pt := TQtMainWindow(AHandle).ScrollArea.ScrolledOffset;
5034      OffsetRect(Rect^, -Pt.X, -Pt.Y);
5035    end else
5036    {$ENDIF}
5037    if TQtWidget(AHandle).ChildOfComplexWidget = ccwScrollingWinControl then
5038    begin
5039      Pt := TQtCustomControl(AHandle).viewport.ScrolledOffset;
5040      OffsetRect(Rect^, -Pt.X, -Pt.Y);
5041    end;
5042
5043    // no need to handle bErase. Qt automatically erase rect on paint event according to docs
5044    TQtWidget(aHandle).Update(Rect);
5045  end else
5046    TQtWidget(aHandle).Update;
5047
5048  Result := True;
5049end;
5050
5051{------------------------------------------------------------------------------
5052  Function: InvalidateRgn
5053  Params: aHandle:
5054          Rect:
5055          bErase:
5056  Returns: True if invalidate is successfull.
5057  Invalidates region of widget.
5058 ------------------------------------------------------------------------------}
5059function TQtWidgetSet.InvalidateRgn(aHandle: HWND; Rgn: HRGN; Erase: Boolean): Boolean;
5060begin
5061  {$ifdef VerboseQtWinAPI}
5062    WriteLn('[WinAPI InvalidateRgn]');
5063  {$endif}
5064  if aHandle = 0 then
5065    exit(False);
5066  if IsValidGDIObject(Rgn) and (TQtRegion(Rgn).FHandle <> nil) then
5067    TQtWidget(aHandle).UpdateRegion(TQtRegion(Rgn).FHandle)
5068  else
5069    TQtWidget(aHandle).Update;
5070  Result := True;
5071end;
5072
5073{------------------------------------------------------------------------------
5074  Procedure: LeaveCriticalSection
5075  Params:  var CritSection: TCriticalSection
5076  Returns: Nothing
5077 ------------------------------------------------------------------------------}
5078procedure TQtWidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection);
5079var
5080  ACritSec: System.PRTLCriticalSection;
5081begin
5082  ACritSec:=System.PRTLCriticalSection(CritSection);
5083  System.LeaveCriticalsection(ACritSec^);
5084end;
5085
5086{------------------------------------------------------------------------------
5087  Function: LineTo
5088  Params:  none
5089  Returns: Nothing
5090
5091
5092 ------------------------------------------------------------------------------}
5093function TQtWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
5094var
5095  PenPos, LastPos: TPoint;
5096begin
5097  {$ifdef VerboseQtWinAPI}
5098    WriteLn('[WinAPI LineTo]');
5099  {$endif}
5100
5101  Result := False;
5102
5103  if not IsValidDC(DC) then Exit;
5104
5105  TQtDeviceContext(DC).getPenPos(@PenPos);
5106  LastPos := Point(X, Y);
5107  if TQtDeviceContext(DC).pen.getCosmetic then
5108    LastPos := TQtDeviceContext(DC).GetLineLastPixelPos(PenPos, LastPos);
5109  TQtDeviceContext(DC).drawLine(PenPos.X, PenPos.Y, LastPos.X, LastPos.Y);
5110  MoveToEx(DC, X, Y, nil);
5111
5112  Result := True;
5113end;
5114
5115function TQtWidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL;
5116var
5117  P: PPoint;
5118  QtPoint: TQtPoint;
5119  Matrix: QTransformH;
5120  QtDC: TQtDeviceContext;
5121begin
5122  Result := False;
5123
5124  if not IsValidDC(DC) then
5125    Exit;
5126
5127  QtDC := TQtDeviceContext(DC);
5128
5129  Matrix := QPainter_transform(QtDC.Widget);
5130  P := @Points;
5131  while Count > 0 do
5132  begin
5133    Dec(Count);
5134    QtPoint.X := P^.X;
5135    QtPoint.Y := P^.Y;
5136    QTransform_map(Matrix, PQtPoint(@QtPoint), PQtPoint(@QtPoint));
5137    P^.X := QtPoint.X;
5138    P^.Y := QtPoint.Y;
5139    Inc(P);
5140  end;
5141
5142  Result := True;
5143end;
5144
5145function TQtWidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer;
5146const
5147  ButtonToQtButton: array[1..4] of QMessageBoxStandardButton = (
5148   QMessageBoxOk, QMessageBoxYes, QMessageBoxNo, QMessageBoxCancel);
5149
5150
5151  function IconToMessageType(AType: cardinal): QMessageBoxIcon;
5152  begin
5153    case AType of
5154      1: Result := QMessageBoxCritical; // MB_ICONERROR = $00000010;
5155      2: Result := QMessageBoxQuestion; // MB_ICONQUESTION = $00000020;
5156      3: Result := QMessageBoxWarning; // MB_ICONWARNING = $00000030;
5157      4: Result := QMessageBoxInformation; // MB_ICONINFORMATION = $00000040;
5158      else Result := QMessageBoxNoIcon;
5159    end;
5160  end;
5161
5162  function ButtonToQtButtons(AType: cardinal): QMessageBoxStandardButtons;
5163  begin
5164    Result := QMessageBoxNoButton;
5165    case AType of
5166      0: Result := QMessageBoxOk;
5167      1: Result := QMessageBoxOk or QMessageBoxCancel;
5168      2: Result := QMessageBoxAbort or QMessageBoxRetry or QMessageBoxIgnore;
5169      3: Result := QMessageBoxYes or QMessageBoxNo or QMessageBoxCancel;
5170      4: Result := QMessageBoxYes or QMessageBoxNo;
5171      5: Result := QMessageBoxRetry or QMessageBoxCancel;
5172      6: Result := QMessageBoxCancel or QMessageBoxRetry or QMessageBoxApply; // not supported by lcl
5173      else
5174      begin
5175        DebugLn(Format('WARNING: TQtWidgetSet.MessageBox() invalid message box type %d',[AType]));
5176      end;
5177    end;
5178  end;
5179
5180  function ButtonToQtDefButton(AType: cardinal; ADefButton: cardinal): QMessageBoxStandardButton;
5181  begin
5182    Result := QMessageBoxNoButton;
5183    case AType of
5184      0: Result := QMessageBoxOk;
5185      1:
5186      begin
5187        if ADefButton = 2 then
5188          Result := QMessageBoxCancel
5189        else
5190          Result := QMessageBoxOk;
5191      end;
5192      2:
5193      begin
5194        if ADefButton = 3 then
5195          Result := QMessageBoxIgnore
5196        else
5197        if ADefButton = 2 then
5198          Result := QMessageBoxRetry
5199        else
5200          Result := QMessageBoxAbort;
5201      end;
5202      3:
5203      begin
5204        if ADefButton = 3 then
5205          Result := QMessageBoxCancel
5206        else
5207        if ADefButton = 2 then
5208          Result := QMessageBoxNo
5209        else
5210          Result := QMessageBoxYes;
5211      end;
5212      4:
5213      begin
5214        if ADefButton = 2 then
5215          Result := QMessageBoxNo
5216        else
5217          Result := QMessageBoxYes;
5218      end;
5219      5:
5220      begin
5221        if ADefButton = 2 then
5222          Result := QMessageBoxCancel
5223        else
5224          Result := QMessageBoxRetry;
5225      end;
5226      6:
5227      begin
5228        if ADefButton = 3 then
5229          Result := QMessageBoxCancel
5230        else
5231        if ADefButton = 2 then
5232          Result := QMessageBoxRetry
5233        else
5234          Result := QMessageBoxApply;
5235      end;
5236      else
5237        DebugLn(Format('WARNING: TQtWidgetSet.MessageBox() invalid message box type %d',[AType]));
5238    end;
5239  end;
5240
5241  function QtButtonToResult(AResult: integer): integer;
5242  begin
5243    Result := 0;
5244    case AResult of
5245      QMessageBoxOk, QMessageBoxApply: Result := ID_OK;
5246      QMessageBoxCancel: Result := ID_CANCEL;
5247      QMessageBoxAbort: Result := ID_ABORT;
5248      QMessageBoxRetry: Result := ID_RETRY;
5249      QMessageBoxIgnore: Result := ID_IGNORE;
5250      QMessageBoxYes: Result := ID_YES;
5251      QMessageBoxNo: Result := ID_NO;
5252      QMessageBoxClose: Result := ID_CLOSE;
5253      QMessageBoxHelp: Result := ID_HELP;
5254    end;
5255  end;
5256var
5257  Str: WideString;
5258  TitleStr: WideString;
5259  //OkStr: WideString;
5260  AParent: QWidgetH;
5261  DialogType, DefButton, DefIcon : Cardinal;
5262begin
5263  Result := 0;
5264  Str := lpText;
5265  TitleStr := lpCaption;
5266  //TODO: TRANSLATIONS for buttons text, use TQtMessageBox
5267  if HWND <> 0 then
5268    AParent := TQtWidget(Hwnd).Widget
5269  else
5270    AParent := nil;
5271  DefButton:= ((uType and $00000300) shr 8) + 1;
5272  DialogType:= (uType and $0000000F);
5273  DefIcon := (uType and $000000FF) shr 4;
5274
5275
5276  case IconToMessageType(DefIcon) of
5277    QMessageBoxInformation: Result := QMessageBox_information(AParent, @TitleStr, @Str, ButtonToQtButtons(DialogType), ButtonToQtDefButton(DialogType, DefButton));
5278    QMessageBoxQuestion: Result := QMessageBox_question(AParent, @TitleStr, @Str, ButtonToQtButtons(DialogType), ButtonToQtDefButton(DialogType, DefButton));
5279    QMessageBoxCritical: Result := QMessageBox_critical(AParent, @TitleStr, @Str, ButtonToQtButtons(DialogType), ButtonToQtDefButton(DialogType, DefButton));
5280    QMessageBoxWarning: Result := QMessageBox_warning(AParent, @TitleStr, @Str, ButtonToQtButtons(DialogType), ButtonToQtDefButton(DialogType, DefButton));
5281    else
5282    begin
5283      DebugLn('WARNING: TQtWidgetSet.MessageBox() unspecified dialog type.');
5284      Result := QMessageBox_information(AParent, @Str, @TitleStr, ButtonToQtButtons(DialogType), ButtonToQtButton[DefButton]);
5285    end;
5286  end;
5287  Result := QtButtonToResult(Result);
5288end;
5289
5290function TQtWidgetSet.MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord
5291  ): HMONITOR;
5292var
5293  AQtPoint: TQtPoint;
5294  Monitor: Integer;
5295begin
5296  Result := MONITOR_UNIMPL;
5297  AQtPoint := QtPoint(ptScreenCoords.x, ptScreenCoords.y);
5298  Monitor := QDesktopWidget_screenNumber(QApplication_desktop(), PQtPoint(@AQtPoint));
5299  if (Monitor >= 0) then
5300    Result := HMONITOR(Monitor + 1);
5301end;
5302
5303function TQtWidgetSet.MonitorFromRect(lprcScreenCoords: PRect; dwFlags: DWord
5304  ): HMONITOR;
5305var
5306  AQtPoint: TQtPoint;
5307  Monitor: Integer;
5308begin
5309  Result := MONITOR_UNIMPL;
5310  Monitor := -1;
5311  if lprcScreenCoords <> nil then
5312  begin
5313    AQtPoint := QtPoint(lprcScreenCoords^.Left, lprcScreenCoords^.Top);
5314    Monitor := QDesktopWidget_screenNumber(QApplication_desktop(), PQtPoint(@AQtPoint));
5315  end;
5316  if (Monitor >= 0) then
5317    Result := HMONITOR(Monitor + 1);
5318end;
5319
5320function TQtWidgetSet.MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR;
5321var
5322  Monitor: Integer;
5323begin
5324  Result := MONITOR_UNIMPL;
5325  Monitor := -1;
5326  if (hwnd > 0) and IsValidHandle(hWnd) then
5327    Monitor := QDesktopWidget_screenNumber(QApplication_desktop(), TQtWidget(hWnd).Widget);
5328  if (Monitor >= 0) then
5329    Result := HMONITOR(Monitor + 1);
5330end;
5331
5332{------------------------------------------------------------------------------
5333  Function: MoveToEx
5334  Params:  none
5335  Returns: Nothing
5336
5337
5338 ------------------------------------------------------------------------------}
5339function TQtWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
5340begin
5341  {$ifdef VerboseQtWinAPI}
5342    WriteLn('[WinAPI MoveToEx]',
5343     ' DC:', dbghex(DC),
5344     ' X:', dbgs(X),
5345     ' Y:', dbgs(Y));
5346  {$endif}
5347
5348  Result := False;
5349
5350  if not IsValidDC(DC) then Exit;
5351
5352  if (OldPoint <> nil) then TQtDeviceContext(DC).getPenPos(OldPoint);
5353
5354  TQtDeviceContext(DC).setPenPos(X, Y);
5355
5356  Result := True;
5357end;
5358
5359function TQtWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
5360var
5361  QtRgn: QRegionH;
5362begin
5363  Result := ERROR;
5364
5365  if not IsValidGDIObject(RGN) then
5366    Exit
5367  else
5368    QtRgn := TQtRegion(RGN).FHandle;
5369
5370  QRegion_translate(QtRgn, nXOffset, nYOffset);
5371
5372  if QRegion_isEmpty(QtRgn) then
5373    Result := NULLREGION
5374  else
5375  begin
5376    if TQtRegion(RGN).IsPolyRegion or (TQtRegion(RGN).numRects > 0) then
5377      Result := COMPLEXREGION
5378    else
5379      Result := SIMPLEREGION;
5380  end;
5381end;
5382
5383function TQtWidgetSet.PaintRgn(DC: HDC; RGN: HRGN): Boolean;
5384var
5385  APath: QPainterPathH;
5386begin
5387  Result := False;
5388  if not IsValidDC(DC) or not IsValidGDIObject(RGN) then
5389    exit;
5390  if TQtRegion(RGN).FHandle = nil then
5391    exit;
5392  APath := QPainterPath_create;
5393  QPainterPath_addRegion(APath, TQtRegion(RGN).FHandle);
5394  QPainterPath_closeSubpath(APath);
5395  QPainter_fillPath(TQtDeviceContext(DC).Widget, APath, QPainter_brush(TQtDeviceContext(DC).Widget));
5396  QPainterPath_destroy(APath);
5397  Result := True;
5398end;
5399
5400function TQtWidgetSet.PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean;
5401begin
5402  Result := False;
5403  {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
5404    WriteLn('***** [WinAPI TQtWidgetSet.PeekMessage] missing implementation ');
5405  {$endif}
5406end;
5407
5408{------------------------------------------------------------------------------
5409  Function: PolyBezier
5410  Params:  DC: HDC; Points: PPoint; NumPts: Integer; Filled: Boolean;
5411           Continuous: Boolean
5412  Returns: Nothing
5413 ------------------------------------------------------------------------------}
5414function TQtWidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer;
5415  Filled, Continuous: boolean): boolean;
5416begin
5417  {$ifdef VerboseQtWinAPI}
5418    WriteLn('[WinAPI PolyBezier] DC: ', dbghex(DC));
5419  {$endif}
5420  Result := inherited PolyBezier(DC, Points, NumPts, Filled, Continuous);
5421end;
5422
5423{------------------------------------------------------------------------------
5424  Function: Polygon
5425  Params:  DC: HDC; Points: PPoint; NumPts: Integer; Winding: Boolean
5426  Returns: Nothing
5427 ------------------------------------------------------------------------------}
5428function TQtWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer;
5429  Winding: boolean): boolean;
5430var
5431  QtPoints: PQtPoint;
5432  i: integer;
5433begin
5434  {$ifdef VerboseQtWinAPI}
5435    WriteLn('[WinAPI Polygon] DC: ', dbghex(DC));
5436  {$endif}
5437  Result := IsValidDC(DC);
5438  if Result then
5439  begin
5440    GetMem(QtPoints, NumPts * SizeOf(TQtPoint));
5441    for i := 0 to NumPts - 1 do
5442      QtPoints[i] := QtPoint(Points[i].x, Points[i].y);
5443    if Winding then
5444      QPainter_drawPolygon(TQtDeviceContext(DC).Widget, QtPoints, NumPts, QtWindingFill)
5445    else
5446      QPainter_drawPolygon(TQtDeviceContext(DC).Widget, QtPoints, NumPts, QtOddEvenFill);
5447    FreeMem(QtPoints);
5448  end;
5449end;
5450
5451{------------------------------------------------------------------------------
5452  Function: Polyline
5453  Params:  DC: HDC; Points: PPoint; NumPts: Integer
5454  Returns: Nothing
5455 ------------------------------------------------------------------------------}
5456function TQtWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
5457begin
5458  {$ifdef VerboseQtWinAPI}
5459    WriteLn('[WinAPI Polyline] DC: ', dbghex(DC));
5460  {$endif}
5461  Result := IsValidDC(DC) and (NumPts > 0);
5462  if Result then
5463    TQtDeviceContext(DC).DrawPolyLine(Points, NumPts);
5464end;
5465
5466function TQtWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam; lParam: LParam): Boolean;
5467var
5468  Widget: TQtWidget absolute Handle;
5469  Event: QLCLMessageEventH;
5470begin
5471  Result := False;
5472  if Handle <> 0 then
5473  begin
5474    Event := QLCLMessageEvent_create(QEventLCLMessage, Msg, wParam, lParam, 0);
5475    QCoreApplication_postEvent(Widget.Widget, Event, 1 {high priority});
5476    Result := True;
5477  end;
5478end;
5479
5480function TQtWidgetSet.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean;
5481begin
5482  Result := False;
5483
5484  if not IsValidGDIObject(RGN) then
5485    exit;
5486  if not (TObject(RGN) is TQtRegion) then
5487    Result := False
5488  else
5489    Result := TQtRegion(RGN).containsPoint(X, Y);
5490end;
5491
5492{------------------------------------------------------------------------------
5493  Function: Rectangle
5494  Params:  DC: HDC; X1, Y1, X2, Y2: Integer
5495  Returns: Nothing
5496
5497  The Rectangle function draws a rectangle. The rectangle is outlined by using
5498  the current pen and filled by using the current brush.
5499 ------------------------------------------------------------------------------}
5500function TQtWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
5501var
5502  R: TRect;
5503  B: Boolean;
5504begin
5505  {$ifdef VerboseQtWinAPI}
5506    WriteLn('[WinAPI Rectangle] DC: ', dbghex(DC));
5507  {$endif}
5508
5509  if not IsValidDC(DC) then Exit(False);
5510
5511  R := NormalizeRect(Rect(X1, Y1, X2, Y2));
5512  if IsRectEmpty(R) then Exit(True);
5513  // issue http://bugs.freepascal.org/view.php?id=25227
5514  B := (QtVersionMajor = 4) and (QtVersionMinor = 8) and
5515    (QPaintEngine_type(TQtDeviceContext(DC).PaintEngine) = QPaintEngineRaster) and
5516    QPen_isCosmetic(QPainter_pen(TQtDeviceContext(DC).Widget));
5517
5518  TQtDeviceContext(DC).drawRect(R.Left, R.Top, R.Right - R.Left - 1, R.Bottom - R.Top - 1, B);
5519  Result := True;
5520end;
5521
5522function TQtWidgetSet.RectVisible(dc : hdc; const ARect: TRect) : Boolean;
5523var
5524  QtDC: TQtDeviceContext;
5525begin
5526  {$ifdef VerboseQtWinAPI}
5527  writeln('[WinAPI RectVisible] ');
5528  {$endif}
5529  Result := False;
5530  if not IsValidDC(DC) then Exit;
5531  QtDC := TQtDeviceContext(DC);
5532  // as MSDN says only clipping region can play here
5533  if QtDC.getClipping then
5534    Result := QtDC.getClipRegion.containsRect(ARect);
5535end;
5536
5537{------------------------------------------------------------------------------
5538  Function: RedrawWindow
5539  Params: Wnd:
5540          lprcUpdate:
5541          hrgnUpdate:
5542          flags:
5543  Returns:
5544
5545 ------------------------------------------------------------------------------}
5546function TQtWidgetSet.RedrawWindow(Wnd: HWND; lprcUpdate: PRECT; hrgnUpdate: HRGN; flags: UINT): Boolean;
5547var
5548  QtWidget: TQtWidget;
5549  Region: TQtRegion;
5550begin
5551  if not IsValidHandle(Wnd) then
5552    Exit(False);
5553
5554  QtWidget := TQtWidget(Wnd);
5555  if IsValidGDIObject(hrgnUpdate) then
5556    Region := TQtRegion(hrgnUpdate)
5557  else
5558    Region := nil;
5559  if (lprcUpdate = nil) and (hrgnUpdate = 0) then
5560  begin
5561    QtWidget.Update(nil);
5562    Exit(True);
5563  end;
5564
5565  if Region = nil then
5566    Result := InvalidateRect(Wnd, lprcUpdate, False)
5567  else
5568    QtWidget.UpdateRegion(Region.FHandle);
5569
5570  Result := True;
5571end;
5572
5573function TQtWidgetSet.ReleaseCapture: Boolean;
5574var
5575  w: TQtWidget;
5576begin
5577  w := TQtWidget(GetCapture);
5578  Result := w <> nil;
5579  if Result then
5580  begin
5581    {$IFDEF MSWINDOWS}
5582    if (w is TQtMainWindow) then
5583      w.releaseMouse()
5584    else
5585      windows.ReleaseCapture;
5586    {$ELSE}
5587    w.releaseMouse();
5588    {$ENDIF}
5589  end;
5590  {$ifdef VerboseQtWinAPI}
5591  WriteLn('[WinAPI ReleaseCapture] Capture = ', THandle(w));
5592  {$endif}
5593end;
5594
5595{------------------------------------------------------------------------------
5596  Function: ReleaseDC
5597  Params:     hWnd:       Handle to the window whose DC is to be released.
5598              hDC:        Handle to the DC to be released.
5599  Returns:
5600 ------------------------------------------------------------------------------}
5601function TQtWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
5602begin
5603  {$ifdef VerboseQtWinAPI}
5604    WriteLn('[WinAPI ReleaseDC]',
5605     ' hWnd: ', dbghex(hWnd),
5606     ' DC: ', dbghex(DC));
5607  {$endif}
5608
5609  Result := 0;
5610
5611  if IsValidDC(DC) then
5612  begin
5613    if TQtDeviceContext(DC).UserDC then
5614      TQtDeviceContext(DC).Free;
5615    Exit;
5616  end;
5617
5618  Result := 1;
5619end;
5620
5621
5622{------------------------------------------------------------------------------
5623  Function: RestoreDC: Restore a previously saved DC state
5624  Params:
5625    DC: Handle to a DeviceContext
5626    SavedDC: Index of saved state that needs to be restored
5627  Returns: True if state was successfuly restored.
5628-------------------------------------------------------------------------------}
5629function TQtWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
5630var
5631  DCData: PQtDCData;
5632begin
5633  {$ifdef VerboseQTWinAPI}
5634  WriteLn('Trace:> [WinAPI RestoreDC] DC=', dbghex(DC),' SavedDC=',SavedDC);
5635  {$Endif}
5636  // if SavedDC is positive, it represents the wished saved dc instance
5637  // if SavedDC is negative, it's a relative number from last pushed state
5638  Result := False;
5639  if SavedDCList=nil then
5640  begin
5641    {$ifdef VerboseQTWinAPI}
5642    WriteLn('Trace:< [WinAPI RestoreDC] there is no List yet, result=', result);
5643    {$Endif}
5644    exit;
5645  end;
5646
5647  if SavedDC < 0 then
5648    SavedDC := SavedDC + SavedDCList.Count;
5649
5650  // check index
5651  Result := (SavedDC > 0) and (SavedDC < SavedDCList.Count);
5652  if Result then
5653  begin
5654    Result := true;
5655    while SavedDC > 0 do
5656    begin
5657      DCData := PQtDcData(SavedDCList[SavedDC]);
5658      SavedDCList.Delete(SavedDC);
5659      Result := TQtDeviceContext(DC).RestoreDCData(DCData);
5660      Dec(SavedDC);
5661    end;
5662  end;
5663  {$ifdef VerboseQTWinAPI}
5664  WriteLn('Trace:< [WinAPI RestoreDC]');
5665  {$Endif}
5666end;
5667
5668function TQtWidgetSet.RoundRect(DC: hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer): Boolean;
5669begin
5670  Result := False;
5671  if not IsValidDC(DC) then
5672  begin
5673    {$ifdef VerboseQTWinAPI}
5674    WriteLn('Trace:< [WinAPI RoundRect] DC Invalid, result=', result);
5675    {$Endif}
5676    Exit;
5677  end;
5678  Result := inherited RoundRect(DC, X1, Y1, X2, Y2, RX, RY);
5679end;
5680{------------------------------------------------------------------------------
5681  Function: SaveDC: save DC state information to a stack
5682  Params:  DC
5683  Returns: The index assigned to the or 0 if DC is not valid
5684-------------------------------------------------------------------------------}
5685function TQtWidgetSet.SaveDC(DC: HDC): Integer;
5686var
5687  DCData: PQtDCData;
5688begin
5689  {$ifdef VerboseQTWinAPI}
5690  WriteLn('Trace:> [WinAPI SaveDC] DC=', dbghex(DC));
5691  {$Endif}
5692
5693  result:=0;
5694
5695  if not IsValidDC(DC) then
5696  begin
5697    {$ifdef VerboseQTWinAPI}
5698    WriteLn('Trace:< [WinAPI SaveDC] DC Invalid, result=', result);
5699    {$Endif}
5700    exit;
5701  end;
5702
5703  if SavedDCList=nil then
5704  begin
5705    SavedDCList := TFPList.Create;
5706    SavedDCList.Add(nil); // start at index 1, 0 is an invalid saved state
5707  end;
5708
5709  DCData := TQtDeviceContext(DC).CreateDCData;
5710  Result := 1;
5711  SavedDCList.Insert(Result, DCData);
5712
5713  {$ifdef VerboseQTWinAPI}
5714  WriteLn('Trace:< [WinAPI SaveDC] result=', Result);
5715  {$Endif}
5716end;
5717
5718{------------------------------------------------------------------------------
5719  Function: ScreenToClient
5720  Params:  Handle: HWND; var P: TPoint
5721  Returns:
5722-------------------------------------------------------------------------------}
5723function TQtWidgetSet.ScreenToClient(Handle : HWND; var P : TPoint) : Integer;
5724begin
5725  Result := 0;
5726  if IsValidHandle(Handle) then
5727  begin
5728    P := TQtWidget(Handle).MapFromGlobal(P);
5729    Result := 1;
5730  end;
5731end;
5732
5733{------------------------------------------------------------------------------
5734  Method:  ScrollWindowEx
5735  Params:  HWnd       - handle of window to scroll
5736           DX         - horizontal amount to scroll
5737           DY         - vertical amount to scroll
5738           PRcScroll  - pointer to scroll rectangle
5739           PRcClip    - pointer to clip rectangle
5740           HRgnUpdate - handle of update region
5741           PRcUpdate  - pointer to update rectangle
5742           Flags      - scrolling flags
5743
5744  Returns: True if succesfull
5745
5746  The ScrollWindowEx function scrolls the content of the specified window's
5747  client area
5748 ------------------------------------------------------------------------------}
5749function TQtWidgetSet.ScrollWindowEx(HWnd: HWND; DX, DY: Integer; PRcScroll,
5750  PRcClip: PRect; HRgnUpdate: HRGN; PRcUpdate: PRect; Flags: UINT): Boolean;
5751var
5752  R: TRect;
5753  W: TQtWidget;
5754begin
5755  Result := False;
5756  if (HWND = 0) then exit;
5757
5758  W := TQtWidget(HWND);
5759  if ((Flags and SW_SCROLLCHILDREN) <> 0) then
5760  begin
5761    if Assigned(W.LCLObject) then {mantis #34589}
5762      W.WidgetState := W.WidgetState + [qtwsForceSendMove];
5763
5764    W.scroll(dx, dy, nil);
5765
5766    if Assigned(W.LCLObject) then {mantis #34589}
5767      W.WidgetState := W.WidgetState - [qtwsForceSendMove];
5768  end else
5769  if (PrcScroll = nil) then
5770  begin
5771    R := W.getClientBounds;
5772    W.scroll(dx, dy, @R);
5773  end
5774  else
5775    W.scroll(dx, dy, PRcScroll);
5776
5777  if ((Flags and SW_INVALIDATE) <> 0) then
5778  begin
5779    if IsValidGDIObject(HRgnUpdate) then
5780    begin
5781      R := TQtRegion(HRgnUpdate).getBoundingRect;
5782      PRcUpdate := @R;
5783      W.Update(@R);
5784    end else
5785    if PRcClip <> nil then
5786    begin
5787      PRcUpdate := PRcClip;
5788      W.Update(PrcClip);
5789    end;
5790  end;
5791
5792  Result := True;
5793end;
5794
5795{------------------------------------------------------------------------------
5796  Function: SelectClipRGN
5797  Params:  DC, RGN
5798  Returns: longint
5799
5800  Sets the DeviceContext's ClipRegion. The Return value
5801  is the new clip regions type, or ERROR.
5802
5803  The result can be one of the following constants
5804      Error
5805      NullRegion
5806      SimpleRegion
5807      ComplexRegion
5808
5809 ------------------------------------------------------------------------------}
5810function TQtWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
5811var
5812  QtDC: TQtDeviceContext;
5813  EmptyRegion: QRegionH;
5814  P: TPoint;
5815begin
5816  Result := ERROR;
5817  if IsValidDC(DC) then
5818  begin
5819    QtDC := TQtDeviceContext(DC);
5820    if IsValidGDIObject(RGN) then
5821    begin
5822      Result := TQtRegion(Rgn).GetRegionType;
5823      // RGN is in Device coordinates. Qt expects logical coordinates
5824      // so we need to convert RGN coords.
5825      GetWindowOrgEx(DC, @P);
5826      TQtRegion(Rgn).translate(P.X, P.Y);
5827      QtDC.setClipRegion(TQtRegion(Rgn).FHandle);
5828    end else
5829    begin
5830      EmptyRegion := QRegion_create;
5831      try
5832        QtDC.setClipRegion(EmptyRegion, QtNoClip);
5833      finally
5834        QRegion_destroy(EmptyRegion);
5835      end;
5836      Result := NULLREGION;
5837    end;
5838  end;
5839end;
5840
5841{------------------------------------------------------------------------------
5842  Function: SelectObject
5843  Params:  none
5844  Returns: The GDI object of the same type previously associated with the DC
5845
5846  Changes one of the GDI objects (Font, Brush, etc) of a Device Context;
5847 ------------------------------------------------------------------------------}
5848function TQtWidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
5849var
5850  aObject: TObject;
5851  {$ifdef VerboseQtWinAPI}
5852    ObjType: string;
5853  {$endif}
5854begin
5855  {$ifdef VerboseQtWinAPI}
5856    WriteLn('Trace:> [WinAPI SelectObject]',
5857    ' DC=', dbghex(DC),
5858    ' GDIObj=', dbghex(GDIObj));
5859  {$endif}
5860
5861  Result := 0;
5862
5863  if not IsValidDC(DC) then
5864  begin
5865    {$ifdef VerboseQtWinAPI}
5866      WriteLn('Trace:< [WinAPI SelectObject] Invalid DC');
5867    {$endif}
5868
5869    Exit;
5870  end;
5871
5872  if not IsValidGDIObject(GDIObj) then
5873  begin
5874    {$ifdef VerboseQtWinAPI}
5875      WriteLn('Trace:< [WinAPI SelectObject] Invalid GDI Object');
5876    {$endif}
5877
5878    Exit;
5879  end;
5880
5881  aObject := TObject(GDIObj);
5882
5883  if aObject is TQtFont then
5884  begin
5885    {$ifdef VerboseQtWinAPI}
5886      ObjType := 'Font';
5887    {$endif}
5888
5889    Result := HGDIOBJ(TQtDeviceContext(DC).font);
5890
5891    TQtDeviceContext(DC).setFont(TQtFont(aObject));
5892  end
5893  else if aObject is TQtPen then
5894  begin
5895    {$ifdef VerboseQtWinAPI}
5896      ObjType := 'Pen'      ;
5897    {$endif}
5898    result := HGDIOBJ(TQtDeviceContext(DC).pen);
5899
5900    TQtDeviceContext(DC).setPen(TQtPen(aObject));
5901  end
5902  else if aObject is TQtBrush then
5903  begin
5904    {$ifdef VerboseQtWinAPI}
5905      ObjType := 'Brush';
5906    {$endif}
5907
5908    Result := HGDIOBJ(TQtDeviceContext(DC).brush);
5909
5910    TQtDeviceContext(DC).setBrush(TQtBrush(aObject));
5911  end
5912  else if aObject is TQtImage then
5913  begin
5914    {$ifdef VerboseQtWinAPI}
5915      ObjType := 'Image';
5916    {$endif}
5917
5918    Result := HGDIOBJ(TQtDeviceContext(DC).vImage);
5919
5920    // TODO: is this also saved in qpainter_save?
5921    TQtDeviceContext(DC).setImage(TQtImage(aObject));
5922  end else
5923  if AObject is TQtRegion then
5924  begin
5925    Result := HGDIOBJ(TQtDeviceContext(DC).getClipRegion);
5926    SelectClipRGN(DC, HRGN(GDIObj));
5927  end;
5928
5929  {$ifdef VerboseQtWinAPI}
5930    WriteLn('Trace:< [WinAPI SelectObject] Result=', dbghex(Result), ' ObjectType=', ObjType);
5931  {$endif}
5932end;
5933
5934function TQtWidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal;
5935  WParam: WParam; LParam: LParam): LResult;
5936var
5937  Widget: TQtWidget absolute HandleWnd;
5938  Event: QLCLMessageEventH;
5939begin
5940  Result := 0;
5941  if (HandleWnd <> 0) and (Widget.Widget <> nil) then
5942  begin
5943    Event := QLCLMessageEvent_create(QEventLCLMessage, Msg, wParam, lParam, 0);
5944    try
5945      QCoreApplication_sendEvent(Widget.Widget, Event);
5946      Result := QLCLMessageEvent_getMsgResult(Event);
5947    finally
5948      QLCLMessageEvent_destroy(Event);
5949    end;
5950  end;
5951end;
5952
5953function TQtWidgetSet.SetActiveWindow(Handle: HWND): HWND;
5954begin
5955  Result := GetActiveWindow;
5956
5957  if Handle <> 0 then
5958    TQtWidget(Handle).Activate
5959  else
5960    Result := 0; // error
5961end;
5962
5963{------------------------------------------------------------------------------
5964  Function: SetBKColor
5965  Params: X:
5966          Y:
5967  Returns:
5968
5969 ------------------------------------------------------------------------------}
5970function TQtWidgetSet.SetBKColor(DC: HDC; Color: TColorRef): TColorRef;
5971begin
5972  {$ifdef VerboseQtWinAPI}
5973    WriteLn('Trace:> [WinAPI SetBkColor]',
5974     ' DC: ', dbghex(DC),
5975     ' Color: ', dbgs(Color));
5976  {$endif}
5977
5978  Result := 0;
5979
5980  if not IsValidDC(DC) then
5981  begin
5982    {$ifdef VerboseQtWinAPI}
5983      WriteLn('Trace:< [WinAPI SetBkColor] Invalid DC');
5984    {$endif}
5985
5986    Exit;
5987  end;
5988
5989  Result := TQtDeviceContext(DC).SetBkColor(TColorRef(Color));
5990end;
5991
5992{------------------------------------------------------------------------------
5993  Method:  SetBkMode
5994  Params:  DC    -
5995  Returns:
5996 ------------------------------------------------------------------------------}
5997function TQtWidgetSet.SetBkMode(DC: HDC; bkMode: Integer): Integer;
5998begin
5999  {$ifdef VerboseQtWinAPI}
6000    WriteLn('Trace:> [WinAPI SetBkMode] DC=', dbghex(DC), ' BkMode=', dbgs(bkMode));
6001  {$endif}
6002
6003  Result := 0;
6004
6005  if not IsValidDC(DC) then
6006  begin
6007    {$ifdef VerboseQtWinAPI}
6008      WriteLn('Trace:< [WinAPI SetBkMode] Invalid DC');
6009    {$endif}
6010
6011    Exit;
6012  end;
6013
6014  Result := TQtDeviceContext(DC).SetBkMode(bkMode);
6015end;
6016
6017function TQtWidgetSet.SetCapture(AHandle: HWND): HWND;
6018var
6019  Message: TLMessage;
6020begin
6021  Result := GetCapture;
6022  if Result <> AHandle then
6023  begin
6024    if Result <> 0 then
6025      ReleaseCapture;
6026    if IsValidHandle(AHandle) then
6027    begin
6028      {$IFDEF MSWINDOWS}
6029      if TQtWidget(AHandle) is TQtCustomControl then
6030      begin
6031        Windows.SetCapture(QWidget_winID(TQtCustomControl(AHandle).Viewport.Widget))
6032      end else
6033        Windows.SetCapture(QWidget_winID(TQtWidget(AHandle).Widget));
6034      {$ELSE}
6035      TQtWidget(AHandle).grabMouse();
6036      {$ENDIF}
6037    end;
6038    {$ifdef VerboseQtWinAPI}
6039      WriteLn('[WinAPI SetCapture] Capture = ', Result, ' New capture = ', AHandle);
6040    {$endif}
6041    if (Result <> 0) and IsValidHandle(AHandle) then
6042    begin
6043      Message.Msg := 0;
6044      FillChar(Message, SizeOf(Message), 0);
6045      Message.msg := LM_CAPTURECHANGED;
6046      Message.wParam := 0;
6047      Message.lParam := PtrInt(Result);
6048      LCLMessageGlue.DeliverMessage(TQtWidget(AHandle).LCLObject, Message);
6049    end;
6050  end;
6051end;
6052
6053function TQtWidgetSet.SetCaretPos(X, Y: Integer): Boolean;
6054begin
6055  Result := QtCaret.SetCaretPos(X, Y);
6056end;
6057
6058function TQtWidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
6059begin
6060  Result := QtCaret.SetCaretPos(X, Y);
6061end;
6062
6063function TQtWidgetSet.SetCaretRespondToFocus(handle: HWND;
6064  ShowHideOnFocus: boolean): Boolean;
6065begin
6066  Result := True;
6067  QtCaret.SetQtCaretRespondToFocus(ShowHideOnFocus);
6068end;
6069
6070{------------------------------------------------------------------------------
6071  Function: SetCursor
6072  Params: ACursor - HCursor (TQtCursor)
6073  Returns:
6074       previous global cursor
6075 ------------------------------------------------------------------------------}
6076function TQtWidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
6077begin
6078  Result := HCURSOR(OverrideCursor);
6079
6080  if Result = ACursor then
6081    Exit;
6082
6083  if Screen.Cursors[crDefault] = ACursor then
6084    OverrideCursor := nil
6085  else
6086    OverrideCursor := TQtCursor(ACursor);
6087end;
6088
6089{------------------------------------------------------------------------------
6090  Function: SetCursorPos
6091  Params: X:
6092          Y:
6093  Returns:
6094
6095 ------------------------------------------------------------------------------}
6096function TQtWidgetSet.SetCursorPos(X, Y: Integer): Boolean;
6097begin
6098  {$ifdef VerboseQtWinAPI}
6099    WriteLn('[WinAPI SetCursorPos]');
6100  {$endif}
6101
6102  QCursor_setPos(X, Y);
6103
6104  Result := True;
6105end;
6106
6107{------------------------------------------------------------------------------
6108  Function: SetFocus
6109  Params: hWnd   - Window handle to be focused
6110  Returns:
6111
6112 ------------------------------------------------------------------------------}
6113function TQtWidgetSet.SetFocus(hWnd: HWND): HWND;
6114var
6115  W: TQtWidget;
6116begin
6117  Result := 0;
6118  if hwnd<>0 then
6119  begin
6120    {$ifdef VerboseFocus}
6121    WriteLn('*********  TQtWidgetSet.SetFocus INIT focusing ', TQtWidget(hwnd).lclobject.name);
6122    {$endif}
6123    Result := GetFocus;
6124    W := TQtWidget(HWND).getWindow;
6125    if (W <> nil) and W.getVisible and not W.IsActiveWindow and
6126      not TQtMainWindow(W).Blocked then
6127        W.Activate;
6128    TQtWidget(hWnd).setFocus;
6129    {$ifdef VerboseFocus}
6130    DebugLn('********* TQtWidgetSet.SetFocus END was %x now is %x %s %d',[result,hwnd,dbgsName(TQtWidget(hWnd).LCLObject), GetTickCount]);
6131    {$endif}
6132  end;
6133end;
6134
6135function TQtWidgetSet.GetForegroundWindow: HWND;
6136begin
6137  {$IFDEF HASX11}
6138  {$note this should return current system active window, not
6139    application one, if our app isn''t active.
6140    This is per MSDN and pretty win32 specific}
6141  if WindowManagerName = 'metacity' then
6142    Result := HwndFromWidgetH(X11GetActivewindow)
6143  else
6144    Result := GetActiveWindow;
6145  {$ELSE}
6146  Result := GetActiveWindow;
6147  {$ENDIF}
6148end;
6149
6150function TQtWidgetSet.SetForegroundWindow(HWnd: HWND): boolean;
6151begin
6152  Result := False;
6153  if HWND <> 0 then
6154  begin
6155    Result := TQtWidget(HWND).IsActiveWindow;
6156    TQtWidget(HWnd).Activate;
6157  end;
6158end;
6159
6160function TQtWidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;
6161var
6162  AWidget, AMenuWidget: TQtWidget;
6163  QtMainWindow: TQtMainWindow absolute AWidget;
6164  QtMenuBar: TQtMenuBar absolute AMenuWidget;
6165  R, R1: TRect;
6166begin
6167  AWidget := TQtWidget(AWindowHandle);
6168  Result := AWidget is TQtMainWindow;
6169  if Result then
6170  begin
6171    AMenuWidget := TQtWidget(AMenuHandle);
6172    if AMenuWidget is TQtMenuBar then
6173    begin
6174      R := AWidget.LCLObject.ClientRect;
6175      R1 := QtMainWindow.MenuBar.getGeometry;
6176      R1.Right := R.Right;
6177      QtMenuBar.setGeometry(R1);
6178      QtMainWindow.setMenuBar(QMenuBarH(QtMenuBar.Widget));
6179    end
6180    else
6181      QtMainWindow.setMenuBar(QMenuBarH(QtMainWindow.MenuBar.Widget));
6182  end;
6183end;
6184
6185function TQtWidgetSet.SetParent(hWndChild: HWND; hWndParent: HWND): HWND;
6186var
6187  OldVisible: Boolean;
6188  Flags: QtWindowFlags;
6189  W: TQtWidget;
6190begin
6191  {$ifdef VerboseQtWinAPI}
6192  writeln('[WinApi SetParent] child: ',dbgHex(PtrUInt(hwndChild)),
6193    ' parent: ',dbgHex(PtrUInt(hWndParent)));
6194  {$endif}
6195  Result := 0;
6196  if not IsValidHandle(hwndChild) then
6197    exit;
6198  Result := GetParent(hWndChild);
6199  if (Result = hwndParent) then
6200    exit;
6201  W := TQtWidget(hWndChild);
6202  OldVisible := W.getVisible;
6203  Flags := W.windowFlags;
6204  if IsValidHandle(hWndParent) then
6205    W.setParent(TQtWidget(hWndParent).GetContainerWidget)
6206  else
6207  begin
6208    W.setParent(nil);
6209    W.setWindowFlags(Flags);
6210  end;
6211  W.setVisible(OldVisible);
6212end;
6213
6214function TQtWidgetSet.SetMapMode(DC: HDC; fnMapMode : Integer): Integer;
6215var
6216  AWindowExt: TPoint;
6217  R: TRect;
6218begin
6219  if IsValidDC(DC) then
6220  begin
6221    if fnMapMode <> TQtDeviceContext(DC).vMapMode then
6222    begin
6223      AWindowExt := Point(0, 0);
6224      case fnMapMode of
6225        MM_ANISOTROPIC:; // user's choice
6226        MM_ISOTROPIC:; // adjusted after each SetViewPortExtEx call (see MSDN for details)
6227        MM_HIENGLISH: AWindowExt := Point(1000, -1000);
6228        MM_HIMETRIC: AWindowExt := Point(2540, -2540);
6229        MM_LOENGLISH: AWindowExt := Point(100, -100);
6230        MM_LOMETRIC: AWindowExt := Point(254, -254);
6231        MM_TWIPS: AWindowExt := Point(1440, -1440);
6232      else
6233        fnMapMode := MM_TEXT;
6234      end;
6235      TQtDeviceContext(DC).vMapMode := fnMapMode;
6236      QPainter_setViewTransformEnabled(TQtDeviceContext(DC).Widget, fnMapMode <> MM_TEXT);
6237      if not (fnMapMode in [MM_TEXT, MM_ANISOTROPIC, MM_ISOTROPIC]) then
6238      begin
6239        QPainter_Window(TQtDeviceContext(DC).Widget, @R);
6240        R.BottomRight := AWindowExt;
6241        QPainter_setWindow(TQtDeviceContext(DC).Widget, @R);
6242        QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
6243        R.Right := QtWidgetSet.GetDeviceCaps(DC, LOGPIXELSX);
6244        R.Bottom := QtWidgetSet.GetDeviceCaps(DC, LOGPIXELSX);
6245        QPainter_setViewPort(TQtDeviceContext(DC).Widget, @R);
6246      end;
6247    end;
6248    Result := Integer(True);
6249  end else
6250    Result := Integer(False);
6251end;
6252
6253function TQtWidgetSet.SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean;
6254var
6255  R, RW: TRect;
6256  Ratio: Single;
6257begin
6258  Result := False;
6259  if IsValidDC(DC) then
6260  begin
6261    QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
6262    if OldSize <> nil then
6263    begin
6264      OldSize^.cx := R.Right - R.Left;
6265      OldSize^.cy := R.Bottom - R.Top;
6266    end;
6267    if (XExtent <> R.Right) or (YExtent <> R.Bottom) then
6268    begin
6269      case TQtDeviceContext(DC).vMapMode of
6270        MM_ANISOTROPIC, MM_ISOTROPIC:
6271        begin
6272          if TQtDeviceContext(DC).vMapMode = MM_ISOTROPIC then
6273          begin
6274            // TK: Is here also an adjustment on Windows if DPIX and DPIY are different?
6275            QPainter_Window(TQtDeviceContext(DC).Widget, @RW);
6276            Ratio := RW.Right / RW.Bottom; // no check, programmer cannot put nonsense
6277            if YExtent * Ratio > XExtent then
6278              YExtent := RoundToInt(XExtent / Ratio)
6279            else if YExtent * Ratio < XExtent then
6280              XExtent := RoundToInt(YExtent * Ratio)
6281          end;
6282          QPainter_setViewPort(TQtDeviceContext(DC).Widget, R.Left, R.Top, XExtent, YExtent);
6283          Result := True;
6284        end;
6285      end;
6286    end;
6287  end;
6288end;
6289
6290function TQtWidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean;
6291var
6292  R: TRect;
6293begin
6294  Result := False;
6295  if IsValidDC(DC) then
6296  begin
6297    QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
6298    if OldPoint <> nil then
6299      OldPoint^ := R.TopLeft;
6300    if (TQtDeviceContext(DC).vMapMode <> MM_TEXT) and (NewX <> R.Left) or (NewY <> R.Top) then
6301    begin
6302      QPainter_setViewPort(TQtDeviceContext(DC).Widget, NewX, NewY, R.Right - R.Left, R.Bottom - R.Top);
6303      Result := True;
6304    end;
6305  end;
6306end;
6307
6308function TQtWidgetSet.SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; OldSize: PSize): Boolean;
6309var
6310  R: TRect;
6311begin
6312  Result := False;
6313  if IsValidDC(DC) then
6314  begin
6315    QPainter_Window(TQtDeviceContext(DC).Widget, @R);
6316    if OldSize <> nil then
6317    begin
6318      OldSize^.cx := R.Right - R.Left;
6319      OldSize^.cy := R.Bottom - R.Top;
6320    end;
6321    if (XExtent <> R.Right) or (YExtent <> R.Bottom) then
6322    begin
6323      case TQtDeviceContext(DC).vMapMode of
6324        MM_ANISOTROPIC, MM_ISOTROPIC:
6325        begin
6326          QPainter_setWindow(TQtDeviceContext(DC).Widget, R.Left, R.Top, XExtent, YExtent);
6327          Result := True;
6328        end;
6329      end;
6330    end;
6331  end;
6332end;
6333
6334{------------------------------------------------------------------------------
6335  Method:  SetWindowOrgEx
6336  Params:  DC    - handle of device context
6337           NewX  - new x-coordinate of window origin
6338           NewY  - new y-coordinate of window origin
6339           Point - record receiving original origin
6340  Returns: Whether the call was successful
6341
6342  Sets the window origin of the device context by using the specified coordinates.
6343 ------------------------------------------------------------------------------}
6344function TQtWidgetSet.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean;
6345var
6346  P: TPoint;
6347begin
6348  {$ifdef VerboseQtWinAPI}
6349    WriteLn('[WinAPI SetWindowOrgEx] DC: ', dbghex(DC), ' NewX: ', dbgs(NewX), ' NewY: ', dbgs(NewY));
6350  {$endif}
6351
6352  Result := False;
6353
6354  if IsValidDC(DC) then
6355  begin
6356    GetWindowOrgEx(DC, @P);
6357    // restore 0, 0
6358    if (P.X <> 0) or (P.Y <> 0) then
6359      TQtDeviceContext(DC).translate(P.X, P.Y);
6360    if OldPoint <> nil then
6361      OldPoint^ := P;
6362    TQtDeviceContext(DC).translate(-NewX, -NewY);
6363    Result := True;
6364  end;
6365end;
6366
6367{------------------------------------------------------------------------------
6368  Method:  SetWindowPos
6369  Params: HWnd            - handle of window
6370          HWndInsertAfter - placement-order handle
6371          X               - horizontal position
6372          Y               - vertical position
6373          CX              - width
6374          CY              - height
6375          UFlags          - window-positioning flags
6376  Returns: If the function succeeds
6377
6378  Changes the size, position, and Z order of a child, pop-up, or top-level
6379  window.
6380 ------------------------------------------------------------------------------}
6381function TQtWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx,
6382  cy: Integer; uFlags: UINT): Boolean;
6383var
6384  DisableUpdates: boolean;
6385begin
6386  {$ifdef VerboseQtWinAPI}
6387    WriteLn('[WinAPI SetWindowPos] Handle: ', dbghex(hWnd),
6388      ' hWndInsertAfter: ',dbghex(hWnd));
6389  {$endif}
6390  Result := hWnd <> 0;
6391  if not Result then
6392    exit;
6393
6394  DisableUpdates := (SWP_NOREDRAW and uFlags) <> 0;
6395  if DisableUpdates then
6396    TQtWidget(Hwnd).setUpdatesEnabled(False);
6397  try
6398    if (SWP_NOMOVE and uFlags) = 0 then
6399      TQtWidget(Hwnd).move(X, Y);
6400
6401    if (SWP_NOSIZE and uFlags) = 0 then
6402      TQtWidget(Hwnd).resize(CX, CY);
6403
6404    if (SWP_SHOWWINDOW and uFlags) <> 0 then
6405      TQtWidget(Hwnd).Show;
6406
6407    if (SWP_HIDEWINDOW and uFlags) <> 0 then
6408      TQtWidget(Hwnd).Hide;
6409
6410    if (SWP_NOZORDER and uFlags) = 0 then
6411    begin
6412      case hWndInsertAfter of
6413        HWND_TOP:
6414          begin
6415            TQtWidget(hWnd).raiseWidget;
6416            if (SWP_NOACTIVATE and uFlags) = 0 then
6417              TQtWidget(hWnd).Activate;
6418          end;
6419        HWND_BOTTOM: TQtWidget(hWnd).lowerWidget;
6420        {TODO: HWND_TOPMOST ,HWND_NOTOPMOST}
6421      end;
6422    end;
6423  finally
6424    if DisableUpdates then
6425      TQtWidget(Hwnd).setUpdatesEnabled(True);
6426  end;
6427end;
6428
6429{------------------------------------------------------------------------------
6430  Method:  SetWindowRgn
6431  Params:  hWnd    - handle of the widget
6432           hRgn    - handle of the region
6433           bRedraw - ?
6434  Returns: 0 if the call failed, any other value if it was successful
6435
6436  Makes the region specifyed in hRgn be the only part of the window which is
6437  visible.
6438 ------------------------------------------------------------------------------}
6439function TQtWidgetSet.SetWindowRgn(hWnd: HWND;
6440 hRgn: HRGN; bRedraw: Boolean):longint;
6441var
6442  w: TQtWidget;
6443  r: TQtRegion;
6444begin
6445  Result := 0;
6446
6447  {$ifdef VerboseQtWinAPI}
6448    WriteLn('[WinAPI SetWindowRgn] Handle: ', dbghex(hWnd));
6449  {$endif}
6450
6451  // Basic checks
6452  if (hWnd = 0) or (hRgn = 0) then Exit;
6453
6454  w := TQtWidget(hWnd);
6455  r := TQtRegion(hRgn);
6456
6457  // Now set the mask in the widget
6458  w.setMask(r.FHandle);
6459
6460  Result := 1;
6461end;
6462
6463function TQtWidgetSet.ShowCaret(hWnd: HWND): Boolean;
6464begin
6465  Result := (hWnd <> 0) and (QtCaret.ShowCaret(TQtWidget(hWnd)));
6466end;
6467
6468{------------------------------------------------------------------------------
6469  Method:  SetProp
6470  Params:  Handle -
6471  Returns:
6472 ------------------------------------------------------------------------------}
6473function TQtWidgetSet.SetProp(Handle: hwnd; Str: PChar; Data: Pointer): Boolean;
6474begin
6475  if Handle<>0 then
6476  begin
6477    TQtWidget(Handle).Props[str] := Data;
6478    Result := (TQtWidget(Handle).Props[str]=Data);
6479    {$ifdef VerboseQtWinApi}
6480    DebugLn('[WinAPI SetProp win=%s str=%s data=%x',[dbgsname(TQtWidget(Handle)), str, ptrint(data)]);
6481    {$endif}
6482  end else
6483    Result := False;
6484end;
6485
6486{------------------------------------------------------------------------------
6487  Function: SetROP2
6488  Params:  HDC, Raster OP mode
6489  Returns: Old Raster OP mode
6490
6491  Please note that the bitwise raster operation modes, denoted with a
6492  RasterOp prefix, are only natively supported in the X11 and
6493  raster paint engines.
6494  This means that the only way to utilize these modes on the Mac is
6495  via a QImage.
6496  The RasterOp denoted blend modes are not supported for pens and brushes
6497  with alpha components. Also, turning on the QPainter::Antialiasing render
6498  hint will effectively disable the RasterOp modes.
6499 ------------------------------------------------------------------------------}
6500function TQtWidgetSet.SetROP2(DC: HDC; Mode: Integer): Integer;
6501var
6502  QtDC: TQtDeviceContext absolute DC;
6503begin
6504  {$ifdef VerboseQtWinAPI}
6505  writeln('TQtWidgetSet.SetROP2() DC ',dbghex(DC),' Mode ',Mode);
6506  {$endif}
6507  Result := R2_COPYPEN;
6508  if not IsValidDC(DC) then
6509    exit;
6510  Result := QtDC.Rop2;
6511  QtDC.Rop2 := Mode;
6512end;
6513
6514{------------------------------------------------------------------------------
6515  Function: SetScrollInfo
6516  Params:  none
6517  Returns: The new position value
6518
6519 ------------------------------------------------------------------------------}
6520function TQtWidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer;
6521  ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer;
6522var
6523  Control: TWinControl;
6524  ScrollBar: TQtScrollBar;
6525
6526  function UpdateScrollInfo: Integer;
6527  var
6528    iReCountMax: Integer;
6529    i: Integer;
6530    WheelLines: Integer;
6531  begin
6532    Scrollbar.BeginUpdate;
6533
6534    Result := 0;
6535
6536    if (ScrollInfo.FMask and SIF_RANGE) <> 0 then
6537    begin
6538      ScrollBar.setMinimum(ScrollInfo.nMin);
6539
6540      // we must recount ScrollBar.Max since invalid value raises AV
6541      iRecountMax := ScrollInfo.nMax - Integer(ScrollInfo.nPage);
6542      if iRecountMax < ScrollInfo.nMin then
6543        iRecountMax := ScrollInfo.nMin;
6544
6545      ScrollBar.setMaximum(iRecountMax);
6546    end;
6547
6548    if (ScrollInfo.FMask and SIF_PAGE) <> 0 then
6549    begin
6550      // segfaults if we don't check Enabled property
6551      if ScrollBar.getEnabled then
6552      begin
6553        ScrollBar.setPageStep(Integer(ScrollInfo.nPage));
6554        WheelLines := QApplication_wheelScrollLines();
6555        with Scrollbar do
6556        begin
6557          i := Max(1, floor((GetPageStep / WheelLines) / 6));
6558          setSingleStep(i);
6559        end;
6560      end;
6561    end;
6562
6563    if (ScrollInfo.FMask and SIF_UPDATEPOLICY) <> 0 then
6564      ScrollBar.setTracking(ScrollInfo.nTrackPos <> SB_POLICY_DISCONTINUOUS);
6565
6566    if (ScrollInfo.FMask and SIF_POS) <> 0 then
6567    begin
6568      if not (ScrollBar.getTracking and ScrollBar.getSliderDown) then
6569      begin
6570        if (ScrollInfo.nPos < ScrollBar.getMin) then
6571          ScrollInfo.nPos := ScrollBar.getMin
6572        else
6573        if (ScrollInfo.nPos > ScrollBar.getMax) then
6574          ScrollInfo.nPos := ScrollBar.getMax;
6575
6576        {related issues for setting pos are #16255, #19687 and #22187.
6577         Do not use ScrollBar.setValue here.}
6578        if (ScrollBar.getSliderPosition <> ScrollInfo.nPos) then
6579          ScrollBar.setSliderPosition(ScrollInfo.nPos);
6580        // setValue(ScrollInfo.nPos);
6581      end;
6582    end;
6583
6584    if (ScrollInfo.FMask and SIF_TRACKPOS) <> 0 then
6585    begin
6586      ScrollBar.TrackPos := ScrollInfo.nTrackPos;
6587      // from MSDN: the SetScrollInfo function ignores this member
6588      // ScrollBar.setSliderPosition(ScrollInfo.nTrackPos);
6589    end;
6590
6591    Result := ScrollBar.getSliderPosition;
6592
6593    ScrollBar.EndUpdate;
6594  end;
6595
6596begin
6597  // bRedraw is useles with qt
6598
6599  Result := 0;
6600
6601  if (Handle = 0) then exit;
6602
6603  ScrollBar := nil;
6604  case SBStyle of
6605    SB_BOTH:
6606    begin
6607      {TODO: SB_BOTH fixme }
6608      //writeln('TODO: ############## SB_BOTH CALLED HERE .... #################');
6609    end; {SB_BOTH}
6610
6611    SB_CTL:
6612    begin
6613      {HWND is always TScrollBar, but seem that Create ScrollBar should be called here }
6614      if (csReading in TQtWidget(Handle).LCLObject.ComponentState) or
6615      (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) then exit;
6616
6617      ScrollBar := TQtScrollBar(Handle);
6618
6619      if not Assigned(ScrollBar) then exit;
6620    end; {SB_CTL}
6621
6622    SB_HORZ:
6623    begin
6624      if (csReading in TQtWidget(Handle).LCLObject.ComponentState) or
6625         (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) then
6626        exit;
6627
6628      {$IFDEF QTSCROLLABLEFORMS}
6629      if (TQtWidget(Handle) is TQtMainWindow) then
6630      begin
6631        if Assigned(TQtMainWindow(Handle).ScrollArea) then
6632          Scrollbar := TQtMainWindow(Handle).ScrollArea.horizontalScrollBar
6633        else
6634          Scrollbar := nil;
6635      end else
6636      {$ENDIF}
6637      if TQtWidget(Handle) is TQtAbstractScrollArea then
6638      begin
6639        ScrollBar := TQtAbstractScrollArea(Handle).horizontalScrollBar;
6640      end else
6641      begin
6642        {do not localize !}
6643        Control := TWinControl(TQtWidget(Handle).LCLObject.FindChildControl(TQtWidget(Handle).LCLObject.Name+'_HSCROLLBAR'));
6644        if (Control <> nil) and (Control.HandleAllocated) then
6645          ScrollBar := TQtScrollBar(Control.Handle)
6646      end;
6647    end; {SB_HORZ}
6648
6649    SB_VERT:
6650    begin
6651      if (csReading in TQtWidget(Handle).LCLObject.ComponentState) or
6652        (csDestroying in TQtWidget(Handle).LCLObject.ComponentState) then
6653        exit;
6654
6655      {$IFDEF QTSCROLLABLEFORMS}
6656      if (TQtWidget(Handle) is TQtMainWindow) then
6657      begin
6658        if Assigned(TQtMainWindow(Handle).ScrollArea) then
6659          Scrollbar := TQtMainWindow(Handle).ScrollArea.verticalScrollBar
6660        else
6661          Scrollbar := nil;
6662      end else
6663      {$ENDIF}
6664      if TQtWidget(Handle) is TQtAbstractScrollArea then
6665      begin
6666        ScrollBar := TQtAbstractScrollArea(Handle).verticalScrollBar;
6667      end else
6668      begin
6669        {do not localize !}
6670        Control := TWinControl(TQtWidget(Handle).LCLObject.FindChildControl(TQtWidget(Handle).LCLObject.Name+'_VSCROLLBAR'));
6671        if (Control <> nil) and (Control.HandleAllocated) then
6672          ScrollBar := TQtScrollBar(Control.Handle)
6673      end;
6674    end; {SB_VERT}
6675
6676  end;
6677
6678  if Assigned(ScrollBar) then
6679    Result := UpdateScrollInfo;
6680end;
6681
6682{------------------------------------------------------------------------------
6683  Method:  SetTextColor
6684  Params:  Handle -
6685  Returns:
6686 ------------------------------------------------------------------------------}
6687function TQtWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
6688begin
6689  {$ifdef VerboseQtWinAPI}
6690    WriteLn('[WinAPI SetTextColor] DC: ', dbghex(DC));
6691  {$endif}
6692  Result := CLR_INVALID;
6693  if not IsValidDC(DC) then begin
6694    {$ifdef VerboseQtWinAPI}
6695    WriteLn('[WinAPI SetTextColor] Invalid DC');
6696    {$endif}
6697    exit;
6698  end;
6699  Result := TQtDeviceContext(DC).vTextColor;
6700  TQtDeviceContext(DC).vTextColor := ColorToRGB(TColor(Color)); // be sure we get TColorRef
6701end;
6702
6703{------------------------------------------------------------------------------
6704  function ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean;
6705  Params  Handle: HWND; wBar: Integer; bShow: Boolean
6706  Result
6707------------------------------------------------------------------------------}
6708function TQtWidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean;
6709var
6710  w: TQtWidget;
6711  ScrollArea: TQtAbstractScrollArea;
6712begin
6713  {$ifdef VerboseQtWinAPI}
6714    WriteLn('[WinAPI ShowScrollBar] Handle: ', dbghex(Handle),' wBar: ',wBar);
6715  {$endif}
6716
6717  Result := (Handle <> 0);
6718
6719  if not Result then exit;
6720
6721  w := TQtWidget(Handle);
6722
6723  {$IFDEF QTSCROLLABLEFORMS}
6724  if (w is TQtMainWindow) and Assigned(TQtMainWindow(w).ScrollArea) then
6725    w := TQtMainWindow(Handle).ScrollArea;
6726  {$ENDIF}
6727  if w is TQtAbstractScrollArea then
6728  begin
6729    ScrollArea := TQtAbstractScrollArea(w);
6730    case wBar of
6731      SB_BOTH:
6732      begin
6733        if bShow then
6734          ScrollArea.setScrollStyle(ssBoth)
6735        else
6736          ScrollArea.setScrollStyle(ssNone);
6737      end;
6738
6739      SB_HORZ:
6740      begin
6741        if bShow then
6742          ScrollArea.setScrollStyle(ssHorizontal)
6743        else
6744          ScrollArea.ScrollBarPolicy[False] := QtScrollBarAlwaysOff;
6745      end;
6746
6747      SB_VERT:
6748      begin
6749        if bShow then
6750          ScrollArea.setScrollStyle(ssVertical)
6751        else
6752          ScrollArea.ScrollBarPolicy[True] := QtScrollBarAlwaysOff;
6753      end;
6754
6755      SB_CTL:
6756      begin
6757        if bShow then
6758          ScrollArea.Show
6759        else
6760          ScrollArea.Hide;
6761      end;
6762    end;
6763
6764  end else
6765    Result := False;
6766end;
6767
6768{------------------------------------------------------------------------------
6769  function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
6770
6771  nCmdShow:
6772    SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
6773------------------------------------------------------------------------------}
6774function TQtWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
6775var
6776  Widget: TQtWidget;
6777begin
6778  {$ifdef VerboseQtWinAPI}
6779  WriteLn('[WinAPI ShowWindow] hwnd ',dbgHex(PtrUInt(hWnd)),' nCmdShow ',nCmdShow);
6780  {$endif}
6781
6782  Result := False;
6783
6784  Widget := TQtWidget(hWnd);
6785
6786  if Widget <> nil then
6787  begin
6788    case nCmdShow of
6789      SW_SHOW: Widget.setVisible(True);
6790      SW_SHOWNORMAL: Widget.ShowNormal;
6791      SW_MINIMIZE: Widget.setWindowState(QtWindowMinimized);
6792      SW_SHOWMINIMIZED: Widget.ShowMinimized;
6793      SW_SHOWMAXIMIZED: Widget.ShowMaximized;
6794      SW_SHOWFULLSCREEN: Widget.ShowFullScreen;
6795      SW_HIDE: Widget.setVisible(False);
6796    end;
6797    {$IFDEF HASX11}
6798    if (nCmdShow <> SW_HIDE) and (Widget is TQtMainWindow)
6799      and not TQtMainWindow(Widget).IsMdiChild
6800      and not TQtMainWindow(Widget).IsMainForm
6801      and not TQtMainWindow(Widget).ShowOnTaskBar then
6802        SetSkipX11Taskbar(Widget.Widget, True);
6803    {$ENDIF}
6804    if (Byte(nCmdShow) in [SW_SHOW, SW_SHOWNORMAL, SW_SHOWMAXIMIZED, SW_SHOWFULLSCREEN]) and
6805      (Widget is TQtMainWindow) then
6806        TQtMainWindow(Widget).Activate;
6807    Result := True;
6808  end;
6809end;
6810
6811{------------------------------------------------------------------------------
6812  Function: StretchBlt
6813  Params:  DestDC:                The destination devicecontext
6814           X, Y:                  The left/top corner of the destination rectangle
6815           Width, Height:         The size of the destination rectangle
6816           SrcDC:                 The source devicecontext
6817           XSrc, YSrc:            The left/top corner of the source rectangle
6818           SrcWidth, SrcHeight:   The size of the source rectangle
6819           ROp:                   The raster operation to be performed
6820  Returns: True if succesful
6821
6822  The StretchBlt function copies a bitmap from a source rectangle into a
6823  destination rectangle using the specified raster operation. If needed it
6824  resizes the bitmap to fit the dimensions of the destination rectangle.
6825  Sizing is done according to the stretching mode currently set in the
6826  destination device context.
6827  If SrcDC contains a mask the pixmap will be copied with this transparency.
6828 ------------------------------------------------------------------------------}
6829function TQtWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
6830  SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean;
6831begin
6832  Result := StretchMaskBlt(DestDC,X,Y,Width,Height,
6833                          SrcDC,XSrc,YSrc,SrcWidth,SrcHeight,
6834                          0,0,0,
6835                          ROp);
6836end;
6837
6838{------------------------------------------------------------------------------
6839  Function: StretchMaskBlt
6840  Params:  DestDC:                The destination devicecontext
6841           X, Y:                  The left/top corner of the destination rectangle
6842           Width, Height:         The size of the destination rectangle
6843           SrcDC:                 The source devicecontext
6844           XSrc, YSrc:            The left/top corner of the source rectangle
6845           SrcWidth, SrcHeight:   The size of the source rectangle
6846           Mask:                  The handle of a monochrome bitmap
6847           XMask, YMask:          The left/top corner of the mask rectangle
6848           ROp:                   The raster operation to be performed
6849  Returns: True if succesful
6850
6851  The StretchMaskBlt function copies a bitmap from a source rectangle into a
6852  destination rectangle using the specified mask and raster operation. If needed
6853  it resizes the bitmap to fit the dimensions of the destination rectangle.
6854  Sizing is done according to the stretching mode currently set in the
6855  destination device context.
6856 ------------------------------------------------------------------------------}
6857function TQtWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
6858  SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
6859  XMask, YMask: Integer; Rop: DWORD): Boolean;
6860var
6861  SrcQDC: TQtDeviceContext absolute SrcDC;
6862  DstQDC: TQtDeviceContext absolute DestDC;
6863  SrcRect, DstRect, MaskRect: TRect;
6864  Image, TmpImage, QMask, TmpMask: QImageH;
6865  TmpPixmap: QPixmapH;
6866  SrcMatrix: QTransformH;
6867  dx, dy: integer;
6868  OldRop: Integer;
6869  OldBkColor: TColorRef;
6870  RestoreClip: Boolean;
6871  AClipRect: TRect;
6872  AWidgetID: LongWord;
6873
6874  function NeedScaling(const ADstRect, ASrcRect: TRect): boolean;
6875  var
6876    R: TRect;
6877    TgtW, TgtH,
6878    ClpW, ClpH: integer;
6879  begin
6880    if not DstQDC.getClipping then
6881      exit((Width <> SrcWidth) or (Height <> SrcHeight));
6882
6883    R := DstQDC.getClipRegion.getBoundingRect;
6884
6885    TgtW := ADstRect.Right - ADstRect.Left;
6886    TgtH := ADstRect.Bottom - ADstRect.Top;
6887    ClpW := R.Right - R.Left;
6888    ClpH := R.Bottom - R.Top;
6889
6890    Result := PtInRect(R, Point(R.Left + 1, R.Top + 1)) and
6891      (((ClpW <= TgtW) and (ClpH <= TgtH)) or ((TgtW < SrcWidth) and (TgtH < SrcHeight)));
6892  end;
6893
6894  procedure RenderPixmap(APixmap: QPixmapH; AMaskImg: QImageH; const AHighQuality: boolean);
6895  var
6896    ATempPixmap: QPixmapH;
6897    ABitmap: QBitmapH;
6898    AMaskPix, AScaledPix: QPixmapH;
6899    ARenderHints: QPainterRenderHints;
6900    ARenderHint: Boolean;
6901  begin
6902    ATempPixmap := QPixmap_create();
6903
6904    ARenderHints := QPainter_renderHints(DstQDC.Widget);
6905    ARenderHint := (AHighQuality and not EqualRect(DstRect, SrcRect)) and
6906      ((ARenderHints and QPainterAntialiasing <> 0) or (ARenderHints and QPainterSmoothPixmapTransform <> 0) or
6907       (ARenderHints and QPainterHighQualityAntialiasing <> 0));
6908
6909    if ARenderHint and (ARenderHints and QPainterSmoothPixmapTransform <> 0) then
6910      ARenderHint := False; // do not touch render hints
6911
6912    if NeedScaling(DstRect, SrcRect) then
6913      QPixmap_scaled(APixmap, ATempPixmap, Width, Height)
6914    else
6915      QPixmap_copy(APixmap, ATempPixmap, 0, 0, QPixmap_width(APixmap), QPixmap_height(APixmap));
6916
6917
6918    if AMaskImg <> nil then
6919    begin
6920      // apply mask to pixmap
6921      AScaledPix := QPixmap_create();
6922      AMaskPix := QPixmap_create();
6923      QPixmap_fromImage(AMaskPix, AMaskImg);
6924      try
6925        if IsRectEmpty(MaskRect) or (MaskRect.Size <> DstRect.Size) then
6926        begin
6927          if (QPixmap_width(ATempPixmap) < (DstRect.Right - DstRect.Left)) or
6928            (QPixmap_Height(ATempPixmap) < (DstRect.Bottom - DstRect.Top)) then
6929            QPixmap_scaled(AMaskPix, AScaledPix, QPixmap_width(ATempPixmap), QPixmap_height(ATempPixmap))
6930          else
6931            QPixmap_scaled(AMaskPix, AScaledPix, Width, Height);
6932        end else
6933        begin
6934          QPixmap_copy(AMaskPix, AScaledPix, MaskRect.Left, MaskRect.Top,
6935            MaskRect.Right - MaskRect.Left, MaskRect.Bottom - MaskRect.Top);
6936        end;
6937
6938        ABitmap := QBitmap_Create(AScaledPix);
6939
6940        QPixmap_setMask(ATempPixmap, ABitmap);
6941        QBitmap_Destroy(ABitmap);
6942        QPixmap_destroy(AScaledPix);
6943      finally
6944        QPixmap_destroy(AMaskPix);
6945      end;
6946    end;
6947
6948    if ARenderHint then
6949      QPainter_setRenderHint(DstQDC.Widget, QPainterSmoothPixmapTransform, True);
6950
6951    QPainter_drawPixmap(DstQDC.Widget, X, Y, Width, Height, ATempPixmap);
6952
6953    if ARenderHint then
6954      QPainter_setRenderHint(DstQDC.Widget, QPainterSmoothPixmapTransform, not ARenderHint);
6955
6956    QPixmap_destroy(ATempPixmap);
6957  end;
6958
6959begin
6960  {$ifdef VerboseQtWinAPI}
6961    WriteLn('[WinAPI StretchMaskBlt]',
6962     ' DestDC:', dbghex(DestDC),
6963     ' SrcDC:', dbghex(SrcDC),
6964     ' Image:', dbghex(PtrInt(Image)),
6965     ' X:', dbgs(X), ' Y:', dbgs(Y),
6966     ' W:', dbgs(Width), ' H:', dbgs(Height),
6967     ' XSrc:', dbgs(XSrc), ' YSrc:', dbgs(YSrc),
6968     ' WSrc:', dbgs(SrcWidth), ' HSrc:', dbgs(SrcHeight),' Rop: ',dbgs(Rop));
6969  {$endif}
6970
6971  Result := False;
6972
6973  SrcMatrix := QPainter_transform(SrcQDC.Widget);
6974
6975  QTransform_map(SrcMatrix, XSrc, YSrc, @XSrc, @YSrc);
6976  // our map can have some transformations
6977  if XSrc < 0 then // we cannot draw from negative coord, so we will draw from zero with shift
6978  begin
6979    dx := -XSrc;
6980    XSrc := 0;
6981  end
6982  else
6983    dx := 0;
6984
6985  if YSrc < 0 then
6986  begin
6987    dy := -YSrc;
6988    YSrc := 0;
6989  end
6990  else
6991    dy := 0;
6992
6993  if dx <> 0 then // apply shifts
6994  begin
6995    inc(X, dx);        // shift destination
6996    dec(Width, dx);    // substract width
6997    dec(SrcWidth, dx); // and do not forget about SrcWidth or we will get unneeded stretching
6998  end;
6999
7000  if dy <> 0 then
7001  begin
7002    inc(Y, dy);
7003    dec(Height, dy);
7004    dec(SrcHeight, dy);
7005  end;
7006
7007  DstRect := Bounds(X, Y, Width, Height);
7008  SrcRect := Bounds(XSrc, YSrc, SrcWidth, SrcHeight);
7009  MaskRect := Bounds(XMask, YMask, SrcWidth, SrcHeight);
7010
7011  if Mask <> 0 then
7012    QMask := TQtImage(Mask).Handle
7013  else
7014    QMask := nil;
7015
7016  if ((Rop = SRCCOPY) and (SrcQDC.vImage <> nil) and (SrcQDC.vImage.Handle <> nil))
7017    and not ((DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top)) then
7018  begin
7019    //issue #32137
7020    TmpImage := QImage_Create();
7021    QImage_copy(SrcQDC.vImage.Handle, TmpImage, XSrc, YSrc, SrcWidth, SrcHeight);
7022
7023    // #11713, #25590
7024    if (QImage_format(TmpImage) = QImageFormat_RGB32) then
7025    begin
7026      Image := QImage_create();
7027      QImage_convertToFormat(TmpImage, Image, QImageFormat_ARGB32);
7028      QImage_destroy(TmpImage);
7029      TmpImage := QImage_create(Image);
7030      QImage_destroy(Image);
7031    end;
7032
7033    TmpPixmap := QPixmap_create();
7034    QPixmap_fromImage(TmpPixmap, TmpImage);
7035
7036    RenderPixmap(TmpPixmap, QMask,
7037      QImage_format(SrcQDC.vImage.Handle) = QImageFormat_ARGB32);
7038    QImage_destroy(TmpImage);
7039    QPixmap_destroy(TmpPixmap);
7040    exit(True);
7041  end else
7042  if SrcQDC.vImage = nil then
7043  begin
7044    if SrcQDC.Parent <> nil then
7045    begin
7046      AWidgetID := QWidget_winId(SrcQDC.Parent);
7047
7048      if (Rop = SRCCOPY) and not ((DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top)) then
7049      begin
7050        TmpPixmap := QPixmap_create();
7051        QPixmap_grabWindow(TmpPixmap, AWidgetID, XSrc,  YSrc, SrcWidth, SrcHeight);
7052        RenderPixmap(TmpPixmap, QMask, QPixmap_hasAlphaChannel(TmpPixmap));
7053        QPixmap_destroy(TmpPixmap);
7054        exit(True);
7055      end else
7056      begin
7057        with SrcQDC.getDeviceSize do
7058          TmpPixmap := QPixmap_create(x, y);
7059        QPixmap_grabWindow(TmpPixmap, AWidgetID, 0, 0);
7060        Image := QImage_create();
7061        QPixmap_toImage(TmpPixmap, Image);
7062        QPixmap_destroy(TmpPixmap);
7063      end;
7064    end
7065    else
7066      Exit;
7067  end
7068  else
7069    Image := SrcQDC.vImage.Handle;
7070
7071  if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then
7072  begin
7073    // Right < Left mean horizontal flip, Bottom < Top - vertical
7074    TmpImage := QImage_create();
7075    QImage_mirrored(Image, TmpImage, DstRect.Right < DstRect.Left, DstRect.Bottom < DstRect.Top);
7076    if QMask <> nil then
7077    begin
7078      TmpMask := QImage_create();
7079      QImage_mirrored(QMask, TmpMask, DstRect.Right < DstRect.Left, DstRect.Bottom < DstRect.Top);
7080    end
7081    else
7082      TmpMask := QMask;
7083    DstRect := NormalizeRect(DstRect);
7084    MaskRect := NormalizeRect(MaskRect);
7085
7086    OldRop := DstQDC.Rop2;
7087    if Rop <> SRCCOPY then
7088      DstQDC.Rop2 := Integer(Rop);
7089    try
7090      DstQDC.drawImage(@DstRect, TmpImage, @SrcRect, TmpMask, @MaskRect);
7091    finally
7092      if Rop <> SRCCOPY then
7093        DstQDC.Rop2 := OldRop;
7094    end;
7095
7096    QImage_destroy(TmpImage);
7097    if TmpMask <> nil then
7098      QImage_destroy(TmpMask);
7099  end else
7100  begin
7101    if (Rop = PATCOPY) then
7102    begin
7103      OldRop := DstQDC.Rop2;
7104      DstQDC.Rop2 := SRCCOPY;
7105      try
7106        DstQDC.setBrush(DstQDC.BackgroundBrush);
7107        with DstRect do
7108          DstQDC.fillRect(Left, Top, Right - Left, Bottom - Top);
7109      finally
7110        DstQDC.Rop2 := OldRop;
7111      end;
7112    end else
7113    if (Rop = BLACKNESS) or (Rop = WHITENESS) then
7114    begin
7115      OldRop := DstQDC.Rop2;
7116      DstQDC.Rop2 := SRCCOPY;
7117      try
7118        if (Rop = BLACKNESS) then
7119          OldBkColor := DstQDC.SetBkColor(clBlack)
7120        else
7121          OldBkColor := DstQDC.SetBkColor(clWhite);
7122        with DstRect do
7123          DstQDC.fillRect(Left, Top, Right - Left, Bottom - Top);
7124      finally
7125        DstQDC.SetBkColor(OldBkColor);
7126        DstQDC.Rop2 := OldRop;
7127      end;
7128    end else
7129    begin
7130      OldRop := DstQDC.Rop2;
7131      if Rop <> SRCCOPY then
7132        DstQDC.Rop2 := Integer(Rop);
7133      try
7134        RestoreClip := False;
7135        if ((SrcRect.Left < DstRect.Left) or (SrcRect.Top < DstRect.Top)) and
7136          DstQDC.getClipping and DstQDC.getClipRegion.containsRect(SrcRect) then
7137        begin
7138          AClipRect := DstQDC.getClipRegion.getBoundingRect;
7139          OffsetRect(AClipRect, -AClipRect.Left, -AClipRect.Top);
7140
7141          if (DstRect.Right - DstRect.Left <= AClipRect.Right) and
7142            (DstRect.Bottom - DstRect.Top <= AClipRect.Bottom) and
7143            DstQDC.getClipRegion.containsPoint(DstRect.Left, DstRect.Top) then
7144          begin
7145            if (QPaintEngine_type(DstQDC.PaintEngine) = QPaintEngineRaster) then
7146            begin
7147              // issue #26744 - only affects raster engine.
7148              RestoreClip := ((DstRect.Left > 0) or (DstRect.Top > 0)) and
7149                (DstRect.Right - DstRect.Left - AClipRect.Right - AClipRect.Left = 0) and
7150                (DstRect.Bottom - DstRect.Top - AClipRect.Bottom - AClipRect.Top = 0);
7151            end else
7152              // issue #26342, unset clipping only when transform is dirty with non raster engine.
7153              RestoreClip := QPaintEngine_testDirty(DstQDC.PaintEngine, QPaintEngineDirtyTransform);
7154            if RestoreClip then
7155              DstQDC.setClipping(False);
7156          end;
7157        end;
7158        DstQDC.drawImage(@DstRect, Image, @SrcRect, QMask, @MaskRect);
7159        if RestoreClip then
7160          DstQDC.setClipping(True);
7161      finally
7162        if Rop <> SRCCOPY then
7163          DstQDC.Rop2 := OldRop;
7164      end;
7165    end;
7166  end;
7167
7168  if SrcQDC.vImage = nil then
7169    QImage_destroy(Image);
7170
7171  Result := True;
7172end;
7173
7174{------------------------------------------------------------------------------
7175  Function: SystemParametersInfo
7176  Params: uiAction: System-wide parameter to be retrieved or set
7177          uiParam: Depends on the system parameter being queried or set
7178          pvParam: Depends on the system parameter being queried or set
7179          fWinIni:
7180  Returns: True if the function succeeds
7181  retrieves or sets the value of one of the system-wide parameters
7182 ------------------------------------------------------------------------------}
7183function TQtWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool;
7184var
7185  ADesktop: QDesktopWidgetH;
7186  AScreen: Integer;
7187  R: TRect;
7188begin
7189  case uiAction of
7190    SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := QApplication_wheelScrollLines;
7191    SPI_GETWORKAREA:
7192    begin
7193      ADesktop := QApplication_desktop();
7194      AScreen := QDesktopWidget_primaryScreen(ADesktop);
7195      QDesktopWidget_availableGeometry(ADesktop, @R, AScreen);
7196      TRect(pvParam^) := R;
7197      Result:=True;
7198    end;
7199  else
7200    Result := False;
7201  end
7202end;
7203
7204{------------------------------------------------------------------------------
7205  Function: TextOut
7206  Params: DC:
7207          X:
7208          Y:
7209          Str:
7210          Count:
7211  Returns:
7212
7213 ------------------------------------------------------------------------------}
7214function TQtWidgetSet.TextOut(DC: HDC; X, Y: Integer; Str: Pchar; Count: Integer
7215  ): Boolean;
7216var
7217  WStr: WideString;
7218begin
7219  {$ifdef VerboseQtWinAPI}
7220    WriteLn('[WinAPI TextOut]');
7221  {$endif}
7222
7223  Result := False;
7224
7225  if not IsValidDC(DC) then Exit;
7226
7227  if Count >= 0 then
7228    WStr := {%H-}Copy(Str, 1, Count)
7229  else
7230    WStr := Str;
7231
7232  TQtDeviceContext(DC).drawText(X, Y, @WStr);
7233
7234  Result := True;
7235end;
7236
7237{------------------------------------------------------------------------------
7238  Method:  UpdateWindow
7239  Params:  Handle
7240  Returns:
7241 ------------------------------------------------------------------------------}
7242function TQtWidgetSet.UpdateWindow(Handle: HWND): Boolean;
7243begin
7244 {$ifdef VerboseQtWinAPI}
7245   WriteLn('[WinAPI UpdateWindow]');
7246 {$endif}
7247  Result := False;
7248  if Handle <> 0 then
7249  begin
7250    TQtWidget(Handle).Update;
7251    Result := True;
7252  end;
7253end;
7254
7255{------------------------------------------------------------------------------
7256  Method:  WindowFromPoint
7257  Params:  TPoint
7258  Returns: The return value is a handle to the window that contains the param
7259  point.
7260  If no window exists at the given point, the return value is 0.
7261  If the point is over a static text control,
7262  the return value is a handle to the window under the static text control.
7263 ------------------------------------------------------------------------------}
7264function TQtWidgetSet.WindowFromPoint(APoint: TPoint): HWND;
7265var
7266  Widget: QWidgetH;
7267begin
7268  // we use cachedresults instead of calling very expensive widgetAt
7269  if (FLastWFPResult <> 0) then
7270  begin
7271    if not IsValidWidgetAtCachePointer then
7272      FLastWFPResult := 0
7273    else
7274    if (APoint.X = FLastWFPMousePos.X) and (APoint.Y = FLastWFPMousePos.Y) and
7275      TQtWidget(FLastWFPResult).getVisible and
7276      TQtWidget(FLastWFPResult).getEnabled then
7277    begin
7278      // return from cache
7279      exit(FLastWFPResult);
7280    end;
7281  end;
7282
7283  Result := 0;
7284  Widget := QApplication_widgetAt(APoint.x, APoint.y);
7285
7286  if (Widget = nil) then
7287  begin
7288    if (APoint.X = FLastWFPMousePos.X) and (APoint.Y = FLastWFPMousePos.Y) then
7289    begin
7290      FLastWFPMousePos := Point(MaxInt, MaxInt);
7291      FLastWFPResult := 0;
7292    end;
7293    exit;
7294  end;
7295
7296  // according to MSDN disabled widget shouldn't be in result
7297  // but win32 returns first enabled and visible parent !
7298  if not QWidget_isEnabled(Widget) or not QWidget_isVisible(Widget) then
7299  begin
7300    while Widget <> nil do
7301    begin
7302      Widget := QWidget_parentWidget(Widget);
7303      if (Widget <> nil) and QWidget_IsVisible(Widget) and
7304        QWidget_isEnabled(Widget) then
7305          break;
7306    end;
7307    if Widget = nil then
7308      exit;
7309  end;
7310
7311  Result := HwndFromWidgetH(Widget);
7312
7313  // return from cache if we are same TQtWidget, just update point
7314  if IsValidWidgetAtCachePointer and (Result = FLastWFPResult) then
7315  begin
7316    FLastWFPMousePos := APoint;
7317    exit(FLastWFPResult);
7318  end;
7319
7320  // maybe we are viewport of native QAbstractScrollArea (eg. QTextEdit).
7321  if (Result = 0) then
7322  begin
7323    if QWidget_parentWidget(Widget) <> nil then
7324    begin
7325      while (Widget <> nil) do
7326      begin
7327        Widget := QWidget_parentWidget(Widget);
7328        if Widget <> nil then
7329          Result := HwndFromWidgetH(Widget);
7330        if Result <> 0 then
7331          break;
7332      end;
7333    end;
7334  end;
7335
7336  if (Result <> 0) and
7337    not (TQtWidget(Result) is TQtMainWindow) then
7338  begin
7339    if TQtWidget(Result).getOwner <> nil then
7340      Result := HWND(TQtWidget(Result).getOwner);
7341  end else
7342  begin
7343    Widget := QApplication_topLevelAt(APoint.x, APoint.y);
7344    if (Widget <> nil) and QWidget_isEnabled(Widget) then
7345      Result := HwndFromWidgetH(Widget)
7346    else
7347      Result := 0;
7348  end;
7349
7350  // add to cache
7351  FLastWFPResult := Result;
7352  FLastWFPMousePos := APoint;
7353end;
7354
7355//##apiwiz##eps##   // Do not remove, no wizard declaration after this line
7356