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