1{%MainUnit gtk2def.pp} 2 3{****************************************************************************** 4 TGtk2DeviceContext 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14 15{$IFOPT C-} 16// Uncomment for local trace 17// {$C+} 18// {$DEFINE ASSERT_IS_ON} 19{$ENDIF} 20 21{ TDeviceContext } 22 23procedure TGtkDeviceContext.SetClipRegion(const AValue: PGdiObject); 24begin 25 ChangeGDIObject(fClipRegion, AValue); 26end; 27 28function TGtkDeviceContext.GetGDIObjects(ID: TGDIType): PGdiObject; 29begin 30 case ID of 31 gdiBitmap: Result:=CurrentBitmap; 32 gdiFont: Result:=CurrentFont; 33 gdiBrush: Result:=CurrentBrush; 34 gdiPen: Result:=CurrentPen; 35 gdiPalette: Result:=CurrentPalette; 36 gdiRegion: Result:=ClipRegion; 37 end; 38end; 39 40function TGtkDeviceContext.GetClipRectangle: TGdkRectangle; 41var 42 X,Y: gint; 43begin 44 if FClipRegion = nil then 45 begin 46 if (PaintRectangle.Left<>0) or (PaintRectangle.Top<>0) or 47 (PaintRectangle.Right<>0) or (PaintRectangle.Bottom<>0) then 48 Result := GdkRectFromRect(PaintRectangle) 49 else 50 begin 51 gdk_window_get_size(Drawable, @X, @Y); 52 Result := GdkRectFromRect(Rect(0,0, X, Y)); 53 end; 54 end else 55 gdk_region_get_clipbox(FClipRegion^.GDIRegionObject, @Result); 56end; 57 58function TGtkDeviceContext.GetOffset: TPoint; 59var 60 Fixed: Pointer; 61 AChild: PGtkWidget; 62 AColumn: PGtkTreeViewColumn; 63 Area: TGdkRectangle; 64 h: gint; 65 w: gint; 66 yoffs: gint; 67 xoffs: gint; 68begin 69 Result := Point(0, 0); 70 if Assigned(FWidget) then 71 begin 72 Fixed := GetFixedWidget(FWidget); 73 if GTK_WIDGET_NO_WINDOW(FWidget) and 74 GTK_WIDGET_NO_WINDOW(Fixed) and 75 not GtkWidgetIsA(FWidget, GTKAPIWidget_GetType) then 76 begin 77 Inc(Result.X, FWidget^.Allocation.x); 78 Inc(Result.y, FWidget^.Allocation.y); 79 end; 80 if (GTK_IS_SCROLLED_WINDOW(FWidget) and GTK_IS_BIN(FWidget)) or (GTK_IS_TREE_VIEW(FWidget)) then 81 begin 82 if GTK_IS_TREE_VIEW(FWidget) then 83 AChild := FWidget 84 else 85 AChild := gtk_bin_get_child(PGtkBin(FWidget)); 86 if GTK_IS_TREE_VIEW(AChild) and gtk_tree_view_get_headers_visible(PGtkTreeView(AChild)) then 87 begin 88 AColumn := gtk_tree_view_get_column(PGtkTreeView(AChild), 0); 89 gtk_tree_view_column_cell_get_size(AColumn, @Area, @xoffs, @yoffs, @w, @h); 90 // borders are 2px 91 dec(Result.y, h - 2); 92 end; 93 end; 94 end; 95end; 96 97function TGtkDeviceContext.GetOwnedGDIObjects(ID: TGDIType): PGdiObject; 98begin 99 Result:=fOwnedGDIObjects[ID]; 100end; 101 102procedure TGtkDeviceContext.SetCurrentBitmap(const AValue: PGdiObject); 103begin 104 ChangeGDIObject(FCurrentBitmap,AValue); 105end; 106 107procedure TGtkDeviceContext.SetCurrentBrush(const AValue: PGdiObject); 108begin 109 ChangeGDIObject(FCurrentBrush,AValue); 110 if FSelectedColors = dcscBrush then 111 FSelectedColors := dcscCustom; 112end; 113 114procedure TGtkDeviceContext.SetCurrentFont(const AValue: PGdiObject); 115begin 116 ChangeGDIObject(FCurrentFont,AValue); 117 if FHasTransf then 118 TransfUpdateFont; 119end; 120 121procedure TGtkDeviceContext.SetCurrentPalette(const AValue: PGdiObject); 122begin 123 ChangeGDIObject(FCurrentPalette,AValue); 124end; 125 126procedure TGtkDeviceContext.SetCurrentPen(const AValue: PGdiObject); 127begin 128 ChangeGDIObject(FCurrentPen,AValue); 129 if FSelectedColors = dcscPen then 130 FSelectedColors := dcscCustom; 131 if FHasTransf then 132 TransfUpdatePen; 133end; 134 135procedure TGtkDeviceContext.ChangeGDIObject(var GDIObject: PGdiObject; 136 const NewValue: PGdiObject); 137begin 138 if GdiObject = NewValue then exit; 139 if GdiObject <> nil then 140 begin 141 dec(GdiObject^.DCCount); 142 if GdiObject^.DCCount < 0 then 143 RaiseGDBException(''); 144 ReleaseGDIObject(GDIObject); 145 end; 146 147 GdiObject := NewValue; 148 149 if GdiObject <> nil then 150 begin 151 inc(GdiObject^.DCCount); 152 ReferenceGDIObject(GDIObject); 153 end; 154end; 155 156procedure TGtkDeviceContext.SetGDIObjects(ID: TGDIType; const AValue: PGdiObject); 157begin 158 case ID of 159 gdiBitmap: ChangeGDIObject(fCurrentBitmap,AValue); 160 gdiFont: ChangeGDIObject(fCurrentFont,AValue); 161 gdiBrush: ChangeGDIObject(fCurrentBrush,AValue); 162 gdiPen: ChangeGDIObject(fCurrentPen,AValue); 163 gdiPalette: ChangeGDIObject(fCurrentPalette,AValue); 164 gdiRegion: ChangeGDIObject(fClipRegion,AValue); 165 end; 166end; 167 168procedure TGtkDeviceContext.SetMapMode(AValue: Integer); 169begin 170 if AValue <> FMapMode then 171 begin 172 case AValue of 173 MM_ANISOTROPIC:; // user's choice 174 MM_ISOTROPIC:; // adjusted after each SetViewPortExtEx call (see MSDN for details) 175 MM_HIENGLISH: FWindowExt := Point(1000, -1000); 176 MM_HIMETRIC: FWindowExt := Point(2540, -2540); 177 MM_LOENGLISH: FWindowExt := Point(100, -100); 178 MM_LOMETRIC: FWindowExt := Point(254, -254); 179 MM_TWIPS: FWindowExt := Point(1440, -1440); 180 else 181 AValue := MM_TEXT; 182 FWindowExt := Point(1, 1); 183 FViewPortExt := Point(1, 1); 184 end; 185 FMapMode := AValue; 186 // to do: combine with affine transformations here when they get implemented 187 FHasTransf := 188 (FMapMode <> MM_TEXT) or 189 (FViewPortOrg.x <> 0) or 190 (FViewPortOrg.y <> 0) or 191 (FWindowOrg.x <> 0) or 192 (FWindowOrg.y <> 0); 193 if not (FMapMode in [MM_TEXT, MM_ANISOTROPIC, MM_ISOTROPIC]) then 194 begin 195 FViewPortExt.X := Gtk2WidgetSet.GetDeviceCaps(HDC(Self), LOGPIXELSX); 196 FViewPortExt.Y := Gtk2WidgetSet.GetDeviceCaps(HDC(Self), LOGPIXELSY); 197 end; 198 TransfUpdateFont; 199 TransfUpdatePen; 200 end; 201end; 202 203procedure TGtkDeviceContext.SetOwnedGDIObjects(ID: TGDIType; 204 const AValue: PGdiObject); 205begin 206//MWE: this is not right. all objects except bitmaps can be selected in more than one DC 207 208 if fOwnedGDIObjects[ID]=AValue then exit; 209 if fOwnedGDIObjects[ID]<>nil then 210 fOwnedGDIObjects[ID]^.Owner:=nil; 211 fOwnedGDIObjects[ID]:=AValue; 212 if fOwnedGDIObjects[ID]<>nil then 213 fOwnedGDIObjects[ID]^.Owner:=Self; 214end; 215 216procedure TGtkDeviceContext.SetROP2(AROP: Integer); 217var 218 Func: TGdkFunction; 219begin 220 case AROP of 221 R2_COPYPEN: Func := GDK_COPY; 222 R2_NOT: Func := GDK_INVERT; 223 R2_XORPEN: Func := GDK_XOR; 224 R2_BLACK: Func := GDK_CLEAR; 225 R2_MASKPEN: Func := GDK_AND; 226 R2_MASKPENNOT: Func := GDK_AND_REVERSE; 227 R2_MASKNOTPEN: Func := GDK_AND_INVERT; 228 R2_NOP: Func := GDK_NOOP; 229 R2_MERGEPEN: Func := GDK_OR; 230 R2_NOTXORPEN: Func := GDK_EQUIV; 231 R2_MERGEPENNOT: Func := GDK_OR_REVERSE; 232 R2_NOTCOPYPEN: Func := GDK_COPY_INVERT; 233 R2_NOTMASKPEN: Func := GDK_NAND; 234 //R2_NOTMERGEPEN: Func := GDK_NOR; 235 R2_WHITE: Func := GDK_SET; 236 else 237 Func := GDK_COPY; 238 end; 239 240 gdk_gc_set_function(GC, Func); 241 gdk_gc_get_values(GC, @FGCValues); 242end; 243 244procedure TGtkDeviceContext.SetViewPortExt(const AValue: TPoint); 245var 246 Ratio: Single; 247begin 248 if (AValue.x <> FViewPortExt.x) or (AValue.y <> FViewPortExt.y) and 249 (FMapMode in [MM_ISOTROPIC, MM_ANISOTROPIC]) then 250 begin 251 if FMapMode = MM_ISOTROPIC then 252 begin 253 // TK: Is here also an adjustment on Windows if DPIX and DPIY are different? 254 Ratio := FWindowExt.x / FWindowExt.y; // no check, programmer cannot put nonsense 255 if AValue.y * Ratio > AValue.x then 256 FViewPortExt := Point(AValue.x, RoundToInt(AValue.x / Ratio)) 257 else if AValue.y * Ratio < AValue.x then 258 FViewPortExt := Point(RoundToInt(AValue.y * Ratio), AValue.y) 259 else 260 FViewPortExt := AValue; 261 end else 262 FViewPortExt := AValue; 263 TransfUpdateFont; 264 TransfUpdatePen; 265 end; 266end; 267 268procedure TGtkDeviceContext.SetViewPortOrg(const AValue: TPoint); 269begin 270 if (FViewPortOrg.x <> AValue.x) or 271 (FViewPortOrg.y <> AValue.y) then 272 begin 273 FViewPortOrg := AValue; 274 FHasTransf := True; 275 end; 276end; 277 278procedure TGtkDeviceContext.SetWindowExt(const AValue: TPoint); 279begin 280 if (AValue.x <> FWindowExt.x) or (AValue.y <> FWindowExt.y) and 281 (FMapMode in [MM_ISOTROPIC, MM_ANISOTROPIC]) then 282 begin 283 FWindowExt := AValue; 284 if FMapMode = MM_ANISOTROPIC then 285 begin 286 TransfUpdateFont; 287 TransfUpdatePen; 288 end; 289 end; 290end; 291 292procedure TGtkDeviceContext.SetWindowOrg(AValue: TPoint); 293begin 294 if (FWindowOrg.x <> AValue.x) or 295 (FWindowOrg.y <> AValue.y) then 296 begin 297 FWindowOrg := AValue; 298 FHasTransf := True; 299 end; 300end; 301 302procedure TGtkDeviceContext.SetSelectedColors(AValue: TDevContextSelectedColorsType); 303begin 304 if FSelectedColors = AValue then Exit; 305 FSelectedColors := AValue; 306 307 case FSelectedColors of 308 dcscPen: SelectPenProps; 309 dcscBrush: SelectBrushProps; 310 dcscFont: SelectTextProps; 311 end; 312end; 313 314procedure TGtkDeviceContext.SetTextMetricsValid(AValid: Boolean); 315begin 316 if AValid then 317 Include(FFlags, dcfTextMetricsValid) 318 else 319 Exclude(FFlags, dcfTextMetricsValid); 320end; 321 322procedure TGtkDeviceContext.RemovePixbuf; 323begin 324 if Assigned(FPixbuf) then 325 begin 326 gdk_pixbuf_unref(FPixbuf); 327 FPixbuf := nil; 328 end; 329end; 330 331procedure TGtkDeviceContext.InvTransfPoint(var X1, Y1: Integer); 332begin 333 X1 := MulDiv(X1 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x); 334 Y1 := MulDiv(Y1 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y); 335 // to do: put affine inverse transformation here (for all Inv.. methods) 336end; 337 338function TGtkDeviceContext.InvTransfPointIndirect(const P: TPoint): TPoint; 339begin 340 Result.X := MulDiv(P.X + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x); 341 Result.Y := MulDiv(P.Y + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y); 342end; 343 344procedure TGtkDeviceContext.InvTransfRect(var X1, Y1, X2, Y2: Integer); 345begin 346 X1 := MulDiv(X1 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x); 347 Y1 := MulDiv(Y1 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y); 348 X2 := MulDiv(X2 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x); 349 Y2 := MulDiv(Y2 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y); 350end; 351 352function TGtkDeviceContext.InvTransfRectIndirect(const R: TRect): TRect; 353begin 354 Result.Left := MulDiv(R.Left + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x); 355 Result.Top := MulDiv(R.Top + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y); 356 Result.Right := MulDiv(R.Right + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x); 357 Result.Bottom := MulDiv(R.Bottom + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y); 358end; 359 360procedure TGtkDeviceContext.InvTransfExtent(var ExtX, ExtY: Integer); 361begin 362 ExtX := MulDiv(ExtX, FWindowExt.x, FViewPortExt.x); 363 ExtY := MulDiv(ExtY, FWindowExt.y, FViewPortExt.y); 364end; 365 366function TGtkDeviceContext.InvTransfExtentIndirect(const Extent: TPoint): TPoint; 367begin 368 Result.X := MulDiv(Extent.X, FWindowExt.x, FViewPortExt.x); 369 Result.Y := MulDiv(Extent.Y, FWindowExt.y, FViewPortExt.y); 370end; 371 372procedure TGtkDeviceContext.TransfAngles(var Angle1, Angle2: Integer); 373begin 374 if FWindowExt.x * FViewPortExt.x < 0 then 375 begin 376 // flip angles along 90-270 degree axis 377 Angle1 := 2880 - Angle1; 378 Angle2 := 2880 - Angle2; 379 end; 380 if FWindowExt.y * FViewPortExt.y < 0 then 381 begin 382 // flip angles along 0-180 degree axis 383 Angle1 := 5760 - Angle1; 384 Angle2 := 5760 - Angle2; 385 end; 386end; 387 388procedure TGtkDeviceContext.TransfNormalize(var Lower, Higher: Integer); 389var 390 Tmp: Integer; 391begin 392 if Lower > Higher then 393 begin 394 Tmp := Lower; 395 Lower := Higher; 396 Higher := Tmp; 397 end; 398end; 399 400procedure TGtkDeviceContext.TransfPoint(var X1, Y1: Integer); 401begin 402 // to do: put affine transformation here (for all Transf.. methods) 403 X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x; 404 Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y; 405end; 406 407function TGtkDeviceContext.TransfPointIndirect(const P: TPoint): TPoint; 408begin 409 Result.x := MulDiv(P.x, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x; 410 Result.Y := MulDiv(P.y, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y; 411end; 412 413procedure TGtkDeviceContext.TransfRect(var X1, Y1, X2, Y2: Integer); 414begin 415 X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x; 416 Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y; 417 X2 := MulDiv(X2, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x; 418 Y2 := MulDiv(Y2, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y; 419end; 420 421function TGtkDeviceContext.TransfRectIndirect(const R: TRect): TRect; 422begin 423 Result.Left := MulDiv(R.Left, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x; 424 Result.Top := MulDiv(R.Top, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y; 425 Result.Right := MulDiv(R.Right, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x; 426 Result.Bottom := MulDiv(R.Bottom, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y; 427end; 428 429procedure TGtkDeviceContext.TransfExtent(var ExtX, ExtY: Integer); 430begin 431 ExtX := MulDiv(ExtX, FViewPortExt.x, FWindowExt.x); 432 ExtY := MulDiv(ExtY, FViewPortExt.y, FWindowExt.y); 433end; 434 435function TGtkDeviceContext.TransfExtentIndirect(const Extent: TPoint): TPoint; 436begin 437 Result.X := MulDiv(Extent.X, FViewPortExt.x, FWindowExt.x); 438 Result.Y := MulDiv(Extent.Y, FViewPortExt.y, FWindowExt.y); 439end; 440 441procedure TGtkDeviceContext.TransfUpdateFont; 442var 443 AWidth, AHeight: Integer; 444 TmpObj: PGdiObject; 445begin 446 if (FCurrentFont <> nil) and (FCurrentFont^.GDIFontObject <> nil) and (FCurrentFont^.LogFont.lfFaceName[0] <> #0) then 447 begin 448 if FCurrentFont^.UntransfFontHeight = 0 then 449 FCurrentFont^.UntransfFontHeight := FCurrentFont^.LogFont.lfHeight; 450 AWidth := 0; AHeight := FCurrentFont^.UntransfFontHeight; 451 TransfExtent(AWidth, AHeight); 452 if FCurrentFont^.UntransfFontHeight > 0 then 453 AHeight := Abs(AHeight) 454 else 455 AHeight := -Abs(AHeight); 456 if AHeight = 0 then 457 if FCurrentFont^.LogFont.lfHeight > 0 then 458 AHeight := 1 459 else 460 if FCurrentFont^.LogFont.lfHeight < 0 then 461 AHeight := -1 462 else 463 AHeight := 0; 464 if FCurrentFont^.LogFont.lfHeight <> AHeight then 465 begin 466 FontCache.Unreference(FCurrentFont^.GDIFontObject); 467 FCurrentFont^.LogFont.lfHeight := AHeight; 468 TmpObj := {%H-}PGdiObject(PtrUInt(GTK2WidgetSet.CreateFontIndirect(FCurrentFont^.LogFont))); 469 FCurrentFont^.GDIFontObject := TmpObj^.GDIFontObject; 470 TmpObj^.GDIFontObject := nil; 471 TmpObj^.RefCount := 0; 472 GTK2WidgetSet.DisposeGDIObject(TmpObj); 473 end; 474 end; 475end; 476 477procedure TGtkDeviceContext.TransfUpdatePen; 478var 479 AWidth, AHeight: Integer; 480begin 481 if FCurrentPen <> nil then 482 begin 483 if FCurrentPen^.UnTransfPenWidth = 0 then 484 FCurrentPen^.UnTransfPenWidth := FCurrentPen^.GDIPenWidth; 485 AWidth := FCurrentPen^.UnTransfPenWidth; 486 AHeight := FCurrentPen^.UnTransfPenWidth; 487 TransfExtent(AWidth, AHeight); 488 AWidth := Abs(AWidth); 489 AHeight := Abs(AHeight); 490 if AWidth > AHeight then AWidth := AHeight; 491 if AWidth <= 0 then AWidth := 1; 492 if FCurrentPen^.GDIPenWidth <> DWord(AWidth) then 493 begin 494 FCurrentPen^.GDIPenWidth := AWidth; 495 Exclude(FFlags, dcfPenSelected); 496 SelectPenProps; 497 end; 498 end; 499end; 500 501procedure TGtkDeviceContext.SetWidget(AWidget: PGtkWidget; AWindow: PGdkWindow; 502 AWithChildWindows: Boolean; ADoubleBuffer: PGdkDrawable); 503 504 procedure RaiseWidgetWithoutClientArea; 505 begin 506 RaiseGDBException('TGtkDeviceContext.SetWidget: widget ' + DbgS(AWidget) + ' has no client area'); 507 end; 508 509 procedure RaiseWidgetAlreadySet; 510 begin 511 RaiseGDBException('TGtkDeviceContext.SetWidget: widget already set'); 512 end; 513 514 procedure RaiseUnableToRealize; 515 begin 516 RaiseGDBException('TGtkDeviceContext.SetWidget: Unable to realize GdkWindow'); 517 end; 518 519var 520 ClientWidget: PGtkWidget; 521 W, TopLvlW: PGtkWidget; 522begin 523 if FWidget <> nil then 524 RaiseWidgetAlreadySet; 525 526 FWithChildWindows := AWithChildWindows; 527 FWidget := AWidget; 528 FPixbuf := nil; 529 530 if (AWidget = nil) then 531 begin 532 // screen: ToDo: multiple desktops 533 FDrawable := gdk_screen_get_root_window(gdk_screen_get_default); 534 end else 535 begin 536 if ADoubleBuffer <> nil then 537 begin 538 Include(FFlags, dcfDoubleBuffer); 539 FOriginalDrawable := AWindow; 540 FDrawable := ADoubleBuffer; 541 end else 542 begin 543 // create a new devicecontext for this window 544 Exclude(FFlags, dcfDoubleBuffer); 545 546 if AWindow = nil then 547 begin 548 ClientWidget := GetFixedWidget(AWidget); 549 if ClientWidget = nil then RaiseWidgetWithoutClientArea; 550 551 AWindow := GetControlWindow(ClientWidget); 552 if AWindow = nil then 553 begin 554 W := gtk_widget_get_parent(AWidget); 555 TopLvlW := gtk_widget_get_toplevel(AWidget); 556 if (W <> nil) and GTK_IS_WINDOW(TopLvlW) then 557 begin 558 //debugln(['TGtkDeviceContext.SetWidget gtk-class=',GetWidgetClassName(W),' lcl-obj=',DbgSName(GetLCLObject(W))]); 559 //we are forcing window creation but not for GtkNotebook 560 //see issue #18754 and #20126 561 //Zeljko:This part should be NOT BE REMOVED since TToolbar, TFrame 562 //TGroupBox etc...depend on this. eg.TToolbar will lock 563 //mouse without realizing clientWidget.Also if THintWindow is 564 //visible it crashes sometimes. SO JUST NOTEBOOK ! 565 if not GTK_IS_NOTEBOOK(W) then 566 gtk_widget_realize(ClientWidget); 567 end; 568 569 AWindow := GetControlWindow(ClientWidget); 570 // Don't raise an exception. Not all operations needs drawable. For example font metrics: 571 // http://bugs.freepascal.org/view.php?id=14035 572 //if AWindow = nil then RaiseUnableToRealize; 573 end; 574 end else 575 begin 576 ClientWidget := AWidget; 577 end; 578 579 FDrawable := AWindow; 580 // GC is created on demand 581 if (FDrawable = nil) and not GTK_WIDGET_MAPPED(AWidget) then 582 FDrawable := gdk_screen_get_root_window(gdk_screen_get_default); 583 end; 584 end; 585 586 gdk_color_black(gdk_colormap_get_system, @CurrentTextColor.Color); 587 BuildColorRefFromGDKColor(CurrentTextColor); 588 gdk_color_white(gdk_colormap_get_system, @CurrentBackColor.Color); 589 BuildColorRefFromGDKColor(CurrentBackColor); 590 // font, brush, pen are created on demand 591end; 592 593procedure TGtkDeviceContext.Clear; 594var 595 g: TGDIType; 596 597 procedure WarnOwnedGDIObject; 598 begin 599 DebugLn(['TDeviceContext.Clear ',dbghex(PtrInt(Self)),' OwnedGDIObjects[',ord(g),']<>nil']); 600 end; 601 602begin 603 if Assigned(FPixbuf) then gdk_pixbuf_unref(FPixbuf); 604 FWidget := nil; 605 FDrawable := nil; 606 FPixbuf := nil; 607 FGC := nil; 608 FillChar(FGCValues, SizeOf(FGCValues), 0); 609 610 FViewPortExt := Point(1, 1); 611 FViewPortOrg := Point(0, 0); 612 FWindowExt := Point(1, 1); 613 FWindowOrg := Point(0, 0); 614 FMapMode := MM_TEXT; 615 if FHasTransf then 616 begin 617 FHasTransf := False; 618 TransfUpdateFont; 619 TransfUpdatePen; 620 end; 621 622 PenPos := Point(0, 0); 623 624 CurrentBitmap:=nil; 625 CurrentFont:=nil; 626 CurrentPen:=nil; 627 CurrentBrush:=nil; 628 CurrentPalette:=nil; 629 ClipRegion:=nil; 630 FillChar(CurrentTextColor,SizeOf(CurrentTextColor),0); 631 FillChar(CurrentBackColor,SizeOf(CurrentBackColor),0); 632 FillChar(PaintRectangle, SizeOf(PaintRectangle), 0); 633 634 SelectedColors:=dcscCustom; 635 SavedContext:=nil; 636 FFlags := []; 637 638 for g:=Low(TGDIType) to high(TGDIType) do 639 if OwnedGDIObjects[g]<>nil then 640 WarnOwnedGDIObject; 641end; 642 643{------------------------------------------------------------------------------ 644 Function: CopyData - used by RestoreDC and SaveDC 645 Params: DestinationDC: a dc to copy data to 646 ClearSource: set true to make a move operation 647 MoveGDIOwnerShip: set true to pass the ownership of the GDI objects 648 to Destination 649 Returns: True if succesful 650 651 Creates a copy DC from the given DC 652 ------------------------------------------------------------------------------} 653function TGtkDeviceContext.CopyDataFrom(ASource: TGtkDeviceContext; AClearSource, AMoveGDIOwnerShip, ARestore: Boolean): Boolean; 654 procedure RaiseRestoreDifferentWidget; 655 begin 656 RaiseGDBException('TGtkDeviceContext.CopyDataFrom: restore widget differs'); 657 end; 658 659 procedure RaiseWidgetAlreadySet; 660 begin 661 RaiseGDBException('TGtkDeviceContext.CopyDataFrom: widget already set'); 662 end; 663 664var 665 g: TGDIType; 666 CurGDIObject: PGDIObject; 667begin 668 Result := Assigned(Self) and Assigned(ASource); 669 if not Result then Exit; 670 671 if ARestore then 672 begin 673 if FWidget <> ASource.FWidget then 674 RaiseRestoreDifferentWidget; 675 end else 676 begin 677 if Assigned(FWidget) then 678 RaiseWidgetAlreadySet; 679 FWidget := ASource.FWidget; 680 end; 681 682 FWithChildWindows := ASource.FWithChildWindows; 683 FDrawable := ASource.FDrawable; 684 FPixbuf := ASource.Pixbuf; 685 FOriginalDrawable := ASource.FOriginalDrawable; 686 687 if Assigned(FGC) then 688 begin 689 // free old GC 690 gdk_gc_unref(FGC); 691 FGC := nil; 692 Exclude(FFlags, dcfPenSelected); 693 end; 694 695 if Assigned(ASource.FGC) and Assigned(FDrawable) then 696 begin 697 gdk_gc_get_values(ASource.FGC, @FGCValues); 698 FGC := gdk_gc_new_with_values(FDrawable, @FGCValues, 699 GDK_GC_FOREGROUND or GDK_GC_BACKGROUND or GDK_GC_SUBWINDOW); 700 Exclude(FFlags, dcfPenSelected); 701 end; 702 703 if dcfTextMetricsValid in ASource.Flags then 704 begin 705 Include(FFlags, dcfTextMetricsValid); 706 DCTextMetric := ASource.DCTextMetric; 707 end 708 else 709 Exclude(FFlags, dcfTextMetricsValid); 710 711 for g := Low(TGDIType) to High(TGDIType) do 712 begin 713 GDIObjects[g] := ASource.GDIObjects[g]; 714 if AClearSource then 715 ASource.GDIObjects[g] := nil; 716 717 if AMoveGDIOwnerShip then 718 begin 719 if Assigned(OwnedGDIObjects[g]) then 720 DeleteObject(HGDIOBJ({%H-}PtrUInt(OwnedGDIObjects[g]))); 721 722 CurGDIObject := ASource.OwnedGDIObjects[g]; 723 724 if Assigned(CurGDIObject) then 725 begin 726 ASource.OwnedGDIObjects[g] := nil; 727 OwnedGDIObjects[g] := CurGDIObject; 728 end; 729 end; 730 end; 731 CopyGDIColor(ASource.CurrentTextColor, CurrentTextColor); 732 CopyGDIColor(ASource.CurrentBackColor, CurrentBackColor); 733 734 SelectedColors := dcscCustom; 735 PenPos := ASource.PenPos; 736 737 if FHasTransf then 738 begin 739 FHasTransf := False; 740 FMapMode := MM_TEXT; 741 FViewPortExt := Point(1, 1); 742 FViewPortOrg := Point(0, 0); 743 FWindowExt := Point(1, 1); 744 FWindowOrg := Point(0, 0); 745 TransfUpdateFont; 746 TransfUpdatePen; 747 end; 748 749 FHasTransf := ASource.HasTransf; 750 if FHasTransf then 751 begin 752 FMapMode := ASource.MapMode; 753 FViewPortExt := ASource.ViewPortExt; 754 FViewPortOrg := ASource.ViewPortOrg; 755 FWindowExt := ASource.WindowExt; 756 FWindowOrg := ASource.WindowOrg; 757 TransfUpdateFont; 758 TransfUpdatePen; 759 end; 760 761 SavedContext := nil; 762end; 763 764function TGtkDeviceContext.FillRect(ARect: TRect; ABrush: HBrush; SkipRop: Boolean): Boolean; 765var 766 Width, Height: Integer; 767 OldCurrentBrush: PGdiObject; 768 DCOrigin: TPoint; 769 BrushChanged: Boolean; 770 ClipArea: TGdkRectangle; 771begin 772 BrushChanged := False; 773 if not IsNullBrush then 774 begin 775 if FHasTransf then 776 begin 777 ARect := TransfRectIndirect(ARect); 778 TransfNormalize(ARect.Left, ARect.Right); 779 TransfNormalize(ARect.Top, ARect.Bottom); 780 end; 781 782 Width := ARect.Right - ARect.Left; 783 Height := ARect.Bottom - ARect.Top; 784 785 // Temporary hold the old brush to replace it with the given brush 786 OldCurrentBrush := GetBrush; 787 if not CompareGDIBrushes({%H-}PGdiObject(ABrush), OldCurrentBrush) then 788 begin 789 BrushChanged := True; 790 CurrentBrush := {%H-}PGdiObject(ABrush); 791 SelectedColors := dcscCustom; 792 end; 793 794 SelectBrushProps; 795 if SkipRop then 796 gdk_gc_set_function(GC, GDK_COPY); 797 798 DCOrigin := Offset; 799 ClipArea := ClipRect; 800 RemovePixbuf; 801 if (CurrentBrush^.GDIBrushFill = GDK_SOLID) and 802 (IsBackgroundColor(TColor(CurrentBrush^.GDIBrushColor.ColorRef))) then 803 StyleFillRectangle(Drawable, GC, 804 CurrentBrush^.GDIBrushColor.ColorRef, 805 ARect.Left + DCOrigin.X, ARect.Top + DCOrigin.Y, 806 Width, Height, @ClipArea) 807 else 808 gdk_draw_rectangle(Drawable, GC, 1, 809 ARect.Left + DCOrigin.X, ARect.Top + DCOrigin.Y, 810 Width, Height); 811 812 if SkipRop then 813 gdk_gc_set_function(GC, GetFunction); 814 815 // Restore current brush 816 if BrushChanged then 817 begin 818 SelectedColors := dcscCustom; 819 CurrentBrush := OldCurrentBrush; 820 end; 821 end; 822 823 Result := True; 824end; 825 826procedure TGtkDeviceContext.CreateBrush; 827begin 828 if FCurrentBrush <> nil then Exit; 829 CurrentBrush := Gtk2Widgetset.CreateDefaultBrush; 830 OwnedGDIObjects[gdiBrush] := FCurrentBrush; 831end; 832 833procedure TGtkDeviceContext.CreateFont; 834var 835 NewFont: PGDIObject; 836 ClientWidget: PGtkWidget; 837begin 838 if FCurrentFont <> nil then exit; 839 840 // create font 841 if FWidget <> nil then 842 begin 843 ClientWidget := GetFixedWidget(FWidget); 844 845 NewFont := Gtk2Widgetset.NewGDIObject(gdiFont); 846 NewFont^.UntransfFontHeight := 0; 847 CurrentFont := NewFont; 848 FCurrentFont^.GDIFontObject := gtk_widget_create_pango_layout(ClientWidget, nil); 849 850 {$ifdef fontconsistencychecks} 851 if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) <> nil then 852 RaiseGDBException('inconsistency: font already in cache, maybe freed, but not removed from cache'); 853 {$endif} 854 855 FontCache.AddWithoutName(FCurrentFont^.GDIFontObject); 856 857 // the gtk internal reference count was increased by 858 // gtk_widget_create_pango_layout and by FontCache.AddWithoutName 859 // reduce it to one, because only this DC is using them at this point 860 UnreferenceGtkIntfFont(FCurrentFont^.GDIFontObject); 861 862 {$ifdef fontconsistencychecks} 863 // MWE: are we paranoid or so ? (if you can't trust the cache, don't use it or stop coding) 864 // MG: some people are coding without knowing about the cache 865 if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) = nil then 866 RaiseGDBException('inconsistency: font added to cache, but can not be found'); 867 {$endif} 868 end 869 else 870 CurrentFont := Gtk2Widgetset.CreateDefaultFont; 871 OwnedGDIObjects[gdiFont] := FCurrentFont; 872end; 873 874function TGtkDeviceContext.CreateGC: PGdkGC; 875begin 876 // create GC 877 878 if (Drawable <> nil) and (Drawable^.parent_instance.ref_count>0) then 879 begin 880 if FWithChildWindows then 881 begin 882 FillChar(FGCValues, SizeOf(FGCValues), 0); 883 FGCValues.subwindow_mode := GDK_INCLUDE_INFERIORS; 884 Result := gdk_gc_new_with_values(Drawable, @FGCValues, GDK_GC_FUNCTION or GDK_GC_SUBWINDOW); 885 end else 886 begin 887 Result := gdk_gc_new(Drawable); 888 end; 889 end else 890 begin 891 // create default GC 892 Result := gdk_gc_new(gdk_screen_get_root_window(gdk_screen_get_default)); 893 end; 894 if Result = nil then Exit; 895 896 gdk_gc_set_function(Result, GDK_COPY); 897 gdk_gc_get_values(Result, @FGCValues); 898end; 899 900procedure TGtkDeviceContext.CreateBitmap; 901begin 902 if FCurrentBitmap <> nil then Exit; 903 CurrentBitmap := GTK2Widgetset.CreateDefaultGDIBitmap; 904 OwnedGDIObjects[gdiBitmap] := FCurrentBitmap; 905end; 906 907procedure TGtkDeviceContext.CreateGDIObject(AGDIType: TGDIType); 908begin 909 case AGDIType of 910 gdiFont: CreateFont; 911 gdiBrush: CreateBrush; 912 gdiPen: CreatePen; 913 gdiBitmap: CreateBitmap; 914 else 915 RaiseGDBException('TGtkDeviceContext.CreateGDIObject'); 916 end; 917end; 918 919procedure TGtkDeviceContext.CreatePen; 920begin 921 if FCurrentPen <> nil then exit; 922 CurrentPen := Gtk2WidgetSet.CreateDefaultPen; 923 OwnedGDIObjects[gdiPen] := FCurrentPen; 924end; 925 926 927function TGtkDeviceContext.GetGC: pgdkGC; 928begin 929 if FGC = nil then 930 FGC := CreateGC; 931 Result := FGC; 932end; 933 934function TGtkDeviceContext.GetFont: PGdiObject; 935begin 936 if FCurrentFont = nil then 937 CreateFont; 938 939 Result := FCurrentFont; 940end; 941 942function TGtkDeviceContext.GetBrush: PGdiObject; 943begin 944 if FCurrentBrush = nil then 945 CreateBrush; 946 947 Result := FCurrentBrush; 948end; 949 950function TGtkDeviceContext.GetPen: PGdiObject; 951begin 952 if FCurrentPen = nil then 953 CreatePen; 954 955 Result := FCurrentPen; 956end; 957 958function TGtkDeviceContext.GetROP2: Integer; 959begin 960 case GetFunction of 961 GDK_COPY: result := R2_COPYPEN; 962 GDK_INVERT: result := R2_NOT; 963 GDK_XOR: result := R2_XORPEN; 964 GDK_CLEAR: result := R2_BLACK; 965 GDK_AND: result := R2_MASKPEN; 966 GDK_AND_REVERSE: result := R2_MASKPENNOT; 967 GDK_AND_INVERT: result := R2_MASKNOTPEN; 968 GDK_NOOP: result := R2_NOP; 969 GDK_OR: result := R2_MERGEPEN; 970 GDK_EQUIV: result := R2_NOTXORPEN; 971 GDK_OR_REVERSE: result := R2_MERGEPENNOT; 972 GDK_COPY_INVERT: result := R2_NOTCOPYPEN; 973 GDK_NAND: result := R2_NOTMASKPEN; 974 //GDK_NOR: result := R2_NOTMERGEPEN; 975 GDK_SET: result := R2_WHITE; 976 else 977 result := R2_COPYPEN; 978 end; 979end; 980 981function TGtkDeviceContext.HasGC: Boolean; 982begin 983 Result := FGC <> nil; 984end; 985 986function TGtkDeviceContext.IsNullBrush: boolean; 987begin 988 Result := (FCurrentBrush <> nil) and (FCurrentBrush^.IsNullBrush); 989end; 990 991 992function TGtkDeviceContext.IsNullPen: boolean; 993begin 994 Result := (FCurrentPen <> nil) and (FCurrentPen^.IsNullPen); 995end; 996 997procedure TGtkDeviceContext.ResetGCClipping; 998begin 999 if FGC = nil then Exit; 1000 1001 {$IFDEF DebugGDK}BeginGDKErrorTrap;{$endif} 1002 gdk_gc_set_clip_mask(FGC, nil); 1003 gdk_gc_set_clip_origin (FGC, 0,0); 1004 {$IFDEF DebugGDK}EndGDKErrorTrap;{$endif} 1005 1006 SelectRegion; 1007end; 1008 1009function TGtkDeviceContext.SelectBitmap(AGdiObject: PGdiObject): PGdiObject; 1010var 1011 NewPixbuf: PGdkPixbuf; 1012 NewDrawable: PGdkPixmap; 1013 Mask: PGdkBitmap; 1014begin 1015 // always create, because a valid GDIObject is needed to restore 1016 Result := GetBitmap; 1017 if CurrentBitmap = AGDIObject then Exit; 1018 1019 NewPixbuf := nil; 1020 CurrentBitmap := AGDIObject; 1021 with FCurrentBitmap^ do 1022 case GDIBitmapType of 1023 gbPixmap: NewDrawable := GDIPixmapObject.Image; 1024 gbBitmap: NewDrawable := GDIBitmapObject; 1025 gbPixbuf: 1026 begin 1027 NewDrawable := nil; 1028 Mask := nil; 1029 NewPixbuf := GDIPixbufObject; 1030 gdk_pixbuf_render_pixmap_and_mask(GDIPixbufObject, NewDrawable, Mask, $80); 1031 GDIBitmapType := gbPixmap; 1032 GDIPixmapObject.Image := NewDrawable; 1033 GDIPixmapObject.Mask := Mask; 1034 if Visual <> nil then 1035 gdk_visual_unref(Visual); 1036 Visual := gdk_window_get_visual(NewDrawable); 1037 gdk_visual_ref(Visual); 1038 end; 1039 else 1040 DebugLn('[TGtkDeviceContext.SelectBitmap] - Unknown bitmaptype, DC=0x%p', [Pointer(Self)]); 1041 Exit; 1042 end; 1043 1044 // no drawable: this is normal, when restoring the default bitmap (FreeDC) 1045 if NewDrawable = nil then Exit; 1046 1047 if FGC <> nil then 1048 gdk_gc_unref(FGC); 1049 FDrawable := NewDrawable; 1050 FPixbuf := NewPixbuf; 1051 FGC := gdk_gc_new(FDrawable); 1052 gdk_gc_set_function(FGC, GDK_COPY); 1053 SelectedColors := dcscCustom; 1054end; 1055 1056{------------------------------------------------------------------------------ 1057 Procedure: TGtkDeviceContext.SelectBrushProps 1058 Params: 1059 Returns: Nothing 1060 1061 Sets the forecolor and fill according to the brush 1062 ------------------------------------------------------------------------------} 1063procedure TGtkDeviceContext.SelectBrushProps; 1064begin 1065 if IsNullBrush then Exit; 1066 1067 // Force brush 1068 GetBrush; 1069 1070 EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor 1071 EnsureGCColor(HDC(Self), dccGDIBrushColor, CurrentBrush^.GDIBrushFill = GDK_Solid, False);//Brush Color 1072 1073 if CurrentBrush^.GDIBrushFill = GDK_Solid then Exit; 1074 if CurrentBrush^.GDIBrushPixmap = nil then Exit; 1075 1076 if CurrentBrush^.GDIBrushFill = GDK_STIPPLED then 1077 begin 1078 //invert background / foreground colors to match Windows.FillRect behavior 1079 //with a 1bit bitmap pattern brush (bit set -> back color, bit unset -> text color) 1080 EnsureGCColor(HDC(Self), dccCurrentTextColor, False, True); 1081 EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True); 1082 gdk_gc_set_stipple(GC, CurrentBrush^.GDIBrushPixmap); 1083 //use GDK_OPAQUE_STIPPLED to draw both background and foreground color 1084 gdk_gc_set_fill(GC, GDK_OPAQUE_STIPPLED); 1085 end 1086 else 1087 begin 1088 gdk_gc_set_tile(GC, CurrentBrush^.GDIBrushPixmap); 1089 gdk_gc_set_fill(GC, GDK_TILED); 1090 end; 1091 1092 gdk_gc_get_values(GC, @FGCValues); 1093end; 1094 1095function TGtkDeviceContext.SelectObject(AGdiObject: PGdiObject): PGdiObject; 1096begin 1097 case AGdiObject^.GDIType of 1098 gdiBitmap: Result := SelectBitmap(AGdiObject); 1099 gdiPen: Result := SelectPen(AGdiObject); 1100 else 1101 // we only handle bitmaps here atm 1102 Result := {%H-}PGdiObject(GTK2WidgetSet.SelectObject(HDC(Self), {%H-}HGDIOBJ(AGdiObject))); 1103 end; 1104end; 1105 1106function TGtkDeviceContext.SelectPen(AGdiObject: PGdiObject): PGdiObject; 1107begin 1108 Result := GetPen;// always create, because a valid GDIObject is needed to restore 1109 if CurrentPen = AGDIObject then Exit; 1110 1111 CurrentPen := AGDIObject; 1112 Exclude(FFlags, dcfPenSelected); 1113 if FGC <> nil then 1114 SelectPenProps; 1115 SelectedColors := dcscCustom; 1116end; 1117 1118constructor TGtkDeviceContext.Create; 1119begin 1120 Clear; 1121 BkMode := OPAQUE; 1122end; 1123 1124destructor TGtkDeviceContext.Destroy; 1125begin 1126 if Assigned(FPixbuf) then gdk_pixbuf_unref(FPixbuf); 1127 inherited Destroy; 1128end; 1129 1130{------------------------------------------------------------------------------ 1131 Procedure: TGtkDeviceContext.SelectPenProps 1132 Params: DC: a (LCL)devicecontext 1133 Returns: Nothing 1134 1135 Sets the forecolor and fill according to the pen 1136 ------------------------------------------------------------------------------} 1137procedure TGtkDeviceContext.SelectPenProps; 1138var 1139 PenStyle: DWord; 1140 LineStyle: TGdkLineStyle; 1141 JoinStyle: TGdkJoinStyle; 1142 CapStyle: TGdkCapStyle; 1143 IsGeometric, IsExtPen: Boolean; 1144 PenWidth: gint; 1145 1146 procedure SetDashes(ADashes: array of gint8); 1147 var 1148 Multiplier: gint; 1149 i: integer; 1150 begin 1151 Multiplier := PenWidth; 1152 if Multiplier = 0 then 1153 Multiplier := 1; 1154 1155 // this works very well for geometric pens 1156 for i := Low(ADashes) to High(ADashes) do 1157 ADashes[i] := ADashes[i] * Multiplier; 1158 1159 laz_gdk_gc_set_dashes(GC, 4096, @ADashes[0], Length(ADashes)) 1160 end; 1161 1162begin 1163// if IsNullPen then Exit; 1164 1165 EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True); // BKColor 1166 EnsureGCColor(HDC(Self), dccGDIPenColor, False, False); // Pen Color 1167 1168 if dcfPenSelected in FFlags then Exit; 1169 Exclude(FFlags, dcfPenInvalid); 1170 if GC = nil then Exit; 1171 1172 // force pen 1173 GetPen; 1174 1175 PenStyle := CurrentPen^.GDIPenStyle and PS_STYLE_MASK; 1176 IsExtPen := CurrentPen^.IsExtPen; 1177 PenWidth := CurrentPen^.GDIPenWidth; 1178 1179 if IsExtPen then 1180 IsGeometric := (CurrentPen^.GDIPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC 1181 else 1182 IsGeometric := PenWidth > 1; 1183 1184 if not IsGeometric then 1185 PenWidth := 0; 1186 1187 CurrentPen^.IsNullPen := PenStyle = PS_NULL; 1188 1189 if IsExtPen and IsGeometric then 1190 begin 1191 case CurrentPen^.GDIPenStyle and PS_JOIN_MASK of 1192 PS_JOIN_ROUND: JoinStyle := GDK_JOIN_ROUND; 1193 PS_JOIN_BEVEL: JoinStyle := GDK_JOIN_BEVEL; 1194 PS_JOIN_MITER: JoinStyle := GDK_JOIN_MITER; 1195 end; 1196 1197 case CurrentPen^.GDIPenStyle and PS_ENDCAP_MASK of 1198 PS_ENDCAP_ROUND: CapStyle := GDK_CAP_ROUND; 1199 PS_ENDCAP_SQUARE: CapStyle := GDK_CAP_PROJECTING; 1200 PS_ENDCAP_FLAT: CapStyle := GDK_CAP_NOT_LAST; 1201 end; 1202 end 1203 else 1204 begin 1205 JoinStyle := GDK_JOIN_ROUND; 1206 if IsGeometric then 1207 CapStyle := GDK_CAP_ROUND 1208 else 1209 CapStyle := GDK_CAP_NOT_LAST; 1210 end; 1211 1212 if (PenStyle = PS_USERSTYLE) and (not IsExtPen or (CurrentPen^.GDIPenDashesCount = 0)) then 1213 PenStyle := PS_SOLID; 1214 1215 if (PenStyle = PS_SOLID) or (PenStyle = PS_INSIDEFRAME) then 1216 LineStyle := GDK_LINE_SOLID 1217 else 1218 LineStyle := GDK_LINE_ON_OFF_DASH; 1219 1220 {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF} 1221 gdk_gc_set_line_attributes(GC, PenWidth, LineStyle, CapStyle, JoinStyle); 1222 {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF} 1223 1224 // Paul Ishenin: I compared patterns with windows 1225 case PenStyle of 1226 PS_DASH: SetDashes([4,2]); 1227 PS_DOT: SetDashes([1,2]); 1228 PS_DASHDOT: SetDashes([4,2,1,2]); 1229 PS_DASHDOTDOT: SetDashes([4,2,1,2,1,2]); 1230 PS_USERSTYLE: laz_gdk_gc_set_dashes(GC, 0, CurrentPen^.GDIPenDashes, CurrentPen^.GDIPenDashesCount); 1231 end; 1232 {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF} 1233 gdk_gc_get_values(GC, @FGCValues); 1234 Include(FFlags, dcfPenSelected); 1235end; 1236 1237{------------------------------------------------------------------------------ 1238 procedure SelectRegion 1239 1240 Applies the current clipping region of the DC (DeviceContext) to the 1241 gc (GDK Graphic context - pgdkGC) 1242 ------------------------------------------------------------------------------} 1243procedure TGtkDeviceContext.SelectRegion; 1244var 1245 RGNType : Longint; 1246begin 1247 {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF} 1248 1249 // force GC 1250 GetGC; 1251 1252 // Clear 1253 gdk_gc_set_clip_region(FGC, nil); 1254 gdk_gc_set_clip_rectangle(FGC, nil); 1255 1256 if ClipRegion <> nil then 1257 begin 1258 RGNType := RegionType(ClipRegion^.GDIRegionObject); 1259 if RGNType <> ERROR then 1260 gdk_gc_set_clip_region(FGC, ClipRegion^.GDIRegionObject); 1261 end; 1262 1263 {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF} 1264end; 1265 1266{------------------------------------------------------------------------------ 1267 Procedure: TGtkDeviceContext.SelectTextProps 1268 Params: 1269 Returns: Nothing 1270 1271 Sets the forecolor and fill according to the Textcolor 1272 ------------------------------------------------------------------------------} 1273procedure TGtkDeviceContext.SelectTextProps; 1274begin 1275 EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor 1276 EnsureGCColor(HDC(Self), dccCurrentTextColor, False, False);//Font Color 1277end; 1278 1279function TGtkDeviceContext.GetBitmap: PGdiObject; 1280begin 1281 if FCurrentBitmap = nil then 1282 CreateBitmap; 1283 1284 Result := FCurrentBitmap; 1285end; 1286 1287function TGtkDeviceContext.GetFunction: TGdkFunction; 1288begin 1289 Result := GCValues._function; 1290end; 1291 1292 1293procedure SetLayoutText(ALayout: PPangoLayout; AText: PChar; ALength: PtrInt); 1294var 1295 OldStr: PChar; 1296begin 1297 OldStr := pango_layout_get_text(ALayout); 1298 if (strlen(OldStr)<>ALength) or (strlcomp(AText, OldStr, ALength) <> 0) then 1299 pango_layout_set_text(ALayout, AText, ALength); 1300end; 1301 1302procedure TGtkDeviceContext.DrawTextWithColors(AText: PChar; ALength: LongInt; 1303 X, Y: Integer; FGColor, BGColor: PGdkColor); 1304var 1305 WidgetCont: PPangoContext; 1306 NewMatrix: TPangoMatrix; 1307 OldMatrix: PPangoMatrix; 1308 renderer: PGdkPangoRenderer; 1309 Direction : TPangoDirection; 1310 AFont: PGdiObject; 1311 1312 procedure SetColors(AFGColor, ABGColor: PGdkColor); inline; 1313 begin 1314 gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_FOREGROUND, AFGColor); 1315 gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_UNDERLINE, AFGColor); 1316 gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_STRIKETHROUGH, AFGColor); 1317 gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_BACKGROUND, ABGColor); 1318 end; 1319 1320begin 1321 AFont := GetFont; 1322 SetLayoutText(AFont^.GDIFontObject, AText, ALength); 1323 1324 WidgetCont := pango_layout_get_context(AFont^.GDIFontObject); 1325 Direction := pango_find_base_dir(AText, ALength); 1326 pango_context_set_base_dir(WidgetCont, Direction); 1327 1328 if AFont^.LogFont.lfEscapement <> 0 then 1329 begin 1330 if Widget <> nil then 1331 renderer := gdk_pango_renderer_get_default(gtk_widget_get_screen(Widget)) 1332 else 1333 renderer := gdk_pango_renderer_get_default(gdk_screen_get_default); 1334 RemovePixbuf; 1335 gdk_pango_renderer_set_drawable(renderer, drawable); 1336 gdk_pango_renderer_set_gc(renderer, GC); 1337 SetColors(FGColor, BGColor); 1338 1339 OldMatrix := pango_context_get_matrix(WidgetCont); 1340 NewMatrix.xx := 1.0; 1341 NewMatrix.xy := 0.0; 1342 NewMatrix.yx := 0.0; 1343 NewMatrix.yy := 1.0; 1344 NewMatrix.x0 := 0.0; 1345 NewMatrix.y0 := 0.0; 1346 pango_matrix_translate(@NewMatrix, X, Y); 1347 pango_matrix_rotate(@NewMatrix, AFont^.LogFont.lfEscapement / 10); 1348 1349 pango_context_set_matrix(WidgetCont, @NewMatrix); 1350 pango_layout_context_changed(AFont^.GDIFontObject); 1351 pango_renderer_draw_layout(PPangoRenderer(renderer), AFont^.GDIFontObject, X, Y); 1352 1353 //now reset 1354 pango_context_set_matrix(WidgetCont, OldMatrix); 1355 pango_layout_context_changed(AFont^.GDIFontObject); 1356 1357 SetColors(nil, nil); 1358 gdk_pango_renderer_set_drawable(renderer, nil); 1359 gdk_pango_renderer_set_gc(renderer, nil); 1360 end 1361 else 1362 gdk_draw_layout_with_colors(drawable, GC, X, Y, AFont^.GDIFontObject, FGColor, BGColor); 1363end; 1364 1365