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