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