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