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