← Back to branch summary

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

« back to all changes in this revision

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