1{%MainUnit gtk3int.pas} 2 3function TGtk3WidgetSet.Arc(DC: HDC; Left, top, right, bottom, angle1, 4 angle2: Integer): Boolean; 5begin 6 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 7 DebugLn('WARNING: TGtk3WidgetSet.Arc not implemented ...'); 8 {$ENDIF} 9 Result:=inherited Arc(DC, Left, top, right, bottom, angle1, angle2); 10end; 11 12function TGtk3WidgetSet.AngleChord(DC: HDC; x1, y1, x2, y2, angle1, 13 angle2: Integer): Boolean; 14begin 15 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 16 DebugLn('WARNING: TGtk3WidgetSet.AngleChord not implemented ...'); 17 {$ENDIF} 18 Result:=inherited AngleChord(DC, x1, y1, x2, y2, angle1, angle2); 19end; 20 21function TGtk3WidgetSet.BeginPaint(Handle: hWnd; var PS: TPaintStruct): hdc; 22var 23 Widget: TGtk3Widget; 24 GtkWidget: PGtkWidget; 25 DC: TGtk3DeviceContext; 26begin 27 Widget := TGtk3Widget(Handle); 28 if Widget <> nil then 29 begin 30 GtkWidget := Widget.GetContainerWidget; 31 if Widget.CairoContext <> nil then 32 DC := TGtk3DeviceContext.CreateFromCairo(GtkWidget, Widget.CairoContext) 33 else 34 DC := TGtk3DeviceContext.Create(GtkWidget, True); 35 end 36 else 37 DC := TGtk3DeviceContext.Create(PGtkWidget(nil), True); 38 39 PS.hdc := HDC(DC); 40 41 if Handle<>0 then 42 begin 43 DC.vClipRect := Widget.PaintData.ClipRect^; 44 (* 45 // if current handle has paintdata information, 46 // setup hdc with it 47 //DC.DebugClipRect('BeginPaint: Before'); 48 if Widget.PaintData.ClipRegion <> nil then 49 begin 50 //Write('>>> Setting Paint ClipRegion: '); 51 //DebugRegion('PaintData.ClipRegion: ', Widget.PaintData.ClipRegion); 52 DC.setClipRegion(Widget.PaintData.ClipRegion); 53 DC.setClipping(True); 54 end; 55 if Widget.PaintData.ClipRect <> nil then 56 begin 57 New(DC.vClipRect); 58 DC.vClipRect^ := Widget.PaintData.ClipRect^; 59 end; 60 *) 61 end; 62 63 Result := PS.hdc; 64end; 65 66function TGtk3WidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; 67 SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; 68begin 69 {$ifdef VerboseGtk3DeviceContext} 70 WriteLn('Trace:> [TGtk3WidgetSet.BitBlt]'); 71 {$endif} 72 Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, 73 Height, ROP); 74 75 {$ifdef VerboseGtk3DeviceContext} 76 WriteLn('Trace:< [TGtk3WidgetSet.BitBlt]'); 77 {$endif} 78end; 79 80function TGtk3WidgetSet.CallNextHookEx(hHk: HHOOK; ncode: Integer; 81 wParam: WParam; lParam: LParam): Integer; 82begin 83 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 84 DebugLn('WARNING: TGtk3WidgetSet.CallNextHookEx not implemented ...'); 85 {$ENDIF} 86 Result:=inherited CallNextHookEx(hHk, ncode, wParam, lParam); 87end; 88 89function TGtk3WidgetSet.CallWindowProc(lpPrevWndFunc: TFarProc; Handle: HWND; 90 Msg: UINT; wParam: WParam; lParam: lParam): Integer; 91begin 92 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 93 DebugLn('WARNING: TGtk3WidgetSet.CallWindowProc not implemented ...'); 94 {$ENDIF} 95 Result:=inherited CallWindowProc(lpPrevWndFunc, Handle, Msg, wParam, lParam); 96end; 97 98function TGtk3WidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean; 99begin 100 {$ifdef VerboseGtk3WinApi} 101 DebugLn('Trace:> [TGtk3WidgetSet.ClientToScreen] ',dbgs(P)); 102 {$endif} 103 // Result:=inherited ClientToScreen(Handle, P); 104 Result := False; 105 P := Point(0, 0); 106 if IsValidHandle(Handle) then 107 Result := TGtk3Widget(Handle).ClientToScreen(P); 108 {$ifdef VerboseGtk3WinApi} 109 DebugLn('Trace:< [TGtk3WidgetSet.ClientToScreen] ',dbgs(P),' result=',dbgs(Result)); 110 {$endif} 111end; 112 113function TGtk3WidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat 114 ): string; 115begin 116 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 117 DebugLn('WARNING: TGtk3WidgetSet.ClipboardFormatToMimeType not implemented ...'); 118 {$ENDIF} 119 Result:=inherited ClipboardFormatToMimeType(FormatID); 120end; 121 122const 123 sPrimary = 'PRIMARY'; 124 sClipboard = 'CLIPBOARD'; 125 126function TGtk3WidgetSet.ClipboardGetData(ClipboardType: TClipboardType; 127 FormatID: TClipboardFormat; Stream: TStream): boolean; 128var 129 pclp:PGtkClipboard; 130 pc:pgchar; 131 pcname:PgdkAtom; 132begin 133 case ClipboardType of 134 ctPrimarySelection: pcname:=TGdkAtom.intern(sPrimary,false); 135 ctSecondarySelection: pcname:=nil; 136 ctClipboard: pcname:=TGdkAtom.intern(sClipboard,false); 137 end; 138 if not Assigned(pcname) then exit; 139 pclp:=TGtkClipboard.get(pcname); 140 if not Assigned(pclp) then exit(false); 141 // text handling 142 //pclp^.request_text(@ClipboardTextReceivedFunc,Stream); 143 pc:=pclp^.wait_for_text; 144 Stream.Write(pc^,strlen(pc)); 145 Result:=true; 146end; 147 148function TGtk3WidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType; 149 var Count: integer; var List: PClipboardFormat): boolean; 150begin 151 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 152 DebugLn('WARNING: TGtk3WidgetSet.ClipboardGetFormats not implemented ...'); 153 {$ENDIF} 154 Result:=inherited ClipboardGetFormats(ClipboardType, Count, List); 155end; 156 157function TGtk3WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType; 158 OnRequestProc: TClipboardRequestEvent; FormatCount: integer; 159 Formats: PClipboardFormat): boolean; 160var 161 pclp:PGtkClipboard; 162 pcname:PgdkAtom; 163begin 164 case ClipboardType of 165 ctPrimarySelection: pcname:=TGdkAtom.intern(sPrimary,false); 166 ctSecondarySelection: pcname:=nil; 167 ctClipboard: pcname:=TGdkAtom.intern(sClipboard,false); 168 end; 169 if not Assigned(pcname) then exit; 170 pclp:=TGtkClipboard.get(pcname); 171 if not Assigned(pclp) then exit(false); 172{ // text handling 173 //pclp^.request_text(@ClipboardTextReceivedFunc,Stream); 174 pc:=pclp^.wait_for_text; 175 Stream.Write(pc^,strlen(pc)); } 176 Result:=true; 177end; 178 179function TGtk3WidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; 180begin 181 if Assigned(Application) then 182 Result := {%H-}TClipboardFormat(TGdkAtom.intern(PChar(AMimeType), False)) 183 else 184 RaiseGDBException( 185 'ERROR: TGtk3WidgetSet.ClipboardRegisterFormat gdk not initialized'); 186end; 187 188function TGtk3WidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; 189 fnCombineMode: Longint): Longint; 190var 191 RDest,RSrc1,RSrc2: Pcairo_region_t; 192 AStatus: cairo_status_t; 193 ACairoRect: Tcairo_rectangle_int_t; 194begin 195 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 196 // DebugLn('WARNING: TGtk3WidgetSet.CombineRgn not implemented ...'); 197 {$ENDIF} 198 Result := ERROR; 199 if not IsValidGDIObject(Dest) or not IsValidGDIObject(Src1) then 200 exit; 201 RDest := TGtk3Region(Dest).Handle; 202 RSrc1 := TGtk3Region(Src1).Handle; 203 if (fnCombineMode<>RGN_COPY) and not IsValidGDIObject(Src2) then 204 exit 205 else 206 RSrc2 := TGtk3Region(Src2).Handle; 207 AStatus := CAIRO_STATUS_READ_ERROR; 208 case fnCombineMode of 209 RGN_AND: 210 begin 211 AStatus := cairo_region_intersect(RSrc1, RSrc2); 212 // cairo cannot intersect empty region 213 if cairo_region_is_empty(RDest) then 214 begin 215 cairo_region_destroy(TGtk3Region(Dest).Handle); 216 cairo_region_get_extents(RSrc1, @ACairoRect); 217 TGtk3Region(Dest).Handle := cairo_region_create_rectangle(@ACairoRect); 218 RDest := TGtk3Region(Dest).Handle; 219 //cairo_region_translate(RDest, -ACairoRect.x, -ACairoRect.y); 220 end else 221 AStatus := cairo_region_intersect(RDest, RSrc1); 222 end; 223 RGN_COPY: 224 begin 225 AStatus := cairo_region_intersect(RDest, RSrc1); 226 // writeln('CombineRgn RGN_COPY ',AStatus); 227 end; 228 RGN_DIFF: 229 begin 230 AStatus := cairo_region_subtract(RSrc1, RSrc2); 231 if cairo_region_is_empty(RDest) then 232 begin 233 cairo_region_destroy(TGtk3Region(Dest).Handle); 234 cairo_region_get_extents(RSrc1, @ACairoRect); 235 TGtk3Region(Dest).Handle := cairo_region_create_rectangle(@ACairoRect); 236 RDest := TGtk3Region(Dest).Handle; 237 cairo_region_translate(RDest, -ACairoRect.x, -ACairoRect.y); 238 end else 239 AStatus := cairo_region_subtract(RDest, RSrc1); 240 end; 241 RGN_OR: 242 begin 243 AStatus := cairo_region_union(RSrc1, RSrc2); 244 AStatus := cairo_region_union(RDest, RSrc1); 245 end; 246 RGN_XOR: 247 begin 248 AStatus := cairo_region_xor(RSrc1, RSrc2); 249 AStatus := cairo_region_xor(RDest, RSrc1); 250 end; 251 end; 252 if (AStatus <> CAIRO_STATUS_SUCCESS) or cairo_region_is_empty(RDest) then 253 Result := NullRegion 254 else 255 begin 256 if cairo_region_num_rectangles(RDest) > 1 then 257 Result := ComplexRegion 258 else 259 Result := SimpleRegion; 260 end; 261end; 262 263function TGtk3WidgetSet.CreateBitmap(Width, Height: Integer; Planes, 264 BitCount: Longint; BitmapBits: Pointer): HBITMAP; 265var 266 Format: cairo_format_t; 267 NewBits: PByte; 268 NewBitsSize: PtrUInt; 269 ARowStride, RSS: Integer; 270begin 271 {$IFDEF VerboseGtk3WinAPI} 272 DebugLn('Trace:> [Gtk3WinAPI CreateBitmap]', 273 ' Width:', dbgs(Width), 274 ' Height:', dbgs(Height), 275 ' Planes:', dbgs(Planes), 276 ' BitCount:', dbgs(BitCount), 277 ' BitmapBits: ', dbgs(BitmapBits)); 278 {$ENDIF} 279 case BitCount of 280 1: Format := CAIRO_FORMAT_A1; 281 8: Format := CAIRO_FORMAT_A8; 282 24: Format := CAIRO_FORMAT_RGB24; 283 else 284 Format := CAIRO_FORMAT_ARGB32; 285 end; 286 287 RSS := GetBytesPerLine(Width, BitCount, rileWordBoundary); 288 if BitmapBits <> nil then 289 begin 290 ARowStride := GetBytesPerLine(Width, BitCount, rileDWordBoundary); 291 if not CopyImageData(Width, Height, RSS, BitCount, BitmapBits, Rect(0, 0, Width, Height), 292 riloBottomToTop, riloBottomToTop, rileDWordBoundary, NewBits, NewBitsSize) then 293 begin 294 // this was never tested 295 ARowStride := RSS; 296 NewBits := AllocMem(RSS * Height); 297 Move(BitmapBits^, NewBits^, RSS * Height); 298 end; 299 Result := HBitmap(TGtk3Image.Create(NewBits, Width, Height, ARowStride, Format, True)); 300 end 301 else 302 Result := HBitmap(TGtk3Image.Create(nil, Width, Height, Format)); 303 304 {$IFDEF VerboseGtk3WinAPI} 305 DebugLn('Trace:< [Gtk3WinAPI CreateBitmap] Bitmap:', dbghex(Result)); 306 {$ENDIF} 307end; 308 309function TGtk3WidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; 310var 311 ABrush: TGtk3Brush; 312begin 313 Result := 0; 314 // DebugLn('TGtk3WidgetSet.CreateBrushIndirect color=',dbgs(logBrush.lbColor),' style=',dbgs(logBrush.lbStyle)); 315 ABrush := TGtk3Brush.Create; 316 try 317 // todo: hatch 318 ABrush.Style := LogBrush.lbStyle; 319 ABrush.Color := ColorToRGB(TColor(logBrush.lbColor)); 320 ABrush.LogBrush := LogBrush; 321 // ABrush.LogBrush.lbColor := ABrush.Color; 322 Result := HBRUSH(ABrush); 323 except 324 Result := 0; 325 DebugLn('TGtk3WidgetSet.CreateBrushIndirect: Failed'); 326 end; 327 328 {$IFDEF VerboseGtk3DeviceContext} 329 DebugLn('Trace:< [Gtk3WinAPI CreateBrushIndirect] Result: ', dbghex(Result)); 330 {$ENDIF} 331end; 332 333function TGtk3WidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; width, 334 Height: Integer): Boolean; 335begin 336 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 337 DebugLn('WARNING: TGtk3WidgetSet.CreateCaret not implemented ...'); 338 {$ENDIF} 339 Result := inherited CreateCaret(Handle, Bitmap, width, Height); 340end; 341 342function TGtk3WidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer 343 ): HBITMAP; 344var 345 Gtk3DC: TGtk3DeviceContext; 346 Format: cairo_format_t = CAIRO_FORMAT_ARGB32; 347 ADepth: Integer; 348 AVisual: PGdkVisual; 349 ABpp: gint; 350 ARowStride: PtrUInt; 351begin 352 {$IFDEF VerboseGtk3WinAPI} 353 DebugLn('Trace:> [WinAPI CreateCompatibleBitmap]', 354 ' DC:', dbghex(DC), 355 ' Width:', dbgs(Width), 356 ' Height:', dbgs(Height)); 357 {$ENDIF} 358 Result := 0; 359 if IsValidDC(DC) then 360 begin 361 Gtk3DC := TGtk3DeviceContext(DC); 362 ADepth := Gtk3DC.getDepth; 363 ABpp := Gtk3DC.getBpp; 364 end else 365 begin 366 AVisual := gdk_window_get_visual(gdk_get_default_root_window); 367 ADepth := gdk_visual_get_depth(AVisual); 368 ABpp := AVisual^.get_bits_per_rgb; 369 g_object_unref(AVisual); 370 end; 371 case ADepth of 372 1: Format := CAIRO_FORMAT_A1; 373 2: Format := CAIRO_FORMAT_A8; 374 24: Format := CAIRO_FORMAT_RGB24; 375 else 376 Format := CAIRO_FORMAT_ARGB32; 377 end; 378 ARowStride := GetBytesPerLine(Width, ABpp, rileDWordBoundary); 379 Result := HBitmap(TGtk3Image.Create(nil, Width, Height, ARowStride, Format)); 380 {$IFDEF VerboseGtk3WinAPI} 381 DebugLn('Trace:< [Gtk3WinAPI CreateCompatibleBitmap] Bitmap:', dbghex(Result)); 382 {$ENDIF} 383end; 384 385function TGtk3WidgetSet.CreateCompatibleDC(DC: HDC): HDC; 386begin 387 Result := HDC(TGtk3DeviceContext.Create(PGtkWidget(nil), False)); 388end; 389 390function TGtk3WidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN; 391begin 392 Result:=HRGN(TGtk3Region.CreateEllipse(X1,Y1,X2,Y2)); 393end; 394 395function TGtk3WidgetSet.CreateRoundRectRgn(X1, Y1, X2, Y2, nW, nH: Integer): HRGN; 396begin 397 Result:=HRGN(TGtk3Region.Create(X1,Y1,X2,Y2,nW,nH)); 398end; 399 400 401function TGtk3WidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT; 402begin 403 Result := CreateFontIndirectEx(LogFont, ''); 404end; 405 406function TGtk3WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; 407 const LongFontName: string): HFONT; 408begin 409 Result := HFONT(TGtk3Font.Create(LogFont, LongFontName)); 410end; 411 412function TGtk3WidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON; 413begin 414 Result := 0; 415 if IsValidGDIObject(IconInfo^.hbmColor) then 416 begin 417 if IconInfo^.fIcon then 418 begin 419 Result := HICON(TGtk3Image.Create(TGtk3Image(IconInfo^.hbmColor).Handle)); 420 end else 421 begin 422 Result := HCURSOR({%H-}PtrUInt(gdk_cursor_new_from_pixbuf(gdk_display_get_default, 423 TGtk3Image(IconInfo^.hbmColor).Handle, IconInfo^.xHotSpot, IconInfo^.yHotSpot))); 424 // create cursor from pixbuf 425 { W := gdk_pixbuf_get_width(TGtk3Image(IconInfo^.hbmColor).Handle); 426 H := gdk_pixbuf_get_height(TGtk3Image(IconInfo^.hbmColor).Handle); 427 DebugLn('TGtk3WidgetSet.CreateIconIndirect W=',dbgs(W),' H=',dbgs(H)); 428 PixBuf := gdk_pixbuf_new_subpixbuf(TGtk3Image(IconInfo^.hbmColor).Handle, 0, 0, W, H); 429 Result := HCURSOR({%H-}PtrUInt(gdk_cursor_new_from_pixbuf(gdk_display_get_default, 430 pixbuf, IconInfo^.xHotSpot, IconInfo^.yHotSpot))); 431 if pixbuf <> nil then 432 g_object_unref(PixBuf); } 433 end; 434 end; 435end; 436 437function TGtk3WidgetSet.CreatePalette(const LogPalette: TLogPalette): HPALETTE; 438begin 439 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 440 DebugLn('WARNING: TGtk3WidgetSet.CreatePalette not implemented ...'); 441 {$ENDIF} 442 Result := 0; 443end; 444 445function TGtk3WidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN; 446var 447 APen: TGtk3Pen; 448begin 449 Result := 0; 450 APen := TGtk3Pen.Create; 451 with LogPen do 452 begin 453 case lopnStyle and PS_STYLE_MASK of 454 PS_SOLID: APen.Style := psSolid; 455 PS_DASH: APen.Style := psDash; 456 PS_DOT: APen.Style := psDot; 457 PS_DASHDOT: APen.Style := psDashDot; 458 PS_DASHDOTDOT: APen.Style := psDashDotDot; 459 PS_NULL: APen.Style := psClear; 460 else 461 APen.Style := psSolid; 462 end; 463 APen.Color := TColor(lopnColor); 464 APen.Cosmetic := lopnWidth.X <= 0 ; 465 if not APen.Cosmetic then 466 APen.Width := lopnWidth.X; 467 end; 468 APen.LogPen := LogPen; 469 470 Result := HPEN(APen); 471end; 472 473function TGtk3WidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer; 474 FillMode: integer): HRGN; 475begin 476 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 477 DebugLn('WARNING: TGtk3WidgetSet.CreatePolygonRgn not implemented ...'); 478 {$ENDIF} 479 Result:=inherited CreatePolygonRgn(Points, NumPts, FillMode); 480end; 481 482function TGtk3WidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; 483begin 484 Result := HRGN(TGtk3Region.Create(True, X1, Y1, X2, Y2)); 485end; 486 487procedure TGtk3WidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection 488 ); 489var 490 ACritSec: System.PRTLCriticalSection; 491begin 492 ACritSec:=System.PRTLCriticalSection(CritSection); 493 System.DoneCriticalsection(ACritSec^); 494 Dispose(ACritSec); 495 CritSection:=0; 496end; 497 498function TGtk3WidgetSet.DeleteDC(hDC: HDC): Boolean; 499begin 500 {$ifdef VerboseGtk3DeviceContext} 501 DebugLn('TGtk3WidgetSet.DeleteDC Handle: ', dbghex(hDC)); 502 {$endif} 503 504 if not IsValidDC(hDC) then 505 exit(False); 506 507 TGtk3DeviceContext(hDC).Free; 508 Result := True; 509end; 510 511function TGtk3WidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean; 512begin 513 Result := False; 514 515 if GDIObject = 0 then 516 Exit(True); 517 518 if not IsValidGDIObject(GDIObject) then 519 Exit; 520 {$ifdef VerboseGtk3DeviceContext} 521 DebugLn('TGtk3WidgetSet.DeleteObject GDIObject: ', dbghex(GdiObject),' name ',dbgsName(TObject(GdiObject))); 522 {$endif} 523 if TObject(GDIObject) is TGtk3ContextObject then 524 begin 525 if TGtk3ContextObject(GDIOBJECT).Shared then 526 // DebugLn('ERROR: TGtk3WidgetSet.DeleteObject trial to delete shared object ',dbgsName(TGtk3ContextObject(GdiObject))) 527 else 528 TGtk3ContextObject(GDIObject).Free; 529 end else 530 TObject(GDIObject).Free; 531end; 532 533function TGtk3WidgetSet.DestroyCaret(Handle: HWND): Boolean; 534begin 535 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 536 DebugLn('WARNING: TGtk3WidgetSet.DestroyCaret not implemented ...'); 537 {$ENDIF} 538 Result:=inherited DestroyCaret(Handle); 539end; 540 541function TGtk3WidgetSet.DestroyCursor(Handle: HCURSOR): Boolean; 542begin 543 Result := Handle <> 0; 544 if Result then 545 g_object_unref(PGdkCursor(Handle)); 546 // gdk_cursor_destroy({%H-}PGdkCursor(Handle)); 547end; 548 549function TGtk3WidgetSet.DestroyIcon(Handle: HICON): Boolean; 550begin 551 Result := False; 552 if IsValidGDIObject(Handle) then 553 begin 554 TGtk3Image(Handle).Free; 555 Result := True; 556 end; 557end; 558 559function TGtk3WidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; 560begin 561 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 562 DebugLn('WARNING: TGtk3WidgetSet.DPToLP not implemented ...'); 563 {$ENDIF} 564 Result:=inherited DPtoLP(DC, Points, Count); 565end; 566 567function TGtk3WidgetSet.DrawFrameControl(DC: HDC; const aRect: TRect; uType, 568 uState: Cardinal): Boolean; 569begin 570 Result:=false; 571 if IsValidDC(DC) then 572 Result:=TGtk3DeviceContext(DC).drawFrameControl(aRect,uType,uState); 573end; 574 575function TGtk3WidgetSet.DrawFocusRect(DC: HDC; const aRect: TRect): boolean; 576begin 577 Result := False; 578 if IsValidDC(DC) then 579 Result:=TGtk3DeviceContext(DC).drawFocusRect(aRect); 580end; 581 582function TGtk3WidgetSet.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; 583 grfFlags: Cardinal): Boolean; 584begin 585 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 586 DebugLn('WARNING: TGtk3WidgetSet.DrawEdge not implemented ...'); 587 {$ENDIF} 588 Result := False; // inherited DrawEdge(DC, ARect, Edge, grfFlags); 589end; 590 591function TGtk3WidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; 592 var Rect: TRect; Flags: Cardinal): Integer; 593const 594 TabString = ' '; 595var 596 pIndex: Longint; 597 AStr: String; 598 599 TM: TTextmetric; 600 theRect: TRect; 601 Lines: PPChar; 602 I, NumLines: Longint; 603 TempDC: HDC; 604 TempPen: HPEN; 605 TempBrush: HBRUSH; 606 l: LongInt; 607 Pt: TPoint; 608 SavedRect: TRect; // if font orientation <> 0 609 LineHeight: Integer; 610 Size: TSize; 611 612 function LeftOffset: Longint; 613 begin 614 if (Flags and DT_RIGHT) = DT_RIGHT then 615 Result := DT_RIGHT 616 else 617 if (Flags and DT_CENTER) = DT_CENTER then 618 Result := DT_CENTER 619 else 620 Result := DT_LEFT; 621 end; 622 623 function TopOffset: Longint; 624 begin 625 if (Flags and DT_BOTTOM) = DT_BOTTOM then 626 Result := DT_BOTTOM 627 else 628 if (Flags and DT_VCENTER) = DT_VCENTER then 629 Result := DT_VCENTER 630 else 631 Result := DT_TOP; 632 end; 633 634 function CalcRect: Boolean; 635 begin 636 Result := (Flags and DT_CALCRECT) = DT_CALCRECT; 637 end; 638 639 function TextExtentPoint(Str: PChar; Count: Integer; var Sz: TSize): Boolean; 640 var 641 NewStr: String; 642 begin 643 if (Flags and DT_EXPANDTABS) <> 0 then 644 begin 645 NewStr := StringReplace(Str, #9, TabString, [rfReplaceAll]); 646 Result := GetTextExtentPoint(DC, PChar(NewStr), Length(NewStr), Sz); 647 end 648 else 649 Result := GetTextExtentPoint(Dc, Str, Count, Sz); 650 end; 651 652 procedure DoCalcRect; 653 var 654 AP: TSize; 655 J, MaxWidth, 656 LineWidth, LineHeight: Integer; 657 begin 658 theRect := Rect; 659 660 MaxWidth := theRect.Right - theRect.Left; 661 //DefHeight := theRect.Bottom - theRect.Top; 662 663 (* 664 if Flags and DT_CENTER <> 0then 665 Alignment := DT_CENTER 666 else 667 if Flags and DT_RIGHT <> 0 then 668 Alignment := DT_RIGHT 669 else 670 Alignment := DT_LEFT; 671 672 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_alignment(Alignment); 673 if Flags and DT_WORDBREAK <> 0 then 674 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_wrap(PANGO_WRAP_WORD); 675 676 // ADevOffset := TGtk3DeviceContext(DC).Offset; 677 // TGtk3DeviceContext(DC).CurrentFont.Layout^.set_width(Rect.Right - Rect.Left); 678 // TGtk3DeviceContext(DC).CurrentFont.Layout^.set_height(Rect.Bottom - Rect.Top); 679 680 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_text(Str, Count); 681 682 683 // TGtk3DeviceContext(DC).CurrentFont.Layout^.get_iter^.get_line_extents(@PR1, @PR2); 684 // DebugLn('DoCalcRect LINE EXTENTS Rect=',dbgs(Rect),' PR1 ',dbgs(RectFromGdkRect(TGdkRectangle(PR1))),' PR2 ',dbgs(RectFromGdkRect(TGdkRectangle(PR2)))); 685 TGtk3DeviceContext(DC).CurrentFont.Layout^.get_extents(@PR1, @PR2); 686 // get_extents(@PR1, @PR2); 687 688 DebugLn('DoCalcRect Rect=',dbgs(Rect),' PR1 ',dbgs(RectFromPangoRect(PR1)),' PR2 ',dbgs(RectFromPangoRect(PR2)),' ALIGNMENT ',dbgs(Alignment)); 689 690 // DebugLn('DoCalcRect Rect=',dbgs(Rect),' PR1 ',Format('x %d y %d width %d height %d' 691 *) 692 693 if (Flags and DT_SINGLELINE) > 0 then 694 begin 695 // ignore word and line breaks 696 TextExtentPoint(PChar(AStr), length(AStr), AP{%H-}); 697 theRect.Bottom := theRect.Top + TM.tmHeight; 698 if (Flags and DT_CALCRECT)<>0 then 699 begin 700 theRect.Right := theRect.Left + AP.cX; 701 theRect.Bottom := theRect.Top + AP.cY; 702 end 703 else 704 begin 705 theRect.Right := theRect.Left + Min(MaxWidth, AP.cX); 706 if (Flags and DT_VCENTER) > 0 then 707 begin 708 OffsetRect(theRect, 0, ((Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)) div 2); 709 end 710 else 711 if (Flags and DT_BOTTOM) > 0 then 712 begin 713 OffsetRect(theRect, 0, (Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)); 714 end; 715 end; 716 end 717 else 718 begin 719 // consider line breaks 720 if (Flags and DT_WORDBREAK) = 0 then 721 begin 722 // do not break at word boundaries 723 TextExtentPoint(PChar(AStr), length(AStr), AP); 724 MaxWidth := AP.cX; 725 //DefHeight := AP.cY; 726 end; 727 728 Gtk3WordWrap(DC, PChar(AStr), MaxWidth, Lines, NumLines); 729 // writeln('WORD WRAP RESULTED IN ',NumLines,' lines for ',AStr,' MAX=',MaxWidth); 730 if (Flags and DT_CALCRECT)<>0 then 731 begin 732 LineWidth := 0; 733 LineHeight := 0; 734 if (Lines <> nil) then 735 begin 736 for J := 0 to NumLines - 1 do 737 begin 738 TextExtentPoint(Lines[J], StrLen(Lines[J]), AP); 739 LineWidth := Max(LineWidth, AP.cX); 740 Inc(LineHeight, AP.cY); 741 end; 742 end; 743 LineWidth := Min(MaxWidth, LineWidth); 744 end else 745 begin 746 LineWidth := MaxWidth; 747 LineHeight := NumLines*TM.tmHeight; 748 end; 749 750 theRect.Right := theRect.Left + LineWidth; 751 theRect.Bottom := theRect.Top + LineHeight; 752 if NumLines>1 then 753 Inc(theRect.Bottom, (NumLines-1)*TM.tmDescent);// space between lines 754 755 // debugln('TGtk3WidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines)); 756 end; 757 758 if not CalcRect then 759 case LeftOffset of 760 DT_CENTER: 761 OffsetRect(theRect, (Rect.Right - theRect.Right) div 2, 0); 762 DT_RIGHT: 763 OffsetRect(theRect, Rect.Right - theRect.Right, 0); 764 end; 765 end; 766 767 // if our Font.Orientation <> 0 we must recalculate X,Y offset 768 // also it works only with DT_TOP DT_LEFT. Gtk2 can handle multiline 769 // text in this case too. 770 procedure CalculateOffsetWithAngle(const AFontAngle: Integer; 771 var TextLeft,TextTop: Integer); 772 var 773 OffsX, OffsY: integer; 774 Angle: Double; 775 Size: TSize; 776 R: TRect; 777 begin 778 R := SavedRect; 779 OffsX := R.Right - R.Left; 780 OffsY := R.Bottom - R.Top; 781 Size.cx := OffsX; 782 Size.cy := OffsY; 783 Angle := AFontAngle / 10; 784 if Angle < 0 then 785 Angle := 360 + Angle; 786 787 if Angle <= 90 then 788 begin 789 OffsX := 0; 790 OffsY := Trunc(Size.cx * sin(Angle * Pi / 180)); 791 end else 792 if Angle <= 180 then 793 begin 794 OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180)); 795 OffsY := Trunc(Size.cx * sin(Angle * Pi / 180) + 796 Size.cy * cos((180 - Angle) * Pi / 180)); 797 end else 798 if Angle <= 270 then 799 begin 800 OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180) + 801 Size.cy * sin((Angle - 180) * Pi / 180)); 802 OffsY := Trunc(Size.cy * sin((270 - Angle) * Pi / 180)); 803 end else 804 if Angle <= 360 then 805 begin 806 OffsX := Trunc(Size.cy * sin((360 - Angle) * Pi / 180)); 807 OffsY := 0; 808 end; 809 TextTop := OffsY; 810 TextLeft := OffsX; 811 end; 812 813 function NeedOffsetCalc: Boolean; 814 begin 815 816 Result := (TGtk3DeviceContext(DC).CurrentFont.LogFont.lfOrientation <> 0) and 817 (Flags and DT_SINGLELINE <> 0) and 818 (Flags and DT_VCENTER = 0) and (Flags and DT_CENTER = 0) and 819 (Flags and DT_RIGHT = 0) and (Flags and DT_BOTTOM = 0) and 820 (Flags and DT_CALCRECT = 0) and not IsRectEmpty(SavedRect); 821 end; 822 823 824 procedure DrawLineRaw(theLine: PChar; LineLength, TopPos: Longint); 825 var 826 Points: array[0..1] of TSize; 827 LeftPos: Longint; 828 begin 829 if LeftOffset <> DT_LEFT then 830 GetTextExtentPoint(DC, theLine, LineLength, {%H-}Points[0]); 831 832 if TempBrush = HBRUSH(-1) then 833 TempBrush := SelectObject(DC, GetStockObject(NULL_BRUSH)); 834 case LeftOffset of 835 DT_LEFT: 836 LeftPos := theRect.Left; 837 DT_CENTER: 838 LeftPos := theRect.Left + (theRect.Right - theRect.Left) div 2 839 - Points[0].cX div 2; 840 DT_RIGHT: 841 LeftPos := theRect.Right - Points[0].cX; 842 end; 843 844 Pt := Point(0, 0); 845 // Draw line of Text 846 if NeedOffsetCalc then 847 begin 848 Pt.X := SavedRect.Left; 849 Pt.Y := SavedRect.Top; 850 CalculateOffsetWithAngle(TGtk3DeviceContext(DC).CurrentFont.LogFont.lfOrientation, Pt.X, Pt.Y); 851 end; 852 TextUtf8Out(DC, LeftPos + Pt.X, TopPos + Pt.Y, theLine, lineLength); 853 end; 854 855 procedure DrawLine(theLine: PChar; LineLength, TopPos: Longint); 856 var 857 Points: array[0..1] of TSize; 858 LogP: TLogPen; 859 LeftPos: Longint; 860 begin 861 if TempBrush = HBRUSH(-1) then 862 TempBrush := SelectObject(DC, GetStockObject(NULL_BRUSH)); 863 864 FillByte({%H-}Points[0],SizeOf(Points[0])*2,0); 865 if LeftOffset <> DT_Left then 866 GetTextExtentPoint(DC, theLine, LineLength, Points[0]); 867 868 case LeftOffset of 869 DT_LEFT: 870 LeftPos := theRect.Left; 871 DT_CENTER: 872 LeftPos := theRect.Left + (theRect.Right - theRect.Left) div 2 873 - Points[0].cX div 2; 874 DT_RIGHT: 875 LeftPos := theRect.Right - Points[0].cX; 876 end; 877 878 Pt := Point(0, 0); 879 if NeedOffsetCalc then 880 begin 881 Pt.X := SavedRect.Left; 882 Pt.Y := SavedRect.Top; 883 CalculateOffsetWithAngle(TGtk3DeviceContext(DC).CurrentFont.LogFont.lfOrientation, Pt.X, Pt.Y); 884 end; 885 // Draw line of Text 886 TextUtf8Out(DC, LeftPos + Pt.X, TopPos + Pt.Y, theLine, LineLength); 887 888 // Draw Prefix 889 if (pIndex > 0) and (pIndex<=LineLength) then 890 begin 891 // Create & select pen of font color 892 if TempPen = HPEN(-1) then 893 begin 894 LogP.lopnStyle := PS_SOLID; 895 LogP.lopnWidth.X := 1; 896 LogP.lopnColor := GetTextColor(DC); 897 TempPen := SelectObject(DC, CreatePenIndirect(LogP)); 898 end; 899 900 {Get prefix line position} 901 GetTextExtentPoint(DC, theLine, pIndex - 1, Points[0]); 902 Points[0].cX := LeftPos + Points[0].cX; 903 Points[0].cY := TopPos + tm.tmHeight - TM.tmDescent + 1; 904 905 GetTextExtentPoint(DC, @aStr[pIndex], UTF8CodepointSize(@aStr[pIndex]), Points[1]); 906 Points[1].cX := Points[0].cX + Points[1].cX; 907 Points[1].cY := Points[0].cY; 908 909 {Draw prefix line} 910 Polyline(DC, PPoint(@Points[0]), 2); 911 end; 912 end; 913begin 914 Result := 0; 915 if (Str=nil) or (Str[0]=#0) or not IsValidDC(DC) then 916 begin 917 // DebugLn('TGtk3DeviceContext.DrawText params error Str Valid ? ',dbgs(Str<>nil),' DC Valid ? ',dbgs(IsValidDC(DC)),' Str#0 ',dbgs(Str[0] = #0)); 918 exit; 919 end; 920 921 if (Count < -1) or (IsRectEmpty(Rect) and 922 ((Flags and DT_CALCRECT = 0) and (Flags and DT_NOCLIP = 0))) then Exit; 923 924 // Don't try to use StrLen(Str) in cases count >= 0 925 // In those cases str is NOT required to have a null terminator ! 926 if Count = -1 then 927 Count := StrLen(Str); 928 929 Lines := nil; 930 NumLines := 0; 931 TempDC := HDC(-1); 932 TempPen := HPEN(-1); 933 TempBrush := HBRUSH(-1); 934 // DebugLn('TGtk3DeviceContext.DrawText ',Str,' count=',dbgs(Count),' DT_CALCRECT ',dbgs(Flags and DT_CALCRECT <> 0),' ARect=',dbgs(Rect)); 935 try 936 if (Flags and (DT_SINGLELINE or DT_CALCRECT or DT_NOPREFIX or DT_NOCLIP or DT_EXPANDTABS)) = 937 (DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP) then 938 begin 939 System.Move(Rect, TheRect, SizeOf(TRect)); 940 SavedRect := Rect; 941 DrawLineRaw(Str, Count, Rect.Top); 942 Result := Rect.Bottom - Rect.Top; 943 Exit; 944 end; 945 946 SetLength(AStr{%H-},Count); 947 if Count>0 then 948 System.Move(Str^,AStr[1],Count); 949 950 if (Flags and DT_EXPANDTABS) <> 0 then 951 AStr := StringReplace(AStr, #9, TabString, [rfReplaceAll]); 952 953 if (Flags and DT_NOPREFIX) <> DT_NOPREFIX then 954 pIndex := DeleteAmpersands(AStr) 955 else 956 pIndex := -1; 957 958 GetTextMetrics(DC, TM{%H-}); 959 DoCalcRect; 960 Result := theRect.Bottom - theRect.Top; 961 if (Flags and DT_CALCRECT) = DT_CALCRECT then 962 begin 963 // DebugLn('TGtk3WidgetSet.DrawText DT_CALCRECT Rect ',dbgs(Rect),' TheRect ',dbgs(theRect),' Result ',dbgs(Result)); 964 System.Move(TheRect, Rect, SizeOf(TRect)); 965 exit; 966 end; 967 968 TempDC := SaveDC(DC); 969 970 if (Flags and DT_NOCLIP) <> DT_NOCLIP then 971 begin 972 if theRect.Right > Rect.Right then 973 theRect.Right := Rect.Right; 974 if theRect.Bottom > Rect.Bottom then 975 theRect.Bottom := Rect.Bottom; 976 // DebugLn('******* CALLING NOT IMPLEMENTED INTERSECTCLIP RECT '); 977 IntersectClipRect(DC, theRect.Left, theRect.Top, 978 theRect.Right, theRect.Bottom); 979 end; 980 981 if (Flags and DT_SINGLELINE) = DT_SINGLELINE 982 then begin 983 // DebugLn(['TGtk2WidgetSet.DrawText Draw single line']); 984 SavedRect := TheRect; 985 DrawLine(PChar(AStr), length(AStr), theRect.Top); 986 Exit; //we're ready 987 end; 988 989 // multiple lines 990 if Lines = nil then Exit; // nothing to do 991 if NumLines = 0 then Exit; // 992 993 994 //DebugLn(['TGtk2WidgetSet.DrawText Draw multiline']); 995 SavedRect := Classes.Rect(0, 0, 0, 0); // no font orientation change if multilined text 996 for i := 0 to NumLines - 1 do 997 begin 998 if theRect.Top > theRect.Bottom then Break; 999 1000 if ((Flags and DT_EDITCONTROL) = DT_EDITCONTROL) 1001 and (tm.tmHeight > (theRect.Bottom - theRect.Top)) 1002 then Break; 1003 1004 if Lines[i] <> nil then 1005 begin 1006 l:=StrLen(Lines[i]); 1007 DrawLine(Lines[i], l, theRect.Top); 1008 dec(pIndex,l+length(LineEnding)); 1009 Size:=default(TSize); 1010 GetTextExtentPoint(DC, Lines[i], l, Size); 1011 LineHeight := Size.cY; 1012 end 1013 else 1014 LineHeight := TM.tmHeight; 1015 Inc(theRect.Top, LineHeight + TM.tmDescent); // space between lines 1016 end; 1017 1018 finally 1019 Reallocmem(Lines, 0); 1020 if TempBrush <> HBRUSH(-1) then 1021 SelectObject(DC, TempBrush);// DeleteObject not needed here, because it was a default Brush 1022 if TempPen <> HPEN(-1) then 1023 DeleteObject(SelectObject(DC, TempPen)); 1024 if TempDC <> HDC(-1) then 1025 RestoreDC(DC, TempDC); 1026 end; 1027end; 1028 1029function TGtk3WidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; 1030var 1031 bFill, bBorder: Boolean; 1032begin 1033 bFill := TGtk3DeviceContext(DC).CurrentBrush.Style <> BS_NULL; 1034 bBorder := TGtk3DeviceContext(DC).CurrentPen.Style <> psClear; 1035 TGtk3DeviceContext(DC).drawEllipse(x1, y1, x2 - x1 - 1, y2 - y1 - 1, bFill, bBorder); 1036 Result := True; 1037end; 1038 1039function TGtk3WidgetSet.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal 1040 ): Boolean; 1041begin 1042 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1043 DebugLn('WARNING: TGtk3WidgetSet.EnableScrollBar not implemented ...'); 1044 {$ENDIF} 1045 Result := inherited EnableScrollBar(Wnd, wSBflags, wArrows); 1046end; 1047 1048function TGtk3WidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; 1049begin 1050 Result := False; 1051 if hWnd <> 0 then 1052 begin 1053 Result := TGtk3Widget(HWND).Enabled; 1054 TGtk3Widget(HWND).Enabled := bEnable; 1055 end; 1056end; 1057 1058function TGtk3WidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; 1059begin 1060 Result := 0; 1061 if IsValidDC(PS.HDC) then 1062 begin 1063 TGtk3DeviceContext(PS.HDC).Free; 1064 PS.HDC := 0; 1065 Result := 1; 1066 end; 1067end; 1068 1069procedure TGtk3WidgetSet.EnterCriticalSection(var CritSection: TCriticalSection 1070 ); 1071var 1072 ACritSec: System.PRTLCriticalSection; 1073begin 1074 ACritSec:=System.PRTLCriticalSection(CritSection); 1075 System.EnterCriticalsection(ACritSec^); 1076end; 1077 1078function TGtk3WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; 1079 lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; 1080var 1081 i: integer; 1082begin 1083 Result := True; 1084 for i := 0 to gdk_screen_get_n_monitors(gdk_screen_get_default) - 1 do 1085 begin 1086 Result := Result and lpfnEnum(i + 1, 0, nil, dwData); 1087 if not Result then break; 1088 end; 1089end; 1090 1091function TGtk3WidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; 1092 Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; 1093type 1094 TPangoFontFaces = packed record 1095 FamilyName: String; 1096 Faces: Array of String; 1097 end; 1098 PPangoFontFaces = Array of TPangoFontFaces; 1099 1100var 1101 i: Integer; 1102 FontType: Integer; 1103 EnumLogFont: TEnumLogFontEx; 1104 Metric: TNewTextMetricEx; 1105 FontList: TStringList; 1106 Faces: PPangoFontFaces; 1107 1108 AStyle: String; 1109 StylesCount: Integer; 1110 StylesList: TStringList; 1111 y: Integer; 1112 CharsetList: TByteList; 1113 CS: Byte; 1114 1115 function Gtk3GetFontFamiliesDefault(var AList: TStringList): Integer; 1116 var 1117 i, j: Integer; 1118 AFamilies: PPPangoFontFamily; 1119 AFaces: PPPangoFontFace; 1120 ANumFaces: Integer; 1121 begin 1122 AList.Clear; 1123 SetLength(Faces, 0); 1124 Result := -1; 1125 AFamilies := nil; 1126 1127 pango_context_list_families(gdk_pango_context_get, @AFamilies, @Result); 1128 SetLength(Faces, Result); 1129 for i := 0 to Result - 1 do 1130 begin 1131 j := AList.Add(StrPas(pango_font_family_get_name(AFamilies[i]))); 1132 AList.Objects[j] := TObject(PtrUInt(pango_font_family_is_monospace(AFamilies[i]))); 1133 Faces[i].FamilyName := AList[j]; 1134 AFaces := nil; 1135 pango_font_family_list_faces(AFamilies[i], @AFaces, @ANumFaces); 1136 SetLength(Faces[i].Faces, ANumFaces); 1137 for j := 0 to ANumFaces - 1 do 1138 Faces[i].Faces[j] := StrPas(pango_font_face_get_face_name(AFaces[j])); 1139 g_free(AFaces); 1140 end; 1141 g_free(AFamilies); 1142 end; 1143 1144 function Gtk3GetFontFamilies(var List: TStringList; 1145 const APitch: Byte; 1146 const AFamilyName: String; 1147 const {%H-}AWritingSystem: Byte): Integer; 1148 var 1149 StrLst: TStringList; 1150 NewList: TStringList; 1151 S: String; 1152 j: integer; 1153 begin 1154 Result := -1; 1155 StrLst := TStringList.Create; 1156 NewList := TStringList.Create; 1157 1158 try 1159 Gtk3GetFontFamiliesDefault(StrLst); 1160 for j := 0 to StrLst.Count - 1 do 1161 begin 1162 S := StrLst[j]; 1163 if APitch <> DEFAULT_PITCH then 1164 begin 1165 case APitch of 1166 FIXED_PITCH, MONO_FONT: 1167 begin 1168 if StrLst.Objects[j] <> nil then 1169 NewList.Add(S); 1170 end; 1171 VARIABLE_PITCH: 1172 begin 1173 if StrLst.Objects[j] = nil then 1174 NewList.Add(S); 1175 end; 1176 end; 1177 end else 1178 NewList.Add(S); 1179 end; 1180 1181 if AFamilyName <> '' then 1182 begin 1183 for j := NewList.Count - 1 downto 0 do 1184 begin 1185 S := NewList[j];; 1186 if S <> AFamilyName then 1187 NewList.Delete(J); 1188 end; 1189 end; 1190 for j := 0 to NewList.Count - 1 do 1191 begin 1192 S := NewList[j]; 1193 List.Add(S); 1194 end; 1195 Result := List.Count; 1196 finally 1197 StrLst.Free; 1198 NewList.Free; 1199 end; 1200 end; 1201 1202 function GetStyleAt(AIndex: Integer): String; 1203 var 1204 S: String; 1205 begin 1206 Result := ''; 1207 if (AIndex >= 0) and (AIndex < StylesList.Count) then 1208 begin 1209 S := StylesList[AIndex]; 1210 Result := S; 1211 end; 1212 end; 1213 1214 function FillLogFontA(const AIndex: Integer; var ALogFontA: TLogFontA; 1215 var {%H-}AMetric: TNewTextMetricEx; var {%H-}AFontType: Integer; 1216 out AStyle: String): Integer; 1217 var 1218 Font: PPangoFontDescription; 1219 FontStyle: TPangoStyle; 1220 FontWeight: TPangoWeight; 1221 S: String; 1222 i: Integer; 1223 begin 1224 S := FontList[AIndex]; 1225 Font := pango_font_description_from_string(PChar(S)); 1226 1227 FontStyle := pango_font_description_get_style(Font); 1228 FontWeight := pango_font_description_get_weight(Font); 1229 1230 ALogFontA.lfItalic := Byte(FontStyle = PANGO_STYLE_ITALIC); 1231 1232 // keep newer pango compat to LCL 1233 if FontWeight = 380 {PANGO_WEIGHT_BOOK as of pango 1.24} then 1234 FontWeight := PANGO_WEIGHT_NORMAL 1235 else 1236 if FontWeight = 1000 {PANGO_WEIGHT_ULTRAHEAVY as of pango 1.24} then 1237 FontWeight := PANGO_WEIGHT_HEAVY; 1238 1239 ALogFontA.lfWeight := FontWeight; 1240 1241 ALogFontA.lfHeight := pango_font_description_get_size(Font); 1242 if not pango_font_description_get_size_is_absolute(Font) then 1243 ALogFontA.lfHeight := PANGO_PIXELS(ALogFontA.lfHeight); 1244 1245 // pango does not have underline and strikeout params for font 1246 // ALogFontA.lfUnderline := ; 1247 // ALogFontA.lfStrikeOut := ; 1248 1249 StylesList.Clear; 1250 for i := High(Faces[AIndex].Faces) downto 0 do 1251 StylesList.Add(Faces[AIndex].Faces[i]); 1252 1253 AStyle := ''; 1254 Result := StylesList.Count; 1255 1256 if StylesList.Count > 0 then 1257 AStyle := GetStyleAt(0); 1258 1259 // current pango support in fpc is really poor, we cannot 1260 // get PangoScript since it's in pango >= 1.4 1261 // FillCharsetListForFont() 1262 end; 1263 1264begin 1265 Result := 0; 1266 {$ifdef VerboseEnumFonts} 1267 WriteLn('[TGtk3WidgetSet.EnumFontFamiliesEx] Charset=',lpLogFont^.lfCharSet, 1268 ' face ',lpLogFont^.lfFaceName,' pitchAndFamily=',lpLogFont^.lfPitchAndFamily); 1269 {$endif} 1270 Result := 0; 1271 Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler 1272 if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and 1273 (lpLogFont^.lfFaceName= '') and 1274 (lpLogFont^.lfPitchAndFamily = 0) then 1275 begin 1276 FontType := 0; 1277 FontList := TStringList.create; 1278 try 1279 if Gtk3GetFontFamiliesDefault(FontList) > 0 then 1280 begin 1281 for i := 0 to FontList.Count - 1 do 1282 begin 1283 EnumLogFont.elfLogFont.lfFaceName := FontList[i]; 1284 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1285 end; 1286 end; 1287 finally 1288 FontList.free; 1289 end; 1290 end else 1291 begin 1292 Result := 0; 1293 FontType := TRUETYPE_FONTTYPE; 1294 FontList := TStringList.Create; 1295 StylesList := TStringList.Create; 1296 CharsetList := TByteList.Create; 1297 for i := 0 to CharsetEncodingList.Count - 1 do 1298 begin 1299 CS := TCharSetEncodingRec(CharsetEncodingList.Items[i]^).CharSet; 1300 if CharsetList.IndexOf(CS) = -1 then 1301 CharsetList.Add(CS); 1302 end; 1303 try 1304 if Gtk3GetFontFamilies(FontList, lpLogFont^.lfPitchAndFamily, 1305 lpLogFont^.lfFaceName, lpLogFont^.lfCharSet) > 0 then 1306 begin 1307 for i := 0 to FontList.Count - 1 do 1308 begin 1309 EnumLogFont.elfLogFont.lfFaceName := FontList[i]; 1310 EnumLogFont.elfLogFont.lfPitchAndFamily := lpLogFont^.lfPitchAndFamily; 1311 EnumLogFont.elfFullName := FontList[i]; 1312 1313 StylesCount := FillLogFontA(i, EnumLogFont.elfLogFont, Metric, FontType, AStyle); 1314 EnumLogFont.elfStyle := AStyle; 1315 1316 if CharSetList.Count > 0 then 1317 EnumLogFont.elfLogFont.lfCharSet := CharsetList.Items[0]; 1318 1319 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1320 for y := 1 to StylesCount - 1 do 1321 begin 1322 AStyle := GetStyleAt(y); 1323 EnumLogFont.elfStyle := AStyle; 1324 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1325 end; 1326 for y := 1 to CharSetList.Count - 1 do 1327 begin 1328 EnumLogFont.elfLogFont.lfCharSet := CharsetList.Items[y]; 1329 Result := Callback(EnumLogFont, Metric, FontType, LParam); 1330 end; 1331 end; 1332 end; 1333 finally 1334 CharSetList.Free; 1335 StylesList.Free; 1336 FontList.Free; 1337 end; 1338 end; 1339end; 1340 1341function TGtk3WidgetSet.EqualRgn(Rgn1: HRGN; Rgn2: HRGN): Boolean; 1342begin 1343 Result := Rgn1 = Rgn2; 1344 if Result then 1345 exit; 1346 if not IsValidGDIObject(Rgn1) or not IsValidGDIObject(Rgn2) then 1347 exit; 1348 Result := cairo_region_equal(TGtk3Region(Rgn1).Handle,TGtk3Region(Rgn2).Handle); 1349end; 1350 1351function TGtk3WidgetSet.IntersectClipRect(dc: hdc; Left, Top, Right,Bottom: Integer): Integer; 1352var 1353 rgn,clip:HRGN; 1354begin 1355 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1356 DebugLn('WARNING: TGtk3WidgetSet.ExcludeClipRect not implemented ...'); 1357 {$ENDIF} 1358 rgn:=Self.CreateRectRgn(Left,Top,Right,Bottom); 1359 //Self.SelectClipRGN(dc,rgn); 1360 clip:=Self.CreateEmptyRegion; 1361 Self.GetClipRGN(dc,clip); 1362 Self.CombineRgn(clip,rgn,clip,RGN_AND); 1363 Self.SelectClipRGN(dc,clip); 1364 DeleteObject(clip); 1365 DeleteObject(rgn); 1366 // fail Self.ExtSelectClipRGN(dc,rgn,RGN_AND); 1367 { ncorg:=Tgtk3DeviceContext(dc).fncOrigin; 1368 GetWindowOrgEx(DC, @DCOrigin); 1369 Result:=inherited IntersectClipRect(dc, Left, Top, Right, Bottom);} 1370 Result:=0; 1371end; 1372 1373 1374function TGtk3WidgetSet.ExcludeClipRect(dc: hdc; Left, Top, Right, 1375 Bottom: Integer): Integer; 1376begin 1377 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1378 DebugLn('WARNING: TGtk3WidgetSet.ExcludeClipRect not implemented ...'); 1379 {$ENDIF} 1380 Result:=inherited ExcludeClipRect(dc, Left, Top, Right, Bottom); 1381end; 1382 1383function TGtk3WidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord; 1384 const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN; 1385var 1386 APen: TGtk3Pen; 1387begin 1388 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1389 // DebugLn('WARNING: TGtk3WidgetSet.ExtCreatePen not implemented ...'); 1390 {$ENDIF} 1391 APen := TGtk3Pen.Create; 1392 APen.IsExtPen := True; 1393 case dwPenStyle and PS_STYLE_MASK of 1394 PS_SOLID: APen.Style := psSolid; 1395 PS_DASH: APen.Style := psDash; 1396 PS_DOT: APen.Style := psDot; 1397 PS_DASHDOT: APen.Style := psDashDot; 1398 PS_DASHDOTDOT: APen.Style := psDashDotDot; 1399 PS_NULL: APen.Style := psClear; 1400 else 1401 APen.Style := psSolid; 1402 end; 1403 1404 APen.Cosmetic := (dwPenStyle and PS_TYPE_MASK) = PS_COSMETIC; 1405 1406 if (dwPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC then 1407 begin 1408 APen.Width := dwWidth; 1409 case dwPenStyle and PS_JOIN_MASK of 1410 PS_JOIN_ROUND: APen.JoinStyle := pjsRound; 1411 PS_JOIN_BEVEL: APen.JoinStyle := pjsBevel; 1412 PS_JOIN_MITER: APen.JoinStyle := pjsMiter; 1413 end; 1414 case dwPenStyle and PS_ENDCAP_MASK of 1415 PS_ENDCAP_ROUND: APen.EndCap := pecRound; 1416 PS_ENDCAP_SQUARE: APen.EndCap := pecSquare; 1417 PS_ENDCAP_FLAT: APen.EndCap := pecFlat; 1418 end; 1419 end; 1420 1421 if (dwPenStyle and PS_STYLE_MASK) = PS_USERSTYLE then 1422 begin 1423 //TODO: APen.setDashPattern 1424 end; 1425 1426 APen.Color := TColor(lplb.lbColor); // ColorToRGB() ? 1427 APen.LogPen.lopnColor := lplb.lbColor; 1428 APen.LogPen.lopnStyle := (dwPenStyle and PS_STYLE_MASK) or (dwPenStyle and PS_JOIN_MASK) or (dwPenStyle and PS_ENDCAP_MASK); 1429 APen.LogPen.lopnWidth.X := dwWidth; 1430 APen.LogPen.lopnWidth.Y := dwWidth; 1431 1432 Result := HPen(APen); 1433end; 1434 1435function TGtk3WidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint): Integer; 1436var 1437 GtkDC: TGtk3DeviceContext absolute DC; 1438 ARect: TGdkRectangle; 1439 DCOrigin: TPoint; 1440 R: Classes.TRect; 1441 Clip: HRGN; 1442 Tmp: HRGN; 1443begin 1444 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1445 // DebugLn('WARNING: TGtk3WidgetSet.ExtSelectClipRGN not implemented ...'); 1446 {$ENDIF} 1447 if not IsValidDC(DC) then 1448 begin 1449 Result := ERROR; 1450 exit; 1451 end else 1452 Result := SIMPLEREGION; 1453 // DebugLn('WARNING: TGtk3WidgetSet.ExtSelectClipRGN not implemented ...Mode=',dbgs(Mode)); 1454 case Mode of 1455 RGN_COPY: Result := SelectClipRGN(DC, RGN); 1456 RGN_OR, 1457 RGN_XOR, 1458 RGN_AND: 1459 begin 1460 // as MSDN says only RGN_COPY allows NULL RGN param. 1461 if not IsValidGDIObject(RGN) then 1462 begin 1463 Result := ERROR; 1464 exit; 1465 end; 1466 // get existing clip 1467 gdk_cairo_get_clip_rectangle(GtkDC.pcr, @ARect); 1468 R := RectFromGdkRect(ARect); 1469 if IsRectEmpty(R) then 1470 begin 1471 // no clip, just select RGN 1472 Result := SelectClipRGN(DC, RGN); 1473 exit; 1474 end; 1475 1476 // get transformation 1477 GetWindowOrgEx(DC, @DCOrigin); 1478 // writeln('ExtSelectClipRgn DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R)); 1479 // OffsetRect(R, -DCOrigin.X, -DCOrigin.Y); 1480 // writeln('ExtSelectClipRgn after DCOrigin=',dbgs(DCOrigin),' R=',dbgs(R)); 1481 Clip := CreateRectRGN(0, 0, R.Right - R.Left, R.Bottom - R.Top); 1482 1483 cairo_region_translate(TGtk3Region(Clip).Handle, -DCOrigin.X, -DCOrigin.Y); 1484 1485 // create target clip 1486 Tmp := CreateEmptyRegion; 1487 // CreateEmptyRegion; 1488 // combine 1489 Result := CombineRGN(Tmp, Clip, RGN, Mode); 1490 // commit 1491 SelectClipRGN(DC, Tmp); 1492 // clean up 1493 DeleteObject(Clip); 1494 DeleteObject(Tmp); 1495 end; 1496 RGN_DIFF: 1497 begin 1498 //DebugLn('WARNING: TGtk3DeviceContext.ExtSelectClipRgn RGN_DIFF not implemented .'); 1499 //exit; 1500 // when substracting we must have active clipregion 1501 // with all of its rects. 1502 gdk_cairo_get_clip_rectangle(GtkDC.pcr, @ARect); 1503 R := RectFromGdkRect(ARect); 1504 if IsRectEmpty(R) then 1505 begin 1506 // no clip, just select RGN 1507 Result := SelectClipRGN(DC, RGN); 1508 exit; 1509 end; 1510 1511 Clip := CreateRectRGN(R.Left, R.Top, R.Right, R.Bottom); 1512 1513 Tmp := CreateEmptyRegion; 1514 Result := CombineRGN(Tmp, HRGN(Clip), RGN, MODE); 1515 1516 // X11 paintEngine comment only ! 1517 // we'll NOT reset num of rects here (performance problem) like we do 1518 // in ExcludeClipRect, because this function must be correct, 1519 // if someone want accurate ExcludeClipRect with X11 then 1520 // use code from intfbasewinapi.inc TWidgetSet.ExcludeClipRect() 1521 // which calls this function and then combineRgn. 1522 SelectClipRGN(DC, Tmp); 1523 DeleteObject(Clip); 1524 DeleteObject(Tmp); 1525 end; 1526 end; 1527end; 1528 1529function TGtk3WidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; 1530 Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; 1531begin 1532 Result := False; 1533 // {$IFDEF VerboseGtk3DeviceContext} 1534 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1535 DebugLn('TGtk3WidgetSet.ExtTextOut x=',dbgs(x),' y=',dbgs(y),' Text ',dbgs(Str),' count ',dbgs(Count)); 1536 {$ENDIF} 1537 // inherited ExtTextOut(DC, X, Y, Options, Rect, Str, Count, Dx); 1538 if IsValidDC(DC) then 1539 begin 1540 Result := True; 1541 TGtk3DeviceContext(DC).drawText(X, Y, Str, Count); 1542 end; 1543end; 1544 1545function TGtk3WidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH 1546 ): Boolean; 1547begin 1548 Result := False; 1549 if IsValidDC(DC) then 1550 begin 1551 with Rect do 1552 TGtk3DeviceContext(DC).fillRect(Left, Top, Right - Left, Bottom - Top, Brush); 1553 Result := True; 1554 end; 1555end; 1556 1557function TGtk3WidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; 1558var 1559 R: TRect; 1560begin 1561 Result := False; 1562 if IsValidDC(DC) and IsValidGDIObject(RegionHnd) then 1563 begin 1564 R := TGtk3Region(RegionHnd).GetExtents; 1565 TGtk3DeviceContext(DC).fillRect(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top); 1566 Result := True; 1567 end; 1568end; 1569 1570function TGtk3WidgetSet.Frame3d(DC: HDC; var ARect: TRect; 1571 const FrameWidth: integer; const Style: TBevelCut): Boolean; 1572const 1573 PixelOffset = 0.5; 1574 NColorLight = clWindow; 1575 NColorDark = clBtnShadow; 1576var 1577 Color1, Color2: TGdkRGBA; 1578 cr: Pcairo_t; 1579 i: Integer; 1580begin 1581 Result := False; 1582 if not IsValidDC(DC) then 1583 Exit; 1584 Result := True; 1585 if FrameWidth <= 0 then 1586 Exit; 1587 1588 case Style of 1589 bvNone: 1590 Exit; 1591 bvSpace: 1592 begin 1593 InflateRect(ARect, -FrameWidth, -FrameWidth); 1594 Exit; 1595 end; 1596 bvRaised: 1597 begin 1598 Color1 := TColorToTGdkRGBA(ColorToRGB(NColorLight)); 1599 Color2 := TColorToTGdkRGBA(ColorToRGB(NColorDark)); 1600 end; 1601 bvLowered: 1602 begin 1603 Color1 := TColorToTGdkRGBA(ColorToRGB(NColorDark)); 1604 Color2 := TColorToTGdkRGBA(ColorToRGB(NColorLight)); 1605 end; 1606 end; 1607 1608 cr := TGtk3DeviceContext(DC).pcr; 1609 cairo_save(cr); 1610 try 1611 cairo_set_line_width(cr, 1); 1612 cairo_set_line_cap(cr, cairo_line_cap_t.CAIRO_LINE_CAP_ROUND); 1613 cairo_set_line_join(cr, cairo_line_join_t.CAIRO_LINE_JOIN_ROUND); 1614 1615 for i := 1 to FrameWidth do 1616 begin 1617 cairo_set_source_rgb(cr, Color1.red, Color1.green, Color1.blue); 1618 cairo_move_to(cr, ARect.Left+PixelOffset, ARect.Top+PixelOffset); 1619 cairo_line_to(cr, ARect.Right+PixelOffset-1, ARect.Top+PixelOffset); 1620 cairo_move_to(cr, ARect.Left+PixelOffset, ARect.Top+PixelOffset); 1621 cairo_line_to(cr, ARect.Left+PixelOffset, ARect.Bottom+PixelOffset-1); 1622 cairo_stroke(cr); 1623 1624 cairo_set_source_rgb(cr, Color2.red, Color2.green, Color2.blue); 1625 cairo_move_to(cr, ARect.Left+PixelOffset, ARect.Bottom+PixelOffset-1); 1626 cairo_line_to(cr, ARect.Right+PixelOffset-1, ARect.Bottom+PixelOffset-1); 1627 cairo_move_to(cr, ARect.Right+PixelOffset-1, ARect.Top+PixelOffset); 1628 cairo_line_to(cr, ARect.Right+PixelOffset-1, ARect.Bottom+PixelOffset-1); 1629 cairo_stroke(cr); 1630 1631 InflateRect(ARect, -1, -1); 1632 end; 1633 finally 1634 cairo_restore(cr); 1635 end; 1636end; 1637 1638function TGtk3WidgetSet.FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; 1639const 1640 PixelOffset = 0.5; 1641var 1642 cr: Pcairo_t; 1643begin 1644 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1645 DebugLn('TGtk3WidgetSet.FrameRect ARect=',dbgs(ARect)); 1646 {$ENDIF} 1647 Result := 0; 1648 if not IsValidDC(DC) then 1649 exit; 1650 cr := TGtk3DeviceContext(DC).pcr; 1651 cairo_rectangle(cr, ARect.Left+PixelOffset, ARect.Top+PixelOffset, ARect.Right-ARect.Left-1, ARect.Bottom-ARect.Top-1); 1652 if IsValidGDIObject(hBr) then 1653 TGtk3DeviceContext(DC).SetSourceColor(TGtk3Brush(HBR).Color); 1654 cairo_set_line_width(cr, 1); 1655 cairo_stroke(cr); //Don't touch 1656end; 1657 1658function TGtk3WidgetSet.HideCaret(hWnd: HWND): Boolean; 1659begin 1660 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1661 DebugLn('WARNING: TGtk3WidgetSet.HideCaret not implemented ...'); 1662 {$ENDIF} 1663 Result:=inherited HideCaret(hWnd); 1664end; 1665 1666function TGtk3WidgetSet.GetActiveWindow: HWND; 1667var 1668 AWindow: PGdkWindow; 1669 AData: gpointer; 1670 AWidget: PGtkWidget; 1671 i: Integer; 1672begin 1673 Result := 0; 1674 AWindow := gdk_screen_get_active_window(gdk_screen_get_default); 1675 if AWindow <> nil then 1676 begin 1677 gdk_window_get_user_data(AWindow,@AWidget); 1678 if AWidget <> nil then 1679 begin 1680 AData := g_object_get_data(AWidget, 'lclwidget'); 1681 // DebugLn('TGtk3WidgetSet.GetActiveWindow found window from data ...',dbgsName(TGtk3Widget(AData).LCLObject)); 1682 exit({%H-}HWND(AData)); 1683 end; 1684 for i := 0 to Screen.FormCount - 1 do 1685 begin 1686 if Screen.Forms[i].HandleAllocated then 1687 begin 1688 if PGtkWindow(TGtk3Window(Screen.Forms[i].Handle).Widget)^.get_window = AWindow then 1689 begin 1690 AWidget := PGtkWindow(TGtk3Window(Screen.Forms[i].Handle).Widget)^.get_focus; 1691 Result := HWND(Screen.Forms[i].Handle); 1692 end; 1693 end; 1694 end; 1695 end; 1696end; 1697 1698function TGtk3WidgetSet.GetBitmapBits(Bitmap: HBITMAP; Count: Longint; 1699 Bits: Pointer): Longint; 1700begin 1701 Result:=inherited GetBitmapBits(Bitmap, Count, Bits); 1702end; 1703 1704function TGtk3WidgetSet.GetBkColor(DC: HDC): TColorRef; 1705begin 1706 Result := 0; 1707 if IsValidDC(DC) then 1708 Result := TGtk3DeviceContext(DC).CurrentBrush.Color; 1709end; 1710 1711function TGtk3WidgetSet.GetCapture: HWND; 1712begin 1713 Result := HwndFromGtkWidget(gtk_grab_get_current); 1714 {$IFDEF VerboseGtk3WinApi} 1715 DebugLn('TGtk3WidgetSet.GetCapture ',dbgHex(Result)); 1716 {$ENDIF} 1717end; 1718 1719function TGtk3WidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean; 1720begin 1721 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1722 DebugLn('WARNING: TGtk3WidgetSet.GetCaretPos not implemented ...'); 1723 {$ENDIF} 1724 Result:=inherited GetCaretPos(lpPoint); 1725end; 1726 1727function TGtk3WidgetSet.GetCaretRespondToFocus(handle: HWND; 1728 var ShowHideOnFocus: boolean): Boolean; 1729begin 1730 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1731 DebugLn('WARNING: TGtk3WidgetSet.GetCaretPosRespondToFocus not implemented ...'); 1732 {$ENDIF} 1733 Result:=inherited GetCaretRespondToFocus(handle, ShowHideOnFocus); 1734end; 1735 1736function TGtk3WidgetSet.GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs 1737 ): Boolean; 1738begin 1739 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1740 DebugLn('WARNING: TGtk3WidgetSet.GetCharABCWidths not implemented ...'); 1741 {$ENDIF} 1742 Result:=inherited GetCharABCWidths(DC, p2, p3, ABCStructs); 1743end; 1744 1745function TGtk3WidgetSet.GetClientBounds(handle: HWND; var ARect: TRect 1746 ): Boolean; 1747begin 1748 {$IF DEFINED(VerboseGtk3WinAPI) OR DEFINED(GTK3DEBUGSIZE)} 1749 DebugLn('[Gtk3WinAPI GetClientBounds]'); 1750 {$ENDIF} 1751 if Handle = 0 then 1752 Exit(False); 1753 ARect := TGtk3Widget(handle).getClientBounds; 1754 Result := True; 1755end; 1756 1757function TGtk3WidgetSet.GetClientRect(handle: HWND; var ARect: TRect): Boolean; 1758begin 1759 {$IF DEFINED(VerboseGtk3WinAPI) OR DEFINED(GTK3DEBUGSIZE)} 1760 DebugLn('[Gtk3WinAPI GetClientRect]'); 1761 {$ENDIF} 1762 if Handle = 0 then 1763 Exit(False); 1764 ARect := TGtk3Widget(handle).getClientRect; 1765 Result := True; 1766end; 1767 1768function TGtk3WidgetSet.GetClipBox(DC: hDC; lpRect: PRect): Longint; 1769var 1770 GtkDC: TGtk3DeviceContext absolute DC; 1771 cr: Pcairo_t; 1772 //Pt: TPoint; 1773 ARect: TGdkRectangle; 1774begin 1775 //{$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1776 //DebugLn('WARNING: TGtk3WidgetSet.GetClipBox not implemented ...'); 1777 //{$ENDIF} 1778 Result := NULLREGION; 1779 if lpRect <> nil then 1780 lpRect^ := Rect(0,0,0,0); 1781 1782 if not IsValidDC(DC) then 1783 Result := ERROR; 1784 1785 if Result <> ERROR then 1786 begin 1787 cr := GtkDC.pcr; 1788 if gdk_cairo_get_clip_rectangle(cr, @ARect) then 1789 begin 1790 lpRect^ := RectFromGdkRect(ARect); 1791 Result := SimpleRegion; 1792 end; 1793 end; 1794end; 1795 1796function TGtk3WidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint; 1797var 1798 ARect: TGdkRectangle; 1799begin 1800 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1801 // DebugLn('WARNING: TGtk3WidgetSet.GetClipRgn not implemented ...'); 1802 {$ENDIF} 1803 Result := -1; 1804 if not IsValidDC(DC) or (RGN = 0) then 1805 exit; 1806 gdk_cairo_get_clip_rectangle(TGtk3DeviceContext(DC).pcr, @ARect); 1807 // DebugLn('GetClipRgn ',dbgs(TGtk3Region(RGN).GetExtents),' clipRect ',dbgs(RectFromGdkRect(ARect))); 1808 if IsRectEmpty(RectFromGdkRect(ARect)) then 1809 exit(0) 1810 else 1811 begin 1812 cairo_region_destroy(TGtk3Region(RGN).Handle); 1813 TGtk3Region(RGN).Handle := cairo_region_create_rectangle(@ARect); 1814 Result := 1; 1815 end; 1816end; 1817 1818function TGtk3WidgetSet.GetCmdLineParamDescForInterface: string; 1819begin 1820 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1821 DebugLn('WARNING: TGtk3WidgetSet.GetCmdLineParamDescForInterface not implemented ...'); 1822 {$ENDIF} 1823 Result:=inherited GetCmdLineParamDescForInterface; 1824end; 1825 1826function TGtk3WidgetSet.GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ; 1827var 1828 GtkDC: TGtk3DeviceContext absolute DC; 1829begin 1830 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1831 // DebugLn('WARNING: TGtk3WidgetSet.GetCurrentObject not implemented ...'); 1832 {$ENDIF} 1833 // Result:=inherited GetCurrentObject(DC, uObjectType); 1834 Result := 0; 1835 if not IsValidDC(DC) then 1836 Exit; 1837 case uObjectType of 1838 OBJ_BITMAP: Result := HGDIOBJ(GtkDC.CurrentImage); 1839 OBJ_BRUSH: Result := HGDIOBJ(GtkDC.CurrentBrush); 1840 OBJ_FONT: Result := HGDIOBJ(GtkDC.CurrentFont); 1841 OBJ_PEN: Result := HGDIOBJ(GtkDC.CurrentPen); 1842 OBJ_REGION: Result := HGDIOBJ(GtkDC.CurrentRegion); 1843 end; 1844end; 1845 1846function TGtk3WidgetSet.GetCursorPos(var lpPoint: TPoint): Boolean; 1847var 1848 ADeviceManager: PGdkDeviceManager; 1849 APointer: PGdkDevice; 1850 AScreen: PGdkScreen; 1851begin 1852 ADeviceManager := gdk_display_get_device_manager(gdk_display_get_default); 1853 APointer := gdk_device_manager_get_client_pointer(ADeviceManager); 1854 AScreen := gdk_screen_get_default; 1855 gdk_device_get_position(APointer, @AScreen, @lpPoint.X, @lpPoint.Y); 1856 Result := True; 1857end; 1858 1859function TGtk3WidgetSet.GetDC(hWnd: HWND): HDC; 1860var 1861 Widget: TGtk3Widget; 1862begin 1863 if Gtk3WidgetSet.IsValidHandle(hWnd) then 1864 begin 1865 Widget := TGtk3Widget(hWnd); 1866 Result := Widget.Context; 1867 if Result = 0 then 1868 Result := HDC(Gtk3DefaultContext); 1869 end else 1870 Result := HDC(Gtk3ScreenContext); 1871end; 1872 1873function TGtk3WidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC; 1874 WindowHandle: HWND; var OriginDiff: TPoint): boolean; 1875begin 1876 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1877 DebugLn('WARNING: TGtk3WidgetSet.GetDCOriginRelativeToWindow not implemented ...'); 1878 {$ENDIF} 1879 Result:=inherited GetDCOriginRelativeToWindow(PaintDC, WindowHandle, 1880 OriginDiff); 1881end; 1882 1883function TGtk3WidgetSet.GetDesignerDC(WindowHandle: HWND): HDC; 1884begin 1885 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1886 DebugLn('WARNING: TGtk3WidgetSet.GetDesignerDC not implemented ...'); 1887 {$ENDIF} 1888 Result:=inherited GetDesignerDC(WindowHandle); 1889end; 1890 1891function TGtk3WidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer; 1892begin 1893 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 1894 if (Index <> BITSPIXEL) and (Index <> LOGPIXELSX) and (Index <> LOGPIXELSY) then 1895 DebugLn('WARNING: TGtk3WidgetSet.GetDeviceCaps not implemented ...Index=',dbgs(Index),' DC=',dbgs(DC)); 1896 {$ENDIF} 1897 Result := 0; // inherited GetDeviceCaps(DC, Index); 1898 case Index of 1899 1900 HORZRES : { Horizontal width in pixels } 1901 begin 1902 if IsValidDC(DC) then 1903 begin 1904 Result := TGtk3DeviceContext(DC).getDeviceSize.X; 1905 end else 1906 Result := GetSystemMetrics(SM_CXSCREEN); 1907 end; 1908 1909 VERTRES : { Vertical height in pixels } 1910 begin 1911 if IsValidDC(DC) then 1912 begin 1913 Result := TGtk3DeviceContext(DC).getDeviceSize.Y; 1914 end else 1915 Result := GetSystemMetrics(SM_CYSCREEN); 1916 end; 1917 1918 HORZSIZE : { Horizontal size in millimeters } 1919 Result := LazUtilities.RoundToInt((GetDeviceCaps(DC, HORZRES) * 100) / 1920 (GetDeviceCaps(DC, LOGPIXELSX) * 25.4)); 1921 1922 VERTSIZE : { Vertical size in millimeters } 1923 Result := LazUtilities.RoundToInt((GetDeviceCaps(DC, VERTRES) * 100) / 1924 (GetDeviceCaps(DC, LOGPIXELSY) * 25.4)); 1925 1926 BITSPIXEL: 1927 begin 1928 if IsValidDC(DC) then 1929 Result := TGtk3DeviceContext(DC).getDepth 1930 else 1931 Result := gdk_window_get_visual(gdk_get_default_root_window)^.get_depth; 1932 end; 1933 PLANES: Result := 1; 1934 SIZEPALETTE: Result := gdk_window_get_visual(gdk_get_default_root_window)^.get_colormap_size; 1935 LOGPIXELSX : { Logical pixels per inch in X } 1936 begin 1937 Result := LazUtilities.RoundToInt(gdk_screen_width / (gdk_screen_width_mm / 25.4)); 1938 end; 1939 1940 LOGPIXELSY : { Logical pixels per inch in Y } 1941 begin 1942 Result := LazUtilities.RoundToInt(gdk_screen_height / (gdk_screen_height_mm / 25.4)); 1943 end; 1944 end; 1945 1946end; 1947 1948function TGtk3WidgetSet.GetDeviceSize(DC: HDC; var p: TPoint): boolean; 1949var 1950 ARect: TGdkRectangle; 1951begin 1952 Result := False; 1953 if not IsValidDC(DC) then 1954 exit; 1955 if TGtk3DeviceContext(DC).Parent <> nil then 1956 begin 1957 if Gtk3IsGdkWindow(TGtk3DeviceContext(DC).Parent^.window) then 1958 begin 1959 p.X := gdk_window_get_width(TGtk3DeviceContext(DC).Parent^.window); 1960 p.Y := gdk_window_get_height(TGtk3DeviceContext(DC).Parent^.window); 1961 Result := True; 1962 end; 1963 end else 1964 if (TGtk3DeviceContext(DC).ParentPixmap <> nil) and 1965 Gtk3IsGdkPixbuf(TGtk3DeviceContext(DC).ParentPixmap) then 1966 begin 1967 p.X := TGtk3DeviceContext(DC).ParentPixmap^.get_width; 1968 p.Y := TGtk3DeviceContext(DC).ParentPixmap^.get_height; 1969 Result := True; 1970 end else 1971 if TGtk3DeviceContext(DC).pcr <> nil then 1972 begin 1973 gdk_cairo_get_clip_rectangle(TGtk3DeviceContext(DC).pcr, @ARect); 1974 p.X := ARect.Width; 1975 p.Y := ARect.Height; 1976 Result := True; 1977 end; 1978end; 1979 1980function TGtk3WidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, 1981 NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; 1982begin 1983 Result:=inherited GetDIBits(DC, Bitmap, StartScan, NumScans, Bits, BitInfo, 1984 Usage); 1985end; 1986 1987function TGtk3WidgetSet.GetDpiForMonitor(hmonitor: HMONITOR; 1988 dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT; 1989var 1990 w,w_mm,h,h_mm:gint; 1991 rr:double; 1992 pscr:PGdkScreen; 1993begin 1994 (* MONITOR_DPI_TYPE = ( 1995 MDT_EFFECTIVE_DPI = 0, 1996 MDT_ANGULAR_DPI = 1, 1997 MDT_RAW_DPI = 2, 1998 MDT_DEFAULT = MDT_EFFECTIVE_DPI); 1999 TMonitorDpiType = MONITOR_DPI_TYPE; 2000 *) 2001 pscr:=TGdkScreen.get_default; 2002 w:=pscr^.get_width; 2003 w_mm:=pscr^.get_width_mm; 2004 h:=pscr^.get_height; 2005 h_mm:=pscr^.get_height_mm; 2006 2007 dpiX:=round(25.4*w/w_mm); 2008 dpiY:=round(25.4*h/h_mm); 2009 2010 rr:=TGdkScreen.get_default^.get_resolution(); 2011 2012 Result:=0; 2013 //Result:=inherited GetDpiForMonitor(hmonitor, dpiType, dpiX, dpiY); 2014end; 2015 2016function TGtk3WidgetSet.GetFocus: HWND; 2017var 2018 i: Integer; 2019 AWidget: PGtkWidget; 2020 AList: PGList; 2021 AHandle: TGtk3Window; 2022 AWindow: PGtkWindow; 2023 AActiveWindow: HWND; 2024begin 2025 AWidget := nil; 2026 2027 AActiveWindow := GetActiveWindow; 2028 if AActiveWindow <> 0 then 2029 begin 2030 AWidget := PGtkWindow(TGtk3Widget(AActiveWindow).Widget)^.get_focus; 2031 end else 2032 begin 2033 // worst case scenario is to search for widget or when application 2034 // isn't active anymore 2035 AList := gtk_window_list_toplevels; 2036 for i := 0 to g_list_length(AList) - 1 do 2037 begin 2038 if Gtk3IsGtkWindow(PGObject(g_list_nth(AList, i)^.data)) then 2039 begin 2040 // gtk3 this is really ugly, it returns .is_active for non active 2041 // windows, while docs says that is_active is window with kbd focus 2042 AWindow := PGtkWindow(g_list_nth(AList, i)^.data); 2043 AHandle := TGtk3Window(HwndFromGtkWidget(AWindow)); 2044 if Assigned(AHandle) and (Screen.FocusedForm = AHandle.LCLObject) and 2045 (AWindow^.is_active) then 2046 begin 2047 AWidget := PGtkWindow(g_list_nth(AList, i)^.data)^.get_focus; 2048 if AWidget <> nil then 2049 break; 2050 end; 2051 end; 2052 end; 2053 g_list_free(AList); 2054 end; 2055 2056 Result := HwndFromGtkWidget(AWidget); 2057 {$IFDEF GTK3DEBUGFOCUS} 2058 DebugLn('TGtk3WidgetSet.GetFocus current focus ',dbgHex(Result)); 2059 if IsValidHandle(Result) then 2060 DebugLn('TGtk3WidgetSet.GetFocus current focus ',dbgsName(TGtk3Widget(Result).LCLObject)); 2061 {$ENDIF} 2062end; 2063 2064function TGtk3WidgetSet.GetFontLanguageInfo(DC: HDC): DWord; 2065begin 2066 Result:=inherited GetFontLanguageInfo(DC); 2067end; 2068 2069function TGtk3WidgetSet.GetForegroundWindow: HWND; 2070var 2071 i: Integer; 2072 AWidget: PGtkWindow; 2073 AWindow: PGtkWindow; 2074 AList: PGList; 2075begin 2076 Result := 0; 2077 AWidget := nil; 2078 AWindow := nil; 2079 AList := gtk_window_list_toplevels; 2080 for i := 0 to g_list_length(AList) - 1 do 2081 begin 2082 if Gtk3IsGtkWindow(PGObject(g_list_nth(AList, i)^.data)) then 2083 begin 2084 AWidget := g_list_nth(AList, i)^.data; 2085 if AWidget^.get_visible and AWidget^.is_toplevel and AWidget^.is_active then 2086 begin 2087 AWindow := AWidget; 2088 break; 2089 end; 2090 end; 2091 end; 2092 g_list_free(AList); 2093 Result := HwndFromGtkWidget(AWindow); 2094end; 2095 2096function TGtk3WidgetSet.GetKeyState(nVirtKey: Integer): Smallint; 2097const 2098 StateDown = SmallInt($FF80); 2099var 2100 AKeyMap: PGdkKeymap; 2101 AModifiers: guint; 2102begin 2103 Result := 0; 2104 2105 Result := 0; 2106 2107 case nVirtKey of 2108 VK_LSHIFT: nVirtKey := VK_SHIFT; 2109 VK_LCONTROL: nVirtKey := VK_CONTROL; 2110 VK_LMENU: nVirtKey := VK_MENU; 2111 end; 2112 2113 (* 2114 // GdkModifierType 2115 GDK_SHIFT_MASK: TGdkModifierType = 1; 2116 GDK_LOCK_MASK: TGdkModifierType = 2; 2117 GDK_CONTROL_MASK: TGdkModifierType = 4; 2118 GDK_MOD1_MASK: TGdkModifierType = 8; 2119 GDK_MOD2_MASK: TGdkModifierType = 16; 2120 GDK_MOD3_MASK: TGdkModifierType = 32; 2121 GDK_MOD4_MASK: TGdkModifierType = 64; 2122 GDK_MOD5_MASK: TGdkModifierType = 128; 2123 GDK_BUTTON1_MASK: TGdkModifierType = 256; 2124 GDK_BUTTON2_MASK: TGdkModifierType = 512; 2125 GDK_BUTTON3_MASK: TGdkModifierType = 1024; 2126 GDK_BUTTON4_MASK: TGdkModifierType = 2048; 2127 GDK_BUTTON5_MASK: TGdkModifierType = 4096; 2128 GDK_MODIFIER_RESERVED_13_MASK: TGdkModifierType = 8192; 2129 GDK_MODIFIER_RESERVED_14_MASK: TGdkModifierType = 16384; 2130 GDK_MODIFIER_RESERVED_15_MASK: TGdkModifierType = 32768; 2131 GDK_MODIFIER_RESERVED_16_MASK: TGdkModifierType = 65536; 2132 GDK_MODIFIER_RESERVED_17_MASK: TGdkModifierType = 131072; 2133 GDK_MODIFIER_RESERVED_18_MASK: TGdkModifierType = 262144; 2134 GDK_MODIFIER_RESERVED_19_MASK: TGdkModifierType = 524288; 2135 GDK_MODIFIER_RESERVED_20_MASK: TGdkModifierType = 1048576; 2136 GDK_MODIFIER_RESERVED_21_MASK: TGdkModifierType = 2097152; 2137 GDK_MODIFIER_RESERVED_22_MASK: TGdkModifierType = 4194304; 2138 GDK_MODIFIER_RESERVED_23_MASK: TGdkModifierType = 8388608; 2139 GDK_MODIFIER_RESERVED_24_MASK: TGdkModifierType = 16777216; 2140 GDK_MODIFIER_RESERVED_25_MASK: TGdkModifierType = 33554432; 2141 GDK_SUPER_MASK: TGdkModifierType = 67108864; 2142 GDK_HYPER_MASK: TGdkModifierType = 134217728; 2143 GDK_META_MASK: TGdkModifierType = 268435456; 2144 GDK_MODIFIER_RESERVED_29_MASK: TGdkModifierType = 536870912; 2145 GDK_RELEASE_MASK: TGdkModifierType = 1073741824; 2146 GDK_MODIFIER_MASK: TGdkModifierType = 1543512063; 2147 *) 2148 // AModifierMask := gdk_keymap_get_modifier_mask(AKeyMap, 0); 2149 2150 AKeyMap := gdk_keymap_get_default; 2151 AModifiers := gdk_keymap_get_modifier_state(AKeyMap); 2152 case nVirtKey of 2153 VK_LBUTTON: 2154 if AModifiers and GDK_BUTTON1_MASK <> 0 then 2155 Result := Result or StateDown; 2156 VK_RBUTTON: 2157 if AModifiers and GDK_BUTTON2_MASK <> 0 then 2158 Result := Result or StateDown; 2159 VK_MBUTTON: 2160 if AModifiers and GDK_BUTTON3_MASK <> 0 then 2161 Result := Result or StateDown; 2162 VK_XBUTTON1: 2163 if AModifiers and GDK_BUTTON4_MASK <> 0 then 2164 Result := Result or StateDown; 2165 VK_XBUTTON2: 2166 if AModifiers and GDK_BUTTON5_MASK <> 0 then 2167 Result := Result or StateDown; 2168 VK_MENU: 2169 if AModifiers and GDK_MOD1_MASK <> 0 then 2170 Result := Result or StateDown; 2171 VK_SHIFT: 2172 if AModifiers and GDK_SHIFT_MASK <> 0 then 2173 Result := Result or StateDown; 2174 VK_CONTROL: 2175 if AModifiers and GDK_CONTROL_MASK <> 0 then 2176 Result := Result or StateDown; 2177 VK_LWIN, VK_RWIN: 2178 if AModifiers and GDK_META_MASK <> 0 then 2179 Result := Result or StateDown; 2180 {$ifdef VerboseGtk3WinAPI} 2181 else 2182 DebugLn('TGtk3WidgetSet.GetKeyState TODO ', DbgSVKCode(Word(nVirtkey))); 2183 {$endif} 2184 end; 2185end; 2186 2187function TGtk3WidgetSet.GetMapMode(DC: HDC): Integer; 2188begin 2189 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2190 DebugLn('WARNING: TGtk3WidgetSet.GetMapMode not implemented ...'); 2191 {$ENDIF} 2192 Result:=inherited GetMapMode(DC); 2193end; 2194 2195function TGtk3WidgetSet.GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo 2196 ): Boolean; 2197var 2198 MonitorRect, MonitorWorkArea: TGdkRectangle; 2199begin 2200 Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo)) or (Monitor = 0); 2201 if not Result then Exit; 2202 Dec(Monitor); 2203 gdk_screen_get_monitor_geometry(gdk_screen_get_default, Monitor, @MonitorRect); 2204 2205 with MonitorRect do 2206 lpmi^.rcMonitor := Bounds(x, y, width, height); 2207 // there is no way to determine workarea in gtk 2208 gdk_screen_get_monitor_workarea(gdk_screen_get_default, Monitor, @MonitorWorkArea); 2209 with MonitorWorkArea do 2210 lpmi^.rcWork := Bounds(x, y, width, height); 2211 lpmi^.rcWork := lpmi^.rcMonitor; 2212 if Monitor = gdk_screen_get_primary_monitor(gdk_screen_get_default) then 2213 lpmi^.dwFlags := MONITORINFOF_PRIMARY 2214 else 2215 lpmi^.dwFlags := 0; 2216end; 2217 2218function TGtk3WidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; 2219 Buf: Pointer): Integer; 2220begin 2221 Result := 0; 2222 if not IsValidGDIObject(GDIObj) then 2223 begin 2224 {$ifdef VerboseGtk3WinAPI} 2225 WriteLn('Trace:< TGtk3WidgetSet.GetObject Invalid GDI Object'); 2226 {$endif} 2227 Exit; 2228 end; 2229 Result:=TGtk3ContextObject(GDIObj).Get(bufsize, buf); 2230end; 2231 2232function TGtk3WidgetSet.GetParent(Handle: HWND): HWND; 2233begin 2234 if Handle <> 0 then 2235 Result := HWND(TGtk3Widget(Handle).getParent) 2236 else 2237 Result := 0; 2238end; 2239 2240function TGtk3WidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer; 2241begin 2242 Result := nil; 2243 if not IsValidHandle(Handle) then 2244 exit; 2245 Result := g_object_get_data(TGtk3Widget(Handle).Widget, PgChar(Str)); 2246end; 2247 2248function TGtk3WidgetSet.GetRgnBox(RGN: HRGN; lpRect: PRect): Longint; 2249begin 2250 Result := SIMPLEREGION; 2251 if IsValidGDIObject(RGN) then 2252 begin 2253 lpRect^ := TGtk3Region(RGN).GetExtents; 2254 end; 2255end; 2256 2257function TGtk3WidgetSet.GetROP2(DC: HDC): Integer; 2258begin 2259 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2260 DebugLn('WARNING: TGtk3WidgetSet.GetROP2 not implemented ...'); 2261 {$ENDIF} 2262 Result := inherited GetROP2(DC); 2263end; 2264 2265function TGtk3WidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer 2266 ): integer; 2267var 2268 BarWidget: PGtkWidget; 2269 Scrolled: PGtkScrolledWindow; 2270begin 2271 Result := 0; 2272 if not IsValidHandle(Handle) then 2273 exit; 2274 BarWidget := nil; 2275 if wtScrollbar in TGtk3Widget(Handle).WidgetType then 2276 BarWidget := TGtk3Widget(Handle).Widget 2277 else 2278 if wtScrollingWin in TGtk3Widget(Handle).WidgetType then 2279 begin 2280 Scrolled := TGtk3ScrollableWin(Handle).GetScrolledWindow; 2281 if Scrolled <> nil then 2282 begin 2283 if BarKind = SM_CYVSCROLL then 2284 BarWidget := Scrolled^.get_vscrollbar 2285 else 2286 BarWidget := Scrolled^.get_hscrollbar; 2287 end; 2288 end; 2289 if BarWidget <> nil then 2290 begin 2291 if BarKind = SM_CYVSCROLL then 2292 Result := BarWidget^.get_allocated_width 2293 else 2294 Result := BarWidget^.get_allocated_height; 2295 end; 2296end; 2297 2298function TGtk3WidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer 2299 ): boolean; 2300var 2301 AWidget: TGtk3Widget; 2302begin 2303 Result := False; 2304 if not IsValidHandle(Handle) then 2305 exit; 2306 AWidget := TGtk3Widget(Handle); 2307 2308 if wtScrollBar in AWidget.WidgetType then 2309 Result := AWidget.Visible 2310 else 2311 begin 2312 if wtScrollingWin in AWidget.WidgetType then 2313 begin 2314 if SBStyle = SB_Horz then 2315 Result := TGtk3ScrollableWin(Handle).getHorizontalScrollbar^.get_visible 2316 else 2317 if SBStyle = SB_Vert then 2318 Result := TGtk3ScrollableWin(Handle).getVerticalScrollbar^.get_visible 2319 end; 2320 end; 2321end; 2322 2323function TGtk3WidgetSet.GetScrollInfo(Handle: HWND; SBStyle: Integer; 2324 var ScrollInfo: TScrollInfo): Boolean; 2325var 2326 Adjustment: PGtkAdjustment; 2327 AWidget: TGtk3Widget; 2328 AScrollWin: PGtkScrolledWindow; 2329begin 2330 Result := False; 2331 if not IsValidHandle(Handle) then 2332 exit; 2333 AWidget := TGtk3Widget(Handle); 2334 Adjustment := nil; 2335 AScrollWin := nil; 2336 if wtScrollBar in AWidget.WidgetType then 2337 Adjustment := PGtkScrollBar(AWidget.Widget)^.adjustment 2338 else 2339 if wtScrollingWin in AWidget.WidgetType then 2340 AScrollWin := TGtk3ScrollableWin(Handle).GetScrolledWindow; 2341 2342 case SBStyle of 2343 SB_Horz: 2344 begin 2345 if not Assigned(Adjustment) and Assigned(AScrollWin) then 2346 Adjustment := AScrollWin^.get_hadjustment; 2347 end; 2348 SB_Vert: 2349 begin 2350 if not Assigned(Adjustment) and Assigned(AScrollWin) then 2351 Adjustment := AScrollWin^.get_vadjustment; 2352 end; 2353 SB_CTL: 2354 begin 2355 2356 end; 2357 SB_BOTH: 2358 begin 2359 2360 end; 2361 end; 2362 2363 if Adjustment = nil then 2364 begin 2365 DebugLn('TGtk3WidgetSet.GetScrollInfo error: cannot get PGtkAdjustment from ',dbgsName(AWidget.LCLObject)); 2366 exit; 2367 end; 2368 2369 // POS 2370 if (ScrollInfo.fMask and SIF_POS) <> 0 then 2371 ScrollInfo.nPos := Round(Adjustment^.Value); 2372 2373 // RANGE 2374 if (ScrollInfo.fMask and SIF_RANGE) <> 0 then 2375 begin 2376 ScrollInfo.nMin:= Round(Adjustment^.Lower); 2377 ScrollInfo.nMax:= Round(Adjustment^.Upper); 2378 end; 2379 // PAGE 2380 if (ScrollInfo.fMask and SIF_PAGE) <> 0 then 2381 begin 2382 ScrollInfo.nPage := Round(Adjustment^.Page_Size); 2383 end; 2384 // TRACKPOS 2385 if (ScrollInfo.fMask and SIF_TRACKPOS) <> 0 then 2386 begin 2387 ScrollInfo.nTrackPos := Round(Adjustment^.Value); 2388 end; 2389 2390 Result := True; 2391end; 2392 2393function TGtk3WidgetSet.GetStockObject(Value: Integer): THandle; 2394begin 2395 Result := 0; 2396 2397 case Value of 2398 BLACK_BRUSH: // Black brush. 2399 Result := FStockBlackBrush; 2400 DKGRAY_BRUSH: // Dark gray brush. 2401 Result := FStockDKGrayBrush; 2402 GRAY_BRUSH: // Gray brush. 2403 Result := FStockGrayBrush; 2404 LTGRAY_BRUSH: // Light gray brush. 2405 Result := FStockLtGrayBrush; 2406 NULL_BRUSH: // Null brush (equivalent to HOLLOW_BRUSH). 2407 Result := FStockNullBrush; 2408 WHITE_BRUSH: // White brush. 2409 Result := FStockWhiteBrush; 2410 2411 BLACK_PEN: // Black pen. 2412 Result := FStockBlackPen; 2413 NULL_PEN: // Null pen. 2414 Result := FStockNullPen; 2415 WHITE_PEN: // White pen. 2416 Result := FStockWhitePen; 2417 2418 {System font. By default, Windows uses the system font to draw menus, 2419 dialog box controls, and text. In Windows versions 3.0 and later, 2420 the system font is a proportionally spaced font; earlier versions of 2421 Windows used a monospace system font.} 2422 DEFAULT_GUI_FONT, SYSTEM_FONT: 2423 begin 2424 2425 If FStockSystemFont <> 0 then 2426 begin 2427 DeleteObject(FStockSystemFont); 2428 FStockSystemFont := 0; 2429 end; 2430 2431 If FStockSystemFont = 0 then 2432 FStockSystemFont := CreateDefaultFont; 2433 Result := FStockSystemFont; 2434 end; 2435 end; 2436end; 2437 2438function TGtk3WidgetSet.GetSysColor(nIndex: Integer): DWORD; 2439begin 2440 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2441 writeln('TGtk3WidgetSet.GetSysColor WARNING: SOME SYSCOLORS ARE STILL HARDCODED nIndex=',nIndex); 2442 {$ENDIF} 2443 if (nIndex = COLOR_WINDOW) or (nIndex = COLOR_WINDOWTEXT) or 2444 (nIndex = COLOR_HIGHLIGHT) or (nIndex = COLOR_HIGHLIGHTTEXT) then 2445 GetStyleWidget(lgsMemo) 2446 else 2447 if (nIndex = COLOR_MENU) or (nIndex = COLOR_MENUHILIGHT) or 2448 (nIndex = COLOR_MENUTEXT) then 2449 begin 2450 GetStyleWidget(lgsMenu); 2451 GetStyleWidget(lgsMenuitem); 2452 end else 2453 if (nIndex = COLOR_MENUBAR) then 2454 GetStyleWidget(lgsMenuBar) 2455 else 2456 if (nIndex = COLOR_SCROLLBAR) then 2457 GetStyleWidget(lgsVerticalScrollbar) 2458 else 2459 if (nIndex = COLOR_BTNFACE) or (nIndex = COLOR_BTNTEXT) or 2460 (nIndex = COLOR_BTNSHADOW) or (nIndex = COLOR_BTNHIGHLIGHT) then 2461 GetStyleWidget(lgsButton) 2462 else 2463 if (nIndex = COLOR_BACKGROUND) or (nIndex = COLOR_FORM) then 2464 GetStyleWidget(lgsWindow); 2465 Result := SysColorMap[nIndex]; 2466end; 2467 2468function TGtk3WidgetSet.GetSysColorBrush(nIndex: Integer): HBrush; 2469begin 2470 if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then 2471 begin 2472 Result := 0; 2473 DebugLn(Format('ERROR: [TGtk3WidgetSet.GetSysColorBrush] Bad Value: %d. Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS])); 2474 end else 2475 begin 2476 Result := FSysColorBrushes[nIndex]; 2477 if Result = HBRUSH(-1) then 2478 begin 2479 InitSysColorBrushes; 2480 Result := FSysColorBrushes[nIndex]; 2481 if Result = HBRUSH(-1) then 2482 DebugLn('WARNING: GetSysColorBrush SysColorBrushes arent''t initialized properly....'); 2483 end; 2484 end; 2485end; 2486 2487function TGtk3WidgetSet.GetSystemMetrics(nIndex: Integer): Integer; 2488var 2489 auw: guint; 2490 auh: guint; 2491 ascreen: PGdkScreen; 2492 ARect: TGdkRectangle; 2493begin 2494 Result := 0; 2495 case nIndex of 2496 SM_CXCURSOR, 2497 SM_CYCURSOR: 2498 begin 2499 // Width and height of a cursor, in pixels. For win32 system cannot create cursors of other sizes. 2500 // For gtk this should be maximal cursor sizes 2501 gdk_display_get_maximal_cursor_size(gdk_display_get_default, @auw, @auh); 2502 if nIndex = SM_CXCURSOR then 2503 Result := auw // return width 2504 else 2505 Result := auh; // return height 2506 end; 2507 SM_CXDRAG: 2508 begin 2509 Result := 2; 2510 end; 2511 SM_CYDRAG: 2512 begin 2513 Result := 2; 2514 end; 2515 SM_CXEDGE: 2516 begin 2517 Result := 2; 2518 end; 2519 SM_CYEDGE: 2520 begin 2521 Result := 2; 2522 end; 2523 2524 SM_CXICON, 2525 SM_CYICON: 2526 // big icon size 2527 // gtk recommends sizes 16,32,48. optional: 64 and 128 2528 Result := 128; 2529 2530 SM_CXMAXIMIZED: 2531 begin 2532 ascreen := gdk_screen_get_default(); 2533 gdk_screen_get_monitor_workarea(ascreen, 0, @ARect); 2534 Result := ARect.width; 2535 end; 2536 SM_CYMAXIMIZED: 2537 begin 2538 ascreen := gdk_screen_get_default(); 2539 gdk_screen_get_monitor_workarea(ascreen, 0, @ARect); 2540 Result := ARect.height; 2541 end; 2542 2543 SM_CXFULLSCREEN, 2544 SM_CXSCREEN: 2545 begin 2546 ascreen := gdk_screen_get_default(); 2547 gdk_screen_get_monitor_geometry(ascreen, 0, @ARect); 2548 Result := ARect.width; 2549 end; 2550 SM_CXVIRTUALSCREEN: 2551 begin 2552 Result := gdk_Screen_Width; 2553 end; 2554 SM_CYFULLSCREEN, 2555 SM_CYSCREEN: 2556 begin 2557 ascreen := gdk_screen_get_default(); 2558 gdk_screen_get_monitor_geometry(ascreen, 0, @ARect); 2559 Result := ARect.height; 2560 end; 2561 SM_CYVIRTUALSCREEN: 2562 begin 2563 result := gdk_Screen_Height; 2564 end; 2565 SM_LCLHasFormAlphaBlend: 2566 Result := 1; 2567 end; 2568end; 2569 2570function TGtk3WidgetSet.GetTextColor(DC: HDC): TColorRef; 2571begin 2572 Result := CLR_INVALID; 2573 if IsValidDC(DC) then 2574 Result := TColorRef(TGtk3DeviceContext(DC).CurrentTextColor); 2575end; 2576 2577function TGtk3WidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; 2578 var Size: TSize): Boolean; 2579begin 2580 Result := False; 2581 if not IsValidDC(DC) then 2582 exit; 2583 if (Count <= 0) or (Str = nil) or (StrPas(Str) = '') then 2584 begin 2585 FillChar(Size, SizeOf(Size), 0); 2586 Exit; 2587 end; 2588 TGtk3DeviceContext(DC).CurrentFont.Layout^.set_text(Str, Count); 2589 TGtk3DeviceContext(DC).CurrentFont.Layout^.get_pixel_size(@Size.Cx, @Size.CY); 2590 // DebugLn('TGtk3WidgetSet.GetTextExtentPoint pixel size is ',dbgs(Size), 2591 // ' avgcharwidth ',dbgs(ACharWidth div PANGO_SCALE),' avgdigitwidth ',dbgs(ADigitWidth div PANGO_SCALE)); 2592 Result := True; 2593end; 2594 2595function TGtk3WidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; 2596const 2597 TestString: array[boolean] of string = ( 2598 // single byte char font 2599 '{ABCDEFGHIJKLMNOPQRSTUVWXYZXYZabcdefghijklmnopqrstuvwxyz|_}', 2600 // double byte char font 2601 #0'{'#0'A'#0'B'#0'C'#0'D'#0'E'#0'F'#0'G'#0'H'#0'I'#0'J'#0'K'#0'L'#0'M'#0'N' 2602 +#0'O'#0'P'#0'Q'#0'R'#0'S'#0'T'#0'U'#0'V'#0'W'#0'X'#0'Y'#0'Z'#0'X'#0'Y'#0'Z' 2603 +#0'a'#0'b'#0'c'#0'd'#0'e'#0'f'#0'g'#0'h'#0'i'#0'j'#0'k'#0'l'#0'm'#0'n'#0'o' 2604 +#0'p'#0'q'#0'r'#0's'#0't'#0'u'#0'v'#0'w'#0'x'#0'y'#0'z'#0'|'#0'_'#0'}' 2605 ); 2606var 2607 AFont: TGtk3Font; 2608 APangoMetrics: PPangoFontMetrics; 2609 aRect: TPangoRectangle; 2610 APangoWeight: TPangoWeight; 2611begin 2612 Result := False; 2613 if IsValidDC(DC) then 2614 begin 2615 //TODO add metrics to cache of font, so if we have valid metrics just return. 2616 //or create metrics when font is created (like qt uses) 2617 AFont := TGtk3DeviceContext(DC).CurrentFont; 2618 2619 APangoMetrics := pango_context_get_metrics(AFont.Layout^.get_context, 2620 AFont.Handle, AFont.Layout^.get_context^.get_language); 2621 if APangoMetrics = nil then 2622 begin 2623 DebugLn(['TGtk3WidgetSet.UpdateDCTextMetric WARNING: no pango metrics']); 2624 exit; 2625 end; 2626 FillChar(TM, SizeOf(TM), #0); 2627 2628 TM.tmAveCharWidth := Max(1, 2629 PANGO_PIXELS(pango_font_metrics_get_approximate_char_width(APangoMetrics)) 2630 ); 2631 TM.tmAscent := PANGO_PIXELS(APangoMetrics^.get_ascent); 2632 TM.tmDescent := PANGO_PIXELS(APangoMetrics^.get_descent); 2633 2634 TM.tmHeight := TM.tmAscent + TM.tmDescent; 2635 2636 pango_layout_set_text(AFont.Layout, PChar(TestString[True]), 2637 length(PChar(TestString[True]))); 2638 pango_layout_get_extents(AFont.Layout, nil, @aRect); 2639 2640 // lBearing := 0; // PANGO_LBEARING(aRect) div PANGO_SCALE; 2641 // rBearing := 0; // PANGO_RBEARING(aRect) div PANGO_SCALE; 2642 2643 pango_layout_set_text(AFont.Layout, 'M', 1); 2644 pango_layout_get_pixel_size(AFont.Layout, @aRect.width, @aRect.height); 2645 TM.tmMaxCharWidth := Max(1,aRect.width); 2646 pango_layout_set_text(AFont.Layout, 'W', 1); 2647 pango_layout_get_pixel_size(AFont.Layout, @aRect.width, @aRect.height); 2648 TM.tmMaxCharWidth := Max(TM.tmMaxCharWidth,aRect.width); 2649 2650 APangoWeight := AFont.Handle^.get_weight; 2651 2652 if APangoWeight < PANGO_WEIGHT_THIN then 2653 APangoWeight := PANGO_WEIGHT_THIN; 2654 if APangoWeight > PANGO_WEIGHT_HEAVY then 2655 APangoWeight := PANGO_WEIGHT_HEAVY; 2656 2657 TM.tmWeight := APangoWeight; 2658 2659 TM.tmFirstChar := 'a'; 2660 TM.tmLastChar := 'z'; 2661 TM.tmDefaultChar := 'x'; 2662 TM.tmBreakChar := '?'; 2663 2664 TM.tmItalic := Ord(AFont.Handle^.get_style = PANGO_STYLE_ITALIC); 2665 // APangoMetrics^.get_underline_position; 2666 // TM.tmUnderlined := 2667 // TM.tmStruckOut := 2668 pango_font_metrics_unref(APangoMetrics); 2669 Result := True; 2670 end; 2671end; 2672 2673function TGtk3WidgetSet.GetViewPortExtEx(DC: HDC; Size: PSize): Integer; 2674begin 2675 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2676 DebugLn('WARNING: TGtk3WidgetSet.GetViewportExtEx not implemented ...'); 2677 {$ENDIF} 2678 Result:=inherited GetViewPortExtEx(DC, Size); 2679end; 2680 2681function TGtk3WidgetSet.GetViewPortOrgEx(DC: HDC; P: PPoint): Integer; 2682begin 2683 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2684 DebugLn('WARNING: TGtk3WidgetSet.GetViewportOrgEx not implemented ...'); 2685 {$ENDIF} 2686 Result:=inherited GetViewPortOrgEx(DC, P); 2687end; 2688 2689function TGtk3WidgetSet.GetWindowExtEx(DC: HDC; Size: PSize): Integer; 2690begin 2691 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2692 DebugLn('WARNING: TGtk3WidgetSet.GetWindowExtEx not implemented ...'); 2693 {$ENDIF} 2694 Result:=inherited GetWindowExtEx(DC, Size); 2695end; 2696 2697function TGtk3WidgetSet.GetWindowLong(Handle: HWND; int: Integer): PtrInt; 2698begin 2699 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2700 DebugLn('WARNING: TGtk3WidgetSet.GetWindowLong not implemented ...'); 2701 {$ENDIF} 2702 Result:=inherited GetWindowLong(Handle, int); 2703end; 2704 2705function TGtk3WidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer; 2706var 2707 Matrix: cairo_matrix_t; 2708 dx: Double; 2709 dy: Double; 2710begin 2711 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2712 // DebugLn('WARNING: TGtk3WidgetSet.GetWindowOrgEx not implemented ...'); 2713 {$ENDIF} 2714 Result := 0; 2715 if not IsValidDC(DC) and (P <> nil) then 2716 begin 2717 {$ifdef VerboseGtk3WinAPI} 2718 WriteLn('Trace: < [WinAPI GetWindowOrgEx] No valid DC or P is nil'); 2719 {$endif} 2720 exit; 2721 end; 2722 cairo_get_matrix(TGtk3DeviceContext(DC).pcr, @Matrix); 2723 dx := 0; 2724 dy := 0; 2725 cairo_matrix_transform_point(@Matrix, @dx, @dy); 2726 // DebugLn('GetWindowOrgEx POINT ',Format('dx %d dy %d',[-Trunc(Dx), -Trunc(Dy)])); 2727 if P <> nil then 2728 begin 2729 P^.X := -Trunc(DX)+TGtk3DeviceContext(DC).fncOrigin.X; 2730 P^.Y := -Trunc(DY)+TGtk3DeviceContext(DC).fncOrigin.Y; 2731 end; 2732 Result := 1; 2733end; 2734 2735function TGtk3WidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer; 2736var 2737 AWindow: PGdkWindow; 2738 x, y: gint; 2739 //w, h: gint; 2740 GRect: TGdkRectangle; 2741 Allocation: TGtkAllocation; 2742begin 2743 Result := 0; 2744 if Handle <> 0 then 2745 begin 2746 AWindow := TGtk3Widget(Handle).GetWindow; 2747 if AWindow <> nil then 2748 begin 2749 AWindow^.get_origin(@x, @y); 2750 //w := AWindow^.get_width; 2751 //h := AWindow^.get_height; 2752 AWindow^.get_frame_extents(@GRect); 2753 // R := RectFromGdkRect(GRect); 2754 ARect := Bounds(0, 0, GRect.width, GRect.Height); 2755 Result := 1; 2756 end else 2757 begin 2758 TGtk3Widget(Handle).Widget^.get_allocation(@Allocation); 2759 ARect := Bounds(Allocation.x, Allocation.y, Allocation.width, Allocation.height); 2760 end; 2761 end; 2762end; 2763 2764function TGtk3WidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left, 2765 Top: integer): boolean; 2766var 2767 AWidget: TGtk3Widget; 2768 APos: TPoint; 2769begin 2770 Left:=0; 2771 Top:=0; 2772 if Handle = 0 then 2773 exit(False); 2774 AWidget := TGtk3Widget(Handle); 2775 Result := AWidget.GetPosition(APos); 2776 Left:=APos.X; 2777 Top:=APos.Y; 2778end; 2779 2780function TGtk3WidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: integer 2781 ): boolean; 2782var 2783 aWidget: PGtkWidget; 2784begin 2785 Result := False; 2786 if Handle <> 0 then 2787 begin 2788 aWidget:= TGtk3Widget(Handle).Widget; 2789 if aWidget<>nil then 2790 begin 2791 Width := aWidget^.get_allocated_width; 2792 Height := aWidget^.get_allocated_Height; 2793 Result := True; 2794 end; 2795 end; 2796end; 2797 2798procedure TGtk3WidgetSet.InitializeCriticalSection( 2799 var CritSection: TCriticalSection); 2800var 2801 ACritSec: System.PRTLCriticalSection; 2802begin 2803 New(ACritSec); 2804 System.InitCriticalSection(ACritSec^); 2805 CritSection:=TCriticalSection(ACritSec); 2806end; 2807 2808function TGtk3WidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect; 2809 bErase: Boolean): Boolean; 2810begin 2811 Result := False; 2812 if AHandle <> 0 then 2813 begin 2814 TGtk3Widget(AHandle).Update(Rect); 2815 Result := True; 2816 end; 2817end; 2818 2819function TGtk3WidgetSet.InvalidateRgn(Handle: HWND; Rgn: HRGN; Erase: Boolean): Boolean; 2820//var 2821// R: TRect; 2822begin 2823 Result := False; // inherited InvalidateRgn(Handle, Rgn, Erase); 2824 if IsValidHandle(Handle) then 2825 begin 2826 if IsValidGDIObject(RGN) then 2827 begin 2828 gtk_widget_queue_draw_region(TGtk3Widget(Handle).GetContainerWidget, 2829 TGtk3Region(RGN).Handle) 2830 end else 2831 TGtk3Widget(Handle).Update(nil); 2832 //TODO: TGtk3Region must be implemented as Pcairo_region_t 2833 // GetRgnBox(Rgn, @R); 2834 // InvalidateRect(Handle, @R, True); 2835 Result := True; 2836 // gtk_widget_queue_draw_region(); 2837 end; 2838end; 2839 2840function TGtk3WidgetSet.IsIconic(handle: HWND): boolean; 2841begin 2842 Result := (handle <> 0) and TGtk3Widget(Handle).IsIconic; 2843end; 2844 2845function TGtk3WidgetSet.IsWindow(handle: HWND): boolean; 2846begin 2847 Result := (handle <> 0) and 2848 Gtk3IsWidget(TGtk3Widget(Handle).Widget); 2849end; 2850 2851function TGtk3WidgetSet.IsWindowEnabled(handle: HWND): boolean; 2852begin 2853 Result := (handle <> 0) and TGtk3Widget(Handle).Enabled and 2854 TGtk3Widget(Handle).Visible; 2855end; 2856 2857function TGtk3WidgetSet.IsWindowVisible(handle: HWND): boolean; 2858begin 2859 Result := (handle <> 0) and TGtk3Widget(Handle).Visible; 2860end; 2861 2862function TGtk3WidgetSet.IsZoomed(handle: HWND): boolean; 2863begin 2864 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2865 DebugLn('WARNING: TGtk3WidgetSet.IsZoomed not implemented ...'); 2866 {$ENDIF} 2867 Result:=inherited IsZoomed(handle); 2868end; 2869 2870procedure TGtk3WidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection 2871 ); 2872var 2873 ACritSec: System.PRTLCriticalSection; 2874begin 2875 ACritSec:=System.PRTLCriticalSection(CritSection); 2876 System.LeaveCriticalsection(ACritSec^); 2877end; 2878 2879function TGtk3WidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean; 2880begin 2881 if not IsValidDC(DC) then 2882 exit(False); 2883 Result := TGtk3DeviceContext(DC).LineTo(X, Y); 2884end; 2885 2886function TGtk3WidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; 2887var 2888 //Matrix: cairo_matrix_t; 2889 cr: PCairo_t; 2890 P: PPoint; 2891 dx, dy: Double; 2892 //Pt: TPoint; 2893begin 2894 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2895 // DebugLn('WARNING: TGtk3WidgetSet.LPtoDP not implemented ...'); 2896 {$ENDIF} 2897 Result := False; 2898 // inherited LPtoDP(DC, Points, Count); 2899 if not IsValidDC(DC) then 2900 exit; 2901 cr := TGtk3DeviceContext(DC).pcr; 2902 2903 P := @Points; 2904 while Count > 0 do 2905 begin 2906 Dec(Count); 2907 DX := P^.X; 2908 DY := P^.Y; 2909 // DebugLn('LPTODP INPUT ',Format('dx %2.2n dy %2.2n',[dx, dy])); 2910 //cairo_matrix_translate(@Matrix, Dx, Dy); 2911 //cairo_matrix_transform_point(@Matrix, @Dx, @Dy); 2912 cairo_user_to_device(cr,@dx,@dy); 2913 // DebugLn('LPTODP Output ',Format('dx %2.2n dy %2.2n',[dx, dy])); 2914 P^.X := Round(DX)-TGtk3DeviceContext(DC).fncOrigin.x; 2915 P^.Y := Round(DY)-TGtk3DeviceContext(DC).fncOrigin.y; 2916 Inc(P); 2917 end; 2918 Result:=true; 2919end; 2920 2921function TGtk3WidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar; 2922 uType: Cardinal): integer; 2923var 2924 fact:TGtk3DialogFactory; 2925begin 2926 fact:=TGtk3DialogFactory.CreateMsgBox(hWnd,lpText,lpCaption,uType); 2927 try 2928 fact.run; 2929 Result:=fact.lcl_result; 2930 finally 2931 fact.Free; 2932 end; 2933end; 2934 2935function TGtk3WidgetSet.MonitorFromPoint(ptScreenCoords: TPoint; dwFlags: DWord 2936 ): HMONITOR; 2937var 2938 pscr:PGdkScreen; 2939 nmon:gint; 2940begin 2941 pscr:=TGdkScreen.get_default; 2942 nmon:=pscr^.get_monitor_at_point(ptScreenCoords.X,ptScreenCoords.Y); 2943 Result:=HMONITOR(nmon+1); 2944end; 2945 2946function TGtk3WidgetSet.MonitorFromWindow(hWnd: HWND; dwFlags: DWord): HMONITOR; 2947var 2948 pscr:PGdkScreen; 2949 nmon:gint; 2950begin 2951 pscr:=TGdkScreen.get_default; 2952 nmon:=pscr^.get_monitor_at_window(TGtk3Widget(hWnd).GetWindow); 2953 Result:=HMONITOR(nmon+1); 2954end; 2955 2956function TGtk3WidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint 2957 ): Boolean; 2958begin 2959 if not IsValidDC(DC) then 2960 exit(False); 2961 Result := TGtk3DeviceContext(DC).MoveTo(X, Y, OldPoint); 2962end; 2963 2964function TGtk3WidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer 2965 ): Integer; 2966begin 2967 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2968 DebugLn('WARNING: TGtk3WidgetSet.OffsetRgn not implemented ...'); 2969 {$ENDIF} 2970 Result:=inherited OffsetRgn(RGN, nXOffset, nYOffset); 2971end; 2972 2973function TGtk3WidgetSet.PaintRgn(DC: HDC; RGN: HRGN): Boolean; 2974begin 2975 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2976 DebugLn('WARNING: TGtk3WidgetSet.PaintRgn not implemented ...'); 2977 {$ENDIF} 2978 Result:=inherited PaintRgn(DC, RGN); 2979end; 2980 2981function TGtk3WidgetSet.PeekMessage(var lpMsg: TMsg; Handle: HWND; 2982 wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): Boolean; 2983begin 2984 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 2985 DebugLn('WARNING: TGtk3WidgetSet.PeekMessage not implemented ...'); 2986 {$ENDIF} 2987 Result:=inherited PeekMessage(lpMsg, Handle, wMsgFilterMin, wMsgFilterMax, 2988 wRemoveMsg); 2989end; 2990 2991function TGtk3WidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; 2992 Filled, Continuous: boolean): boolean; 2993begin 2994 if not IsValidDC(DC) then 2995 exit(False); 2996 TGtk3DeviceContext(DC).drawPolyBezier(Points, NumPts, Filled, Continuous); 2997 Result:=True; 2998end; 2999 3000function TGtk3WidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; 3001 Winding: boolean): boolean; 3002var 3003 NFillRule: integer; 3004 bFill, bBorder: boolean; 3005begin 3006 if not IsValidDC(DC) then 3007 exit(False); 3008 if Winding then 3009 NFillRule := Ord(CAIRO_FILL_RULE_WINDING) 3010 else 3011 NFillRule := Ord(CAIRO_FILL_RULE_EVEN_ODD); 3012 bFill := TGtk3DeviceContext(DC).CurrentBrush.Style <> BS_NULL; 3013 bBorder := TGtk3DeviceContext(DC).CurrentPen.Style <> psClear; 3014 TGtk3DeviceContext(DC).drawPolygon(Points, NumPts, NFillRule, bFill, bBorder); 3015 Result:= True; 3016end; 3017 3018function TGtk3WidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean; 3019begin 3020 if not IsValidDC(DC) then 3021 exit(False); 3022 if TGtk3DeviceContext(DC).CurrentPen.Style = psClear then Exit; 3023 TGtk3DeviceContext(DC).drawPolyLine(Points, NumPts); 3024 Result:=True; 3025end; 3026 3027 3028type 3029 PCustomGtk3Message = ^TCustomGtk3Message; 3030 TCustomGtk3Message = record 3031 Handle: HWND; 3032 Msg: Cardinal; 3033 AwParam: WParam; 3034 AlParam: LParam; 3035 Result: LRESULT; 3036 end; 3037 3038function Gtk3ProcessPostMessage(user_data: gpointer): gboolean; cdecl; 3039var 3040 AMsg: TCustomGtk3Message; 3041 AMessage: TLMessage; 3042begin 3043 Result := False; 3044 if user_data <> nil then 3045 begin 3046 AMsg := TCustomGtk3Message(user_data^); 3047 if AMsg.Handle <> 0 then 3048 begin 3049 FillChar(AMessage{%H-}, SizeOf(AMessage), #0); 3050 AMessage.Msg := AMsg.Msg; 3051 AMessage.WParam := AMsg.AwParam; 3052 AMessage.LParam := AMsg.AlParam; 3053 TGtk3Widget(AMsg.Handle).DeliverMessage(AMessage); 3054 end; 3055 g_idle_remove_by_data(user_data); 3056 Freemem(user_data); 3057 user_data := nil; 3058 Result := True; 3059 end; 3060end; 3061 3062function TGtk3WidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; 3063 wParam: WParam; lParam: LParam): Boolean; 3064var 3065 AEvent: PCustomGtk3Message; 3066begin 3067 Result := False; 3068 if Handle <> 0 then 3069 begin 3070 AEvent := GetMem(SizeOf(TCustomGtk3Message)); 3071 AEvent^.Handle := Handle; 3072 AEvent^.Msg := Msg; 3073 AEvent^.AwParam := wParam; 3074 AEvent^.AlParam := lParam; 3075 AEvent^.Result := 0; 3076 g_idle_add(@Gtk3ProcessPostMessage, AEvent); 3077 if GetCurrentThreadId <> MainThreadID then 3078 begin 3079 // writeln('TGtk3WidgetSet.PostMessage from different thread !'); 3080 g_main_context_wakeup(g_main_context_default); 3081 end; 3082 Result := True; 3083 end; 3084end; 3085 3086function TGtk3WidgetSet.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean; 3087begin 3088 Result := False; 3089 if IsValidGDIObject(RGN) then 3090 Result := TGtk3Region(RGN).ContainsPoint(Point(X, Y)); 3091end; 3092 3093function TGtk3WidgetSet.RadialArc(DC: HDC; left, top, right, bottom, sx, sy, 3094 ex, ey: Integer): Boolean; 3095begin 3096 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3097 DebugLn('WARNING: TGtk3WidgetSet.RadialArc not implemented ...'); 3098 {$ENDIF} 3099 Result:=inherited RadialArc(DC, left, top, right, bottom, sx, sy, ex, ey); 3100end; 3101 3102function TGtk3WidgetSet.RadialChord(DC: HDC; x1, y1, x2, y2, sx, sy, ex, 3103 ey: Integer): Boolean; 3104begin 3105 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3106 DebugLn('WARNING: TGtk3WidgetSet.RadialChord not implemented ...'); 3107 {$ENDIF} 3108 Result:=inherited RadialChord(DC, x1, y1, x2, y2, sx, sy, ex, ey); 3109end; 3110 3111function TGtk3WidgetSet.RealizePalette(DC: HDC): Cardinal; 3112begin 3113 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3114 DebugLn('WARNING: TGtk3WidgetSet.RealizePalette not implemented ...'); 3115 {$ENDIF} 3116 Result := inherited RealizePalette(DC); 3117end; 3118 3119function TGtk3WidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; 3120var 3121 R: TRect; 3122 bFill, bBorder: Boolean; 3123begin 3124 if not IsValidDC(DC) then 3125 exit(False); 3126 R := NormalizeRect(Rect(X1, Y1, X2, Y2)); 3127 if IsRectEmpty(R) then Exit(True); 3128 bFill := TGtk3DeviceContext(DC).CurrentBrush.Style <> BS_NULL; 3129 bBorder := TGtk3DeviceContext(DC).CurrentPen.Style <> psClear; 3130 TGtk3DeviceContext(DC).drawRect(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, bFill, bBorder); 3131 Result := True; 3132end; 3133 3134function TGtk3WidgetSet.RectInRegion(RGN: HRGN; ARect: TRect): Boolean; 3135begin 3136 Result := False; 3137 if IsValidGDIObject(RGN) then 3138 Result := TGtk3Region(Rgn).ContainsRect(ARect); 3139end; 3140 3141function TGtk3WidgetSet.RectVisible(dc: hdc; const ARect: TRect): Boolean; 3142var 3143 ACairoRegion: Pcairo_region_t; 3144 ACairoRect: Tcairo_rectangle_int_t; 3145begin 3146 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3147 // DebugLn('WARNING: TGtk3WidgetSet.RectVisible not implemented ...'); 3148 {$ENDIF} 3149 Result := False; 3150 if not IsValidDC(DC) then 3151 exit; 3152 if (TGtk3DeviceContext(DC).Parent <> nil) and 3153 Gtk3IsGdkWindow(TGtk3DeviceContext(DC).Parent^.window) then 3154 begin 3155 if not gdk_window_is_visible(TGtk3DeviceContext(DC).Parent^.window) then 3156 exit; 3157 ACairoRegion := gdk_window_get_visible_region(TGtk3DeviceContext(DC).Parent^.window); 3158 end else 3159 ACairoRegion := gdk_window_get_visible_region(gdk_get_default_root_window); 3160 ACairoRect.x := ARect.Left; 3161 ACairoRect.y := ARect.Top; 3162 ACairoRect.width := ARect.Right - ARect.Left; 3163 ACairoRect.height := ARect.Bottom - ARect.Top; 3164 Result := cairo_region_contains_rectangle(ACairoRegion, @ACairoRect) <> CAIRO_REGION_OVERLAP_OUT; 3165end; 3166 3167function TGtk3WidgetSet.RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer 3168 ): Boolean; 3169begin 3170 Result := False; 3171 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3172 DebugLn('WARNING: TGtk3WidgetSet.RegroupMenuItem not implemented ...'); 3173 {$ENDIF} 3174 // inherited RegroupMenuItem(hndMenu, GroupIndex); 3175end; 3176 3177function TGtk3WidgetSet.ReleaseCapture: Boolean; 3178var 3179 AWidget: TGtk3Widget; 3180begin 3181 {$IFDEF VerboseGtk3WinApi} 3182 DebugLn('TGtk3WidgetSet.ReleaseCapture'); 3183 {$ENDIF} 3184 AWidget := TGtk3Widget(GetCapture); 3185 Result := AWidget <> nil; 3186 if Result then 3187 begin 3188 if AWidget.Widget = nil then exit; 3189 if AWidget.GetContainerWidget^.has_grab then 3190 gtk_grab_remove(AWidget.GetContainerWidget) 3191 else 3192 if AWidget.Widget^.has_grab then 3193 gtk_grab_remove(AWidget.Widget); 3194 end; 3195end; 3196 3197function TGtk3WidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer; 3198begin 3199 Result := 0; 3200 if IsValidDC(DC) then 3201 begin 3202 if TGtk3DeviceContext(DC).CanRelease then 3203 TGtk3DeviceContext(DC).Free; 3204 Result := 1; 3205 end; 3206end; 3207 3208function TGtk3WidgetSet.RemoveProp(Handle: hwnd; Str: PChar): THandle; 3209begin 3210 Result := 0; 3211 if Handle = 0 then 3212 exit; 3213 if Gtk3IsObject(TGtk3Widget(Handle).Widget) then 3214 g_object_set_data(TGtk3Widget(Handle).Widget, Str, nil); 3215 if TGtk3Widget(Handle).GetContainerWidget <> TGtk3Widget(Handle).Widget then 3216 begin 3217 if Gtk3IsObject(TGtk3Widget(Handle).GetContainerWidget) then 3218 g_object_set_data(TGtk3Widget(Handle).GetContainerWidget, Str, nil); 3219 end; 3220 Result := 1; 3221end; 3222 3223function TGtk3WidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean; 3224begin 3225 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3226 // DebugLn('WARNING: TGtk3WidgetSet.RestoreDC not implemented ...'); 3227 {$ENDIF} 3228 Result := False; 3229 if not IsValidDC(DC) then 3230 exit; 3231 cairo_restore(TGtk3DeviceContext(DC).pcr); 3232 Result := True; 3233end; 3234 3235function TGtk3WidgetSet.RoundRect(DC: hDC; X1, Y1, X2, Y2: Integer; RX, 3236 RY: Integer): Boolean; 3237begin 3238 Result := False; 3239 if not IsValidDC(DC) then 3240 exit; 3241 Result := TGtk3DeviceContext(DC).RoundRect(X1, Y1, X2, Y2, RX, RY); 3242end; 3243 3244function TGtk3WidgetSet.SaveDC(DC: HDC): Integer; 3245begin 3246 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3247 // DebugLn('WARNING: TGtk3WidgetSet.SaveDC not implemented ...'); 3248 {$ENDIF} 3249 Result := 0; 3250 if not IsValidDC(DC) then 3251 exit; 3252 cairo_save(TGtk3DeviceContext(DC).pcr); 3253 Result := 1; 3254end; 3255 3256function TGtk3WidgetSet.ScreenToClient(Handle: HWND; var P: TPoint): Integer; 3257begin 3258 Result := 0; 3259 {$ifdef VerboseGtk3WinApi} 3260 DebugLn('Trace:> [TGtk3WidgetSet.ScreenToClient] ',dbgs(P)); 3261 {$endif} 3262 if not IsValidHandle(Handle) then 3263 exit; 3264 3265 Result := TGtk3Widget(Handle).ScreenToClient(P); 3266end; 3267 3268function TGtk3WidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, 3269 prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean; 3270begin 3271 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3272 DebugLn('WARNING: TGtk3WidgetSet.ScrollWindowEx not implemented ...'); 3273 {$ENDIF} 3274 Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip, 3275 hrgnUpdate, prcUpdate, flags); 3276end; 3277 3278function TGtk3WidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint; 3279begin 3280 Result := 0; 3281 if IsValidDC(DC) then 3282 begin 3283 if IsValidGDIObject(RGN) then 3284 Result := TGtk3DeviceContext(DC).setClipRegion(TGtk3Region(RGN)) 3285 else 3286 Result := TGtk3DeviceContext(DC).ResetClip; 3287 end; 3288end; 3289 3290function TGtk3WidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; 3291begin 3292 Result := 0; 3293 if not IsValidDC(DC) then 3294 exit; 3295 if IsValidGDIObject(GDIObj) then 3296 begin 3297 Result:=HGDIOBJ(TGtk3ContextObject(GDIOBJ).Select(TGtk3DeviceContext(DC))); 3298 end; 3299end; 3300 3301function TGtk3WidgetSet.SelectPalette(DC: HDC; Palette: HPALETTE; 3302 ForceBackground: Boolean): HPALETTE; 3303begin 3304 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3305 DebugLn('WARNING: TGtk3WidgetSet.SelectPalette not implemented ...'); 3306 {$ENDIF} 3307 Result := inherited SelectPalette(DC, Palette, ForceBackground); 3308end; 3309 3310function TGtk3WidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal; 3311 wParam: WParam; lParam: LParam): LResult; 3312begin 3313 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3314 DebugLn('WARNING: TGtk3WidgetSet.SendMessage not implemented ...'); 3315 {$ENDIF} 3316 Result := inherited SendMessage(HandleWnd, Msg, wParam, lParam); 3317end; 3318 3319function TGtk3WidgetSet.SetActiveWindow(Handle: HWND): HWND; 3320begin 3321 Result := GetActiveWindow; 3322 if Handle <> 0 then 3323 begin 3324 if wtWindow in TGtk3Widget(Handle).WidgetType then 3325 PGtkWindow(TGtk3Window(Handle).Widget)^.present; 3326 end; 3327end; 3328 3329function TGtk3WidgetSet.SetBkColor(DC: HDC; Color: TColorRef): TColorRef; 3330begin 3331 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3332 // DebugLn('WARNING: TGtk3WidgetSet.SetBkColor not implemented ...'); 3333 {$ENDIF} 3334 Result := clNone; 3335 if not IsValidDC(DC) then 3336 exit; 3337 Result := TGtk3DeviceContext(DC).CurrentBrush.Color; 3338 TGtk3DeviceContext(DC).CurrentBrush.Color := TColor(ColorToRGB(TColor(Color))); 3339end; 3340 3341function TGtk3WidgetSet.SetBkMode(DC: HDC; bkMode: Integer): Integer; 3342begin 3343 {.$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3344 // DebugLn('WARNING: TGtk3WidgetSet.SetBkMode not implemented ...', dbgs(BkMode)); 3345 {.$ENDIF} 3346 Result := 0; 3347 if not IsValidDC(DC) then 3348 exit; 3349 Result := TGtk3DeviceContext(DC).BkMode; 3350 TGtk3DeviceContext(DC).BkMode := bkMode; 3351 // if cairo_pattern_get_type(cairo_get_source(TGtk3DeviceContext(DC).Widget)) = CAIRO_PATTERN_TYPE_SURFACE then 3352 // Result := TRANSPARENT; 3353 // we must use TGtk3Brush.Handle = Pcairo_pattern_t 3354 // cairo_pattern_get_type(nil).CAIRO_PATTERN_TYPE_SOLID; 3355 // cairo_get_source(); 3356end; 3357 3358function TGtk3WidgetSet.SetCapture(AHandle: HWND): HWND; 3359var 3360 Message: TLMessage; 3361begin 3362 {$IFDEF VerboseGtk3WinApi} 3363 DebugLn('TGtk3WidgetSet.SetCapture'); 3364 {$ENDIF} 3365 Result := GetCapture; 3366 if Result <> AHandle then 3367 begin 3368 if Result <> 0 then 3369 ReleaseCapture; 3370 if IsValidHandle(AHandle) then 3371 begin 3372 TGtk3Widget(AHandle).SetCapture; 3373 //if (Result <> 0) then 3374 begin 3375 Message.Msg := 0; 3376 FillChar(Message, SizeOf(Message), 0); 3377 Message.msg := LM_CAPTURECHANGED; 3378 Message.wParam := 0; 3379 Message.lParam := PtrInt(Result); 3380 LCLMessageGlue.DeliverMessage(TGtk3Widget(AHandle).LCLObject, Message); 3381 end; 3382 end; 3383 end; 3384end; 3385 3386function TGtk3WidgetSet.SetCaretPos(X, Y: Integer): Boolean; 3387begin 3388 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3389 DebugLn('WARNING: TGtk3WidgetSet.SetCaretPos not implemented ...'); 3390 {$ENDIF} 3391 Result:=inherited SetCaretPos(X, Y); 3392end; 3393 3394function TGtk3WidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; 3395begin 3396 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3397 DebugLn('WARNING: TGtk3WidgetSet.SetCaretPosEx not implemented ...'); 3398 {$ENDIF} 3399 Result:=inherited SetCaretPosEx(Handle, X, Y); 3400end; 3401 3402function TGtk3WidgetSet.SetCaretRespondToFocus(handle: HWND; 3403 ShowHideOnFocus: boolean): Boolean; 3404begin 3405 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3406 DebugLn('WARNING: TGtk3WidgetSet.SetCaretRespondToFocus not implemented ...'); 3407 {$ENDIF} 3408 Result:=inherited SetCaretRespondToFocus(handle, ShowHideOnFocus); 3409end; 3410 3411function TGtk3WidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR; 3412begin 3413 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3414 // DebugLn('WARNING: TGtk3WidgetSet.SetCursor not implemented ...'); 3415 {$ENDIF} 3416 Result := FGlobalCursor; 3417 if ACursor = FGlobalCursor then Exit; 3418 if ACursor = Screen.Cursors[crDefault] 3419 then SetGlobalCursor(0) 3420 else SetGlobalCursor(ACursor); 3421 FGlobalCursor := ACursor; 3422end; 3423 3424function TGtk3WidgetSet.SetCursorPos(X, Y: Integer): Boolean; 3425var 3426 ADeviceManager: PGdkDeviceManager; 3427 APointer: PGdkDevice; 3428begin 3429 ADeviceManager := gdk_display_get_device_manager(gdk_display_get_default); 3430 APointer := gdk_device_manager_get_client_pointer(ADeviceManager); 3431 // howto get what screen we are querying on ? 3432 // gdk_display_get_screen(gdk_display_get_default, 0); 3433 gdk_device_warp(APointer, gdk_screen_get_default, X, Y); 3434 Result := True; 3435end; 3436 3437function TGtk3WidgetSet.SetFocus(hWnd: HWND): HWND; 3438begin 3439 Result := GetFocus; 3440 if hWnd <> 0 then 3441 begin 3442 {$IFDEF GTK3DEBUGFOCUS} 3443 if Result <> 0 then 3444 DebugLn('TGtk3WidgetSet.SetFocus: ',dbgsName(TGtk3Widget(HWND).LCLObject),' oldFocus ',dbgsName(TGtk3Widget(Result).LCLObject)) 3445 else 3446 DebugLn('TGtk3WidgetSet.SetFocus: ',dbgsName(TGtk3Widget(HWND).LCLObject),' oldFocus 0'); 3447 {$ENDIF} 3448 TGtk3Widget(HWND).setFocus; 3449 end; 3450end; 3451 3452function TGtk3WidgetSet.SetForegroundWindow(hWnd: HWND): boolean; 3453var 3454 AWindow: TGtk3Window; 3455begin 3456 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3457 // DebugLn('WARNING: TGtk3WidgetSet.SetForegroundWindow not implemented ...'); 3458 {$ENDIF} 3459 if not IsValidHandle(HWnd) then 3460 exit(False); 3461 Result := wtWindow in TGtk3Widget(HWND).WidgetType; 3462 if Result then 3463 begin 3464 AWindow := TGtk3Window(HWND); 3465 if not AWindow.Visible then 3466 exit(False); 3467 // DebugLn('TGtk3WidgetSet.SetForegroundWindow ',dbgsName(AWindow.LCLObject)); 3468 AWindow.Activate; 3469 Result := True; 3470 end; 3471end; 3472 3473function TGtk3WidgetSet.SetMapMode(DC: HDC; fnMapMode: Integer): Integer; 3474begin 3475 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3476 DebugLn('WARNING: TGtk3WidgetSet.SetMapMode not implemented ...'); 3477 {$ENDIF} 3478 Result:=inherited SetMapMode(DC, fnMapMode); 3479end; 3480 3481function TGtk3WidgetSet.SetParent(hWndChild: HWND; hWndParent: HWND): HWND; 3482begin 3483 Result := HWND(TGtk3Widget(hWndChild).getParent); 3484 TGtk3Widget(hWndChild).SetParent(TGtk3Widget(hWndParent),0,0) 3485end; 3486 3487function TGtk3WidgetSet.SetProp(Handle: hwnd; Str: PChar; Data: Pointer 3488 ): Boolean; 3489begin 3490 if Handle = 0 then 3491 exit(False); 3492 if Gtk3IsObject(TGtk3Widget(Handle).Widget) then 3493 g_object_set_data(TGtk3Widget(Handle).Widget, Str, Data); 3494 if TGtk3Widget(Handle).GetContainerWidget <> TGtk3Widget(Handle).Widget then 3495 begin 3496 if Gtk3IsObject(TGtk3Widget(Handle).GetContainerWidget) then 3497 g_object_set_data(TGtk3Widget(Handle).GetContainerWidget, Str, Data); 3498 end; 3499 Result := True; 3500end; 3501 3502function TGtk3WidgetSet.SetRectRgn(aRGN: HRGN; X1, Y1, X2, Y2: Integer 3503 ): Boolean; 3504begin 3505 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3506 DebugLn('WARNING: TGtk3WidgetSet.SetRectRgn not implemented ...'); 3507 {$ENDIF} 3508 Result:=inherited SetRectRgn(aRGN, X1, Y1, X2, Y2); 3509end; 3510 3511function TGtk3WidgetSet.SetROP2(DC: HDC; Mode: Integer): Integer; 3512begin 3513 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3514 DebugLn('WARNING: TGtk3WidgetSet.SetROP2 not implemented ...'); 3515 {$ENDIF} 3516 Result:=inherited SetROP2(DC, Mode); 3517end; 3518 3519function TGtk3WidgetSet.SetScrollInfo(Handle: HWND; SBStyle: Integer; 3520 ScrollInfo: TScrollInfo; bRedraw: Boolean): Integer; 3521 3522 (* 3523 3524 procedure SetRangeUpdatePolicy(Range: PGtkRange); 3525 var 3526 UpdPolicy: TGTKUpdateType; 3527 begin 3528 case ScrollInfo.nTrackPos of 3529 SB_POLICY_DISCONTINUOUS: UpdPolicy := GTK_UPDATE_DISCONTINUOUS; 3530 SB_POLICY_DELAYED: UpdPolicy := GTK_UPDATE_DELAYED; 3531 else 3532 UpdPolicy := GTK_UPDATE_CONTINUOUS; 3533 end; 3534 !!! update policy for gtkRange does not exist anymore in gtk3 3535 so we must mimic that by using events. !!! 3536 gtk_range_set_update_policy(Range, UpdPolicy); 3537 end; 3538 procedure SetScrolledWindowUpdatePolicy(ScrolledWindow:PGTKScrolledWindow); 3539 var 3540 Range: PGtkRange; 3541 begin 3542 case SBStyle of 3543 SB_VERT: Range := PGtkRange(ScrolledWindow^.vscrollbar); 3544 SB_HORZ: Range := PGtkRange(ScrolledWindow^.hscrollbar); 3545 else exit; 3546 end; 3547 SetRangeUpdatePolicy(Range); 3548 end; 3549 *) 3550 3551const 3552 POLICY: array[BOOLEAN] of TGTKPolicyType = (2, 0); // GTK_POLICY_NEVER, GTK_POLICY_ALWAYS); 3553 3554var 3555 Adjustment: PGtkAdjustment; 3556 AWidget: TGtk3Widget; 3557 ARange: PGtkRange; 3558 AScrollWin: PGtkScrolledWindow; 3559 IsScrollbarVis: Boolean; 3560begin 3561 Result := 0; 3562 if not IsValidHandle(Handle) then 3563 exit; 3564 3565 AWidget := TGtk3Widget(Handle); 3566 3567 Adjustment := nil; 3568 ARange := nil; 3569 AScrollWin := nil; 3570 3571 if wtScrollBar in AWidget.WidgetType then 3572 begin 3573 ARange := PGtkRange(AWidget.Widget); 3574 Adjustment := ARange^.adjustment; 3575 end else 3576 if wtScrollingWin in AWidget.WidgetType then 3577 begin 3578 AScrollWin := TGtk3ScrollableWin(Handle).GetScrolledWindow; 3579 if AScrollWin = nil then 3580 exit; 3581 if not Gtk3IsScrolledWindow(AScrollWin) then 3582 begin 3583 DebugLn('ERROR: TGtk3WidgetSet.SetScrollInfo: Wrong class extracted for scrollwin ',dbgsName(TGtk3Widget(Handle).LCLObject)); 3584 AScrollWin := nil; 3585 end; 3586 end; 3587 3588 case SBStyle of 3589 SB_Horz: 3590 begin 3591 if not Assigned(Adjustment) and Assigned(AScrollWin) then 3592 Adjustment := AScrollWin^.get_hadjustment; 3593 end; 3594 SB_Vert: 3595 begin 3596 if not Assigned(Adjustment) and Assigned(AScrollWin) then 3597 Adjustment := AScrollWin^.get_vadjustment; 3598 end; 3599 SB_CTL: 3600 begin 3601 DebugLn('TGtk3WidgetSet.SetScrollInfo SB_CTL error: not implemented ', 3602 dbgsName(AWidget.LCLObject)); 3603 end; 3604 SB_BOTH: 3605 begin 3606 DebugLn('TGtk3WidgetSet.SetScrollInfo SB_BOTH error: not implemented ', 3607 dbgsName(AWidget.LCLObject)); 3608 end; 3609 end; 3610 3611 if Adjustment = nil then 3612 begin 3613 DebugLn('TGtk3WidgetSet.SetScrollInfo error: cannot get PGtkAdjustment from ', 3614 dbgsName(AWidget.LCLObject)); 3615 exit; 3616 end; 3617 3618 if (ScrollInfo.fMask and SIF_RANGE) <> 0 then 3619 begin 3620 Adjustment^.lower := ScrollInfo.nMin; 3621 Adjustment^.upper := ScrollInfo.nMax; 3622 end; 3623 if (ScrollInfo.fMask and SIF_PAGE) <> 0 then 3624 begin 3625 // 0 <= nPage <= nMax-nMin+1 3626 Adjustment^.page_size := ScrollInfo.nPage; 3627 Adjustment^.page_size := Min(Max(Adjustment^.page_size,0), 3628 Adjustment^.upper-Adjustment^.lower+1); 3629 Adjustment^.page_increment := (Adjustment^.page_size/6)+1; 3630 end; 3631 if (ScrollInfo.fMask and SIF_POS) <> 0 then 3632 begin 3633 // nMin <= nPos <= nMax - Max(nPage-1,0) 3634 Adjustment^.value := ScrollInfo.nPos; 3635 Adjustment^.value := Max(Adjustment^.value,Adjustment^.lower); 3636 Adjustment^.value := Min(Adjustment^.value, 3637 Adjustment^.upper-Max(Adjustment^.page_size-1,0)); 3638 end; 3639 3640 // check if scrollbar should be hidden 3641 IsScrollbarVis := True; 3642 if ((ScrollInfo.fMask and (SIF_RANGE or SIF_PAGE)) <> 0) and 3643 ((SBStyle=SB_HORZ) or (SBStyle=SB_VERT)) then 3644 begin 3645 if (Adjustment^.lower >= (Adjustment^.upper-Max(adjustment^.page_size-1,0))) 3646 then begin 3647 if (ScrollInfo.fMask and SIF_DISABLENOSCROLL) = 0 then 3648 IsScrollbarVis := False 3649 else 3650 ;// scrollbar should look disabled (no thumbbar and grayed appearance) 3651 // maybe not possible in gtk 3652 end; 3653 end; 3654 if bRedraw then 3655 begin 3656 if (AScrollWin <> nil) then 3657 begin 3658 // DebugLn('Setting scrollstyle of ',dbgsName(AWidget.LCLObject)); 3659 if SBStyle = SB_HORZ then 3660 TGtk3ScrollableWin(AWidget).HScrollBarPolicy := POLICY[IsScrollbarVis] 3661 else 3662 if SBStyle = SB_VERT then 3663 TGtk3ScrollableWin(AWidget).VScrollBarPolicy := POLICY[IsScrollbarVis]; 3664 end else 3665 AWidget.Update(nil); 3666 3667 Adjustment^.changed; 3668 3669 end; 3670 Result := Round(Adjustment^.value); 3671end; 3672 3673function TGtk3WidgetSet.SetSysColors(cElements: Integer; const lpaElements; 3674 const lpaRgbValues): Boolean; 3675begin 3676 Result:=inherited SetSysColors(cElements, lpaElements, lpaRgbValues); 3677end; 3678 3679function TGtk3WidgetSet.SetTextCharacterExtra(DC: hdc; nCharExtra: Integer 3680 ): Integer; 3681begin 3682 Result:=inherited SetTextCharacterExtra(DC, nCharExtra); 3683end; 3684 3685function TGtk3WidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef; 3686begin 3687 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3688 // DebugLn('WARNING: TGtk3WidgetSet.SetTextColor not implemented ...'); 3689 {$ENDIF} 3690 Result := CLR_INVALID; 3691 if IsValidDC(DC) then 3692 begin 3693 Result := TGtk3DeviceContext(DC).CurrentTextColor; 3694 TGtk3DeviceContext(DC).CurrentTextColor := Color; 3695 end; 3696end; 3697 3698function TGtk3WidgetSet.SetViewPortExtEx(DC: HDC; XExtent, YExtent: Integer; 3699 OldSize: PSize): Boolean; 3700begin 3701 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3702 DebugLn('WARNING: TGtk3WidgetSet.SetViewPortExtEx not implemented ...'); 3703 {$ENDIF} 3704 Result:=inherited SetViewPortExtEx(DC, XExtent, YExtent, OldSize); 3705end; 3706 3707function TGtk3WidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; 3708 OldPoint: PPoint): Boolean; 3709begin 3710 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3711 DebugLn('WARNING: TGtk3WidgetSet.SetViewPortOrgEx not implemented ...'); 3712 {$ENDIF} 3713 Result:=inherited SetViewPortOrgEx(DC, NewX, NewY, OldPoint); 3714end; 3715 3716function TGtk3WidgetSet.SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; 3717 OldSize: PSize): Boolean; 3718begin 3719 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3720 DebugLn('WARNING: TGtk3WidgetSet.SetWindowExtEx not implemented ...'); 3721 {$ENDIF} 3722 Result:=inherited SetWindowExtEx(DC, XExtent, YExtent, OldSize); 3723end; 3724 3725function TGtk3WidgetSet.SetWindowLong(Handle: HWND; Idx: Integer; 3726 NewLong: PtrInt): PtrInt; 3727begin 3728 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3729 DebugLn('WARNING: TGtk3WidgetSet.SetWindowLong not implemented ...'); 3730 {$ENDIF} 3731 Result:=inherited SetWindowLong(Handle, Idx, NewLong); 3732end; 3733 3734function TGtk3WidgetSet.SetWindowOrgEx(dc: hdc; NewX, NewY: Integer; 3735 OldPoint: PPoint): Boolean; 3736var 3737 Matrix: cairo_matrix_t; 3738 //dx, dy: Double; 3739begin 3740 Result := False; // inherited SetWindowOrgEx(dc, NewX, NewY, OldPoint); 3741 if IsValidDC(DC) then 3742 begin 3743 GetWindowOrgEx(dc, OldPoint); 3744 cairo_get_matrix(TGtk3DeviceContext(DC).pcr, @Matrix); 3745 //dx := 0; 3746 //dy := 0; 3747 // cairo_matrix_init_translate(Matrix, -NewX, -NewY); 3748 cairo_matrix_translate(@Matrix, 3749 -NewX - TGtk3DeviceContext(DC).fncOrigin.x, 3750 -NewY - TGtk3DeviceContext(DC).fncOrigin.Y); 3751 cairo_transform(TGtk3DeviceContext(DC).pcr, @Matrix); 3752 // cairo_set_matrix(TGtk3DeviceContext(DC).Widget, Matrix); 3753 // DebugLn('TGtk3WidgetSet.SetWindowOrgEx NewX=',dbgs(NewX),' NewY=',dbgs(NewY)); 3754 Result := True; 3755 3756 end; 3757end; 3758 3759function TGtk3WidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, 3760 cx, cy: Integer; uFlags: UINT): Boolean; 3761begin 3762 Result := False; 3763 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3764 DebugLn('WARNING: TGtk3WidgetSet.SetWindowPos not implemented Handle=',dbgHex(hWnd),' X=',dbgs(X),' Y=',dbgs(Y)); 3765 {$ENDIF} 3766end; 3767 3768function TGtk3WidgetSet.SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: Boolean 3769 ): longint; 3770var 3771 PCR: Pcairo_region_t; 3772begin 3773 if hRgn = 0 then 3774 PCR := nil 3775 else 3776 PCR := TGtk3Region(hRgn).Handle; 3777 gtk_widget_shape_combine_region(TGtk3Widget(hWnd).Widget, PCR); 3778 if bRedraw then 3779 TGtk3Widget(hWnd).Widget^.realize; 3780 Result:=1; 3781end; 3782 3783function TGtk3WidgetSet.ShowCaret(hWnd: HWND): Boolean; 3784begin 3785 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3786 DebugLn('WARNING: TGtk3WidgetSet.ShowCaret not implemented ...'); 3787 {$ENDIF} 3788 Result:=inherited ShowCaret(hWnd); 3789end; 3790 3791function TGtk3WidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; 3792 bShow: Boolean): Boolean; 3793var 3794 AWidget: TGtk3Widget; 3795 // AScrolledWin: PGtkScrolledWindow; 3796 NewPolicy: TGtkPolicyType; 3797begin 3798 Result := IsValidHandle(Handle); 3799 if not Result then 3800 exit; 3801 AWidget := TGtk3Widget(Handle); 3802 if wtScrollBar in AWidget.WidgetType then 3803 begin 3804 AWidget.Visible := bShow; 3805 end else 3806 (* 3807 if wtWindow in AWidget.WidgetType then 3808 begin 3809 DebugLn('WARNING: TGtk3WidgetSet.ShowScrollBar cannot get scrollbar from ',dbgsName(AWidget.LCLObject), 3810 ' bShow ',dbgs(bShow)); 3811 end else 3812 *) 3813 if wtScrollingWin in AWidget.WidgetType then 3814 begin 3815 // AScrolledWin := 3816 if TGtk3ScrollableWin(Handle).GetScrolledWindow = nil then 3817 exit; 3818 if wBar in [SB_BOTH, SB_HORZ] then 3819 begin 3820 if bShow then 3821 NewPolicy := GTK_POLICY_ALWAYS 3822 else 3823 NewPolicy := GTK_POLICY_NEVER; 3824 3825 // bug in gtk3 3826 if (wtWindow in AWidget.WidgetType) and (NewPolicy = GTK_POLICY_NEVER) then 3827 NewPolicy := GTK_POLICY_AUTOMATIC; 3828 3829 TGtk3ScrollableWin(AWidget).HScrollBarPolicy := NewPolicy; 3830 end; 3831 if wBar in [SB_BOTH, SB_VERT] then 3832 begin 3833 if bShow then 3834 NewPolicy := GTK_POLICY_ALWAYS 3835 else 3836 NewPolicy := GTK_POLICY_NEVER; 3837 3838 // bug in gtk3 3839 if (wtWindow in AWidget.WidgetType) and (NewPolicy = GTK_POLICY_NEVER) then 3840 NewPolicy := GTK_POLICY_AUTOMATIC; 3841 3842 TGtk3ScrollableWin(AWidget).VScrollBarPolicy := NewPolicy; 3843 end; 3844 end else 3845 DebugLn('WARNING: TGtk3WidgetSet.ShowScrollBar cannot get scrollbar from ',dbgsName(AWidget.LCLObject)); 3846end; 3847 3848function TGtk3WidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; 3849begin 3850 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3851 DebugLn('WARNING: TGtk3WidgetSet.ShowWindow not implemented ...'); 3852 {$ENDIF} 3853 Result := IsValidHandle(Hwnd); 3854 if not result then exit; 3855 if TObject(hWnd) is TGtk3Window then 3856 Result:=TGtk3Window(hWnd).ShowState(nCmdShow) 3857 else 3858 begin 3859 TGtk3Widget(hWnd).Show; 3860 Result:=true; 3861 end; 3862end; 3863 3864function TGtk3WidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; 3865 SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; 3866begin 3867 Result := StretchMaskBlt(DestDC,X,Y,Width,Height, 3868 SrcDC,XSrc,YSrc,SrcWidth,SrcHeight, 3869 0,0,0, 3870 ROp); 3871end; 3872 3873function TGtk3WidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, 3874 Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; 3875 Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean; 3876 3877var 3878 DestContext: TGtk3DeviceContext absolute DestDC; 3879 SrcContext: TGtk3DeviceContext absolute SrcDC; 3880 ATargetRect, ASrcRect: TRect; 3881begin 3882 Result := False; 3883 {$IFDEF GTK3DEBUGNOTIMPLEMENTED} 3884 DebugLn('WARNING: TGtk3WidgetSet.StretchMaskBlt not implemented ...'); 3885 {$ENDIF} 3886 ATargetRect := Rect(X, Y, Width + X, Height + Y); 3887 ASrcRect := Rect(XSrc, YSrc, SrcWidth + XSrc, SrcHeight + YSrc); 3888 3889 if (DestContext.OwnsSurface) and (SrcContext.OwnsSurface) or (mask<>0) then 3890 DestContext.drawImage1(@ATargetRect, PgdkPixbuf(SrcContext.CurrentImage.Handle) , @ASrcRect, nil, nil) 3891 else 3892 DestContext.drawSurface(@ATargetRect,SrcContext.CairoSurface , @ASrcRect, nil, nil); 3893 3894 Result := True; 3895end; 3896 3897function TGtk3WidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord; 3898 pvParam: Pointer; fWinIni: DWord): LongBool; 3899var 3900 wa:TGdkRectangle; 3901 pdisp:PGdkDisplay; 3902 pmon:PgdkMonitor; 3903 pr:PRect; 3904begin 3905 Result:=True; 3906 Case uiAction of 3907 SPI_GETWHEELSCROLLLINES: PDword(pvParam)^ := 3; 3908 SPI_GETWORKAREA: begin 3909 pdisp:=TGdkDisplay.get_default; 3910 pmon:=pdisp^.get_primary_monitor(); 3911 pmon^.get_workarea(@wa); 3912 pr:=PRect(pvParam); 3913 pr^.Left:=wa.x; 3914 pr^.Top:=wa.y; 3915 pr^.Width:=wa.width; 3916 pr^.Height:=wa.height; 3917 end; 3918 else 3919 Result:=False; 3920 end; 3921end; 3922 3923function TGtk3WidgetSet.TextOut(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): Boolean; 3924begin 3925 {$IFDEF VerboseGtk3DeviceContext} 3926 DebugLn('TGtk3WidgetSet.TextOut X=',dbgs(x),' Y=',dbgs(y),' Text=',dbgs(Str),' Count=',dbgs(Count)); 3927 {$ENDIF} 3928 Result := False; 3929 if Count <= 0 then 3930 Exit; 3931 if IsValidDC(DC) then 3932 begin 3933 Result := True; 3934 TGtk3DeviceContext(DC).drawText(X, Y, Str, Count); 3935 end; 3936end; 3937 3938function TGtk3WidgetSet.UpdateWindow(Handle: HWND): Boolean; 3939begin 3940 {$ifdef VerboseGtk3WinAPI} 3941 DebugLn('[Gtk3WinAPI UpdateWindow]'); 3942 {$endif} 3943 Result := False; 3944 if IsValidHandle(Handle) then 3945 begin 3946 TGtk3Widget(Handle).Update(nil); 3947 if TGtk3Widget(Handle).GetContainerWidget^.get_has_window then 3948 begin 3949 if Gtk3IsGdkWindow(TGtk3Widget(Handle).GetContainerWidget^.window) then 3950 TGtk3Widget(Handle).GetContainerWidget^.window^.process_updates(True); 3951 end else 3952 if TGtk3Widget(Handle).Widget^.get_has_window then 3953 begin 3954 if Gtk3IsGdkWindow(TGtk3Widget(Handle).Widget^.window) then 3955 TGtk3Widget(Handle).Widget^.window^.process_updates(True); 3956 end; 3957 Result := True; 3958 end; 3959end; 3960 3961function TGtk3WidgetSet.WindowFromPoint(APoint: TPoint): HWND; 3962var 3963 ev: TGdkEvent; 3964 ADeviceManager: PGdkDeviceManager; 3965 APointer: PGdkDevice; 3966 AWindow: PGdkWindow; 3967 AWidget: PGtkWidget; 3968 x: gint; 3969 y: gint; 3970begin 3971 //TODO: create caching mechanism. window_at_position is pretty expensive call. 3972 Result := 0; 3973 ADeviceManager := gdk_display_get_device_manager(gdk_display_get_default); 3974 APointer := gdk_device_manager_get_client_pointer(ADeviceManager); 3975 APointer^.get_position(nil, @x ,@y); 3976 AWindow := gdk_device_get_window_at_position(APointer, @APoint.X, @APoint.Y); 3977 if AWindow <> nil then 3978 begin 3979 FillChar(ev{%H-}, SizeOf(ev), 0); 3980 ev.any.window := AWindow; 3981 AWidget := gtk_get_event_widget(@ev); 3982 Result := HwndFromGtkWidget(AWidget); 3983 (* 3984 if Result <> 0 then 3985 begin 3986 DebugLn('TGtk3WidgetSet.WindowFromPoint ',dbgsName(TGtk3Widget(Result).LCLObject)); 3987 end else 3988 DebugLn('Cannot find window under point ',dbgs(APoint)); 3989 *) 3990 end; 3991end; 3992