← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/customdrawn/customdrawnwinapi_android.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

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