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