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