paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-05 00:13:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Started with object based GDI

Browse Source 
* More splitup of gtk1/gtk2 code
* Fixed restore of GC after linedrawing
* Enabled desktop grabbing for gtk1

git-svn-id: trunk@12975 -
This commit is contained in:
marc 2007-11-23 00:07:45 +00:00
parent f63d9a94cb
commit 28578c3a91
22 changed files with 2509 additions and 2236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -2875,6 +2875,8 @@ lcl/interfaces/fpgui/fpguiwsstdctrls.pp svneol=native#text/pascal
lcl/interfaces/fpgui/fpguiwstoolwin.pp svneol=native#text/pascal
lcl/interfaces/fpgui/interfaces.pp svneol=native#text/pascal
lcl/interfaces/gtk/dragicons.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1def.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtk1devicecontext.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1extra.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1extrah.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1int.pp svneol=native#text/pascal
@ -2888,6 +2890,7 @@ lcl/interfaces/gtk/gtkcomboboxcallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkdebug.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkdef.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkdefines.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkdevicecontext.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkdragcallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkextra.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkfiledialogutils.inc svneol=native#text/plain
@ -2949,6 +2952,8 @@ lcl/interfaces/gtk/tests/lclclipboardunit.pas svneol=native#text/plain
lcl/interfaces/gtk/tnotebook_close_tab.xpm -text svneol=native#image/x-xpixmap
lcl/interfaces/gtk2/README.txt svneol=native#text/plain
lcl/interfaces/gtk2/gtk2cellrenderer.pas svneol=native#text/plain
lcl/interfaces/gtk2/gtk2def.pp svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2devicecontext.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2extra.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2extrah.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2int.pas svneol=native#text/pascal

55
lcl/interfaces/gtk/gtk1def.pp Normal file
View File

@ -0,0 +1,55 @@
{ $Id$
-------------------------------
gtk1def.pp - Type definitions
-------------------------------
@created(Tue Nov 20st WET 2007)
@lastmod($Date$)
@author(Marc Weustink <marc@@dommelstein.net>)
This unit contains type definitions needed in the GTK1 <-> LCL interface
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
unit Gtk1Def;
{$mode objfpc} {$H+}
interface
uses
glib, gdk, gtk, gdkpixbuf,
// Classes, SysUtils, LCLIntf, LCLProc, LCLType, DynHashArray,
// GraphType, GtkExtra,
GtkDef;
type
{ TGtk1DeviceContext }
TGtk1DeviceContext = class(TGtkDeviceContext)
private
protected
function GetFunction: TGdkFunction; override;
public
end;
implementation
{$i gtk1devicecontext.inc}
end.

35
lcl/interfaces/gtk/gtk1devicecontext.inc Normal file
View File

@ -0,0 +1,35 @@
{%MainUnit gtk1def.pp}
{******************************************************************************
TGtk1DeviceContext
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
{ TGtk1DeviceContext }
function TGtk1DeviceContext.GetFunction: TGdkFunction;
begin
Result := GCValues.thefunction;
end;

3
lcl/interfaces/gtk/gtk1int.pp
View File

@ -62,7 +62,7 @@ uses
// widgetset
GtkInt,
GtkDebug,
GtkFontCache, gtkDef, GtkProc, gtkMsgQueue, GtkExtra, gtkWSPrivate, WSLCLClasses;
GtkFontCache, GtkDef, Gtk1Def, GtkProc, gtkMsgQueue, GtkExtra, gtkWSPrivate, WSLCLClasses;
type
@ -77,6 +77,7 @@ type
protected
function CreateComponentWidget(Sender: TObject; ACompStyle: Integer;
const ACaption: String): PGtkWidget; override; // temporary solution till all are created through createhandle
function GetDeviceContextClass: TGtkDeviceContextClass; override;
public
procedure SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont); override;
end;

5
lcl/interfaces/gtk/gtk1widgetset.inc
View File

@ -179,6 +179,11 @@ begin
DebugLn(['TGtkWidgetSet.CreateComponent ',DbgSName(Sender),' ',GetWidgetDebugReport(p)]);
end;
function TGTK1WidgetSet.GetDeviceContextClass: TGtkDeviceContextClass;
begin
Result := TGtk1DeviceContext;
end;
{------------------------------------------------------------------------------
procedure SetWidgetFont
AWidget : PGtkWidget; const AFont: TFont

467
lcl/interfaces/gtk/gtkdef.pp
View File

@ -24,7 +24,7 @@
}
unit GTKDef;
unit GtkDef;
{$mode objfpc}
{$LONGSTRINGS ON}
@ -38,7 +38,7 @@ uses
glib, gdk, gtk, gdkpixbuf,
{$ENDIF}
Classes, SysUtils, LCLIntf, LCLProc, LCLType, LCLMemManager, DynHashArray,
GraphType;
GraphType, GtkExtra;
{$ifdef TraceGdiCalls}
const
@ -49,6 +49,68 @@ type
PCallBacksArray = ^TCallBacksArray;
{$endif}
// styles -------------------------------------------------------------------
type
TLazGtkStyle = (
lgsGTK_Default, // without anything
lgsDefault, // with rc file
lgsButton,
lgsLabel,
lgsWindow,
lgsCheckbox,
lgsRadiobutton,
lgsMenu,
lgsMenuBar,
lgsMenuitem,
lgsList,
lgsVerticalScrollbar,
lgsHorizontalScrollbar,
lgsTooltip,
lgsVerticalPaned,
lgsHorizontalPaned,
lgsNotebook,
lgsStatusBar,
lgsHScale,
lgsVScale,
lgsGroupBox,
lgsTreeView, // for gtk2
lgsToolBar, // toolbar
lgsToolButton, // button placed on toolbar
// user defined
lgsUserDefined
);
const
LazGtkStyleNames: array[TLazGtkStyle] of string = (
'gtk_default',
'default',
'button',
'label',
'window',
'checkbox',
'radiobutton',
'menu',
'menubar',
'menuitem',
'list',
'vertical scrollbar',
'horizontal scrollbar',
'tooltip',
'vertical paned',
'horizontal paned',
'statusbar',
'notebook',
'hscale',
'vscale',
'groupbox',
'treeview',
'toolbar',
'toolbutton',
''
);
const
// drag target type for on drop files event invoking
FileDragTarget: TGtkTargetEntry = (target: 'text/uri-list'; flags: 0; info: 0;);
@ -57,7 +119,7 @@ type
TGDIType = (gdiBitmap, gdiBrush, gdiFont, gdiPen, gdiRegion, gdiPalette);
TGDIBitmapType = (gbBitmap, gbPixmap{obsolete:, gbImage});
TDeviceContext = class;
TGtkDeviceContext = class;
{$IFDEF Gtk1}
TGtkIntfFont = PGDKFont;
@ -72,15 +134,6 @@ type
Blue: Byte;
end;
{obsolete:
PGDI_RGBImage = ^TGDI_RGBImage;
TGDI_RGBImage = record
Height,
Width: Integer;
Depth: Byte;
Data: array[0..0] of TGDIRGB;
end;}
TGDIColorFlag = (cfColorAllocated);
TGDIColorFlags = set of TGDIColorFlag;
@ -99,7 +152,7 @@ type
TGDIObject = record
RefCount: integer;
DCCount: integer; // number of DeviceContexts using this GDIObject
Owner: TDeviceContext;
Owner: TGtkDeviceContext;
{$ifdef TraceGdiCalls}
StackAddrs: TCallBacksArray;
{$endif}
@ -115,7 +168,6 @@ type
gbPixmap: (GDIPixmapObject: record // normal pixmap
Image: PGdkPixmap; // imagedata
Mask: PGdkBitmap; // the mask for images with 1 bit alpha and pixmap not supporting alpha
{$note check the need for mask} //MWE: at theismoment I cant oversee is we will set it from the LCL
end);
);
gdiBrush: (
@ -198,10 +250,14 @@ type
dcscFont
);
{ TDeviceContext }
TDeviceContext = class
{ TGtkDeviceContext }
TGtkDeviceContextClass = class of TGtkDeviceContext;
TGtkDeviceContext = class
private
FClipRegion: PGdiObject;
FCurrentBitmap: PGdiObject;
FCurrentBrush: PGdiObject;
@ -209,9 +265,30 @@ type
FCurrentPalette: PGdiObject;
FCurrentPen: PGdiObject;
FGC: pgdkGC;
FGCValues: TGdkGCValues;
FDrawable: PGDKDrawable; // either the gdk_window of the owner
// or the gdk_bitmap/pixmap of the selected image
// or the double buffer (OriginalDrawable will hold the original)
FOriginalDrawable: PGDKDrawable; // only set if dcfDoubleBuffer in DCFlags
FWidget: PGtkWidget; // the owner (in case of a windowDC)
FWithChildWindows: boolean;// this DC covers sub gdkwindows
FOrigin: TPoint;
FSpecialOrigin: Boolean;
FFlags: TDeviceContextsFlags;
FSelectedColors: TDevContextSelectedColorsType;
FOwnedGDIObjects: array[TGDIType] of PGdiObject;
fOwnedGDIObjects: array[TGDIType] of PGdiObject;
function GetGDIObjects(ID: TGDIType): PGdiObject;
function GetOffset: TPoint;
function GetOwnedGDIObjects(ID: TGDIType): PGdiObject;
procedure SetClipRegion(const AValue: PGdiObject);
procedure SetCurrentBitmap(const AValue: PGdiObject);
@ -223,25 +300,55 @@ type
const NewValue: PGdiObject);
procedure SetGDIObjects(ID: TGDIType; const AValue: PGdiObject);
procedure SetOwnedGDIObjects(ID: TGDIType; const AValue: PGdiObject);
procedure SetSelectedColors(AValue: TDevContextSelectedColorsType);
function GetGC: pgdkGC;
public
WithChildWindows: boolean;// this DC covers sub gdkwindows
// device handles
DCWidget: PGtkWidget; // the owner
Drawable: PGDKDrawable;
OriginalDrawable: PGDKDrawable; // only set if dcfDoubleBuffer in DCFlags
GCValues: TGdkGCValues;
private
// winapi
function GetROP2: Integer;
procedure SetROP2(AROP: Integer);
protected
function CreateGC: PGdkGC; virtual;
procedure CreateFont; virtual;
procedure CreateBrush; virtual;
procedure CreatePen; virtual;
procedure CreateBitmap; virtual;
function GetFunction: TGdkFunction; virtual; abstract;
property GCValues: TGdkGCValues read FGCValues;
protected
// winapi
function SelectBitmap(AGdiObject: PGdiObject): PGdiObject; virtual;
function SelectPen(AGdiObject: PGdiObject): PGdiObject; virtual;
public
procedure CreateGDIObject(AGDIType: TGDIType);
procedure SelectBrushProps; virtual;
procedure SelectTextProps; virtual;
procedure SelectPenProps; virtual;
procedure SelectRegion;
public
// device handles
procedure SetWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
AWithChildWindows: Boolean; ADoubleBuffer: PGdkDrawable = nil);
property Drawable: PGDKDrawable read FDrawable;
property Widget: PGtkWidget read FWidget; // the owner
property GC: pgdkGC read GetGC write FGC;
function HasGC: Boolean;
procedure ResetGCClipping;
// origins
Origin: TPoint;
SpecialOrigin: boolean;
property Origin: TPoint read FOrigin write FOrigin;
PenPos: TPoint;
property Offset: TPoint read GetOffset;
{$ifdef TraceGdiCalls}
StackAddrs: TCallBacksArray;
{$endif}
@ -259,9 +366,10 @@ type
DCTextMetric: TDevContextTextMetric; // only valid if dcfTextMetricsValid set
// control
SelectedColors: TDevContextSelectedColorsType;
SavedContext: TDeviceContext; // linked list of saved DCs
DCFlags: TDeviceContextsFlags;
property SelectedColors: TDevContextSelectedColorsType read FSelectedColors write SetSelectedColors;
SavedContext: TGtkDeviceContext; // linked list of saved DCs
property Flags: TDeviceContextsFlags read FFlags;
procedure SetTextMetricsValid(AValid: Boolean); // temp helper, to allow flag manipulation
property OwnedGDIObjects[ID: TGDIType]: PGdiObject read GetOwnedGDIObjects write SetOwnedGDIObjects;
procedure Clear;
@ -273,7 +381,31 @@ type
function IsNullBrush: boolean;
function IsNullPen: boolean;
function CopyDataFrom(ASource: TGtkDeviceContext; AClearSource, AMoveGDIOwnerShip, ARestore: Boolean): Boolean;
public
// winapi
function SelectObject(AGdiObject: PGdiObject): PGdiObject;
property ROP2: Integer read GetRop2 write SetRop2;
end;
// memory system for TDeviceContext(s) ---------------------------------------------
{ TDeviceContextMemManager }
TDeviceContextMemManager = class(TLCLMemManager)
private
FDeviceContextClass: TGtkDeviceContextClass;
protected
procedure FreeFirstItem; override;
public
constructor Create(AClass: TGtkDeviceContextClass);
procedure DisposeDeviceContext(ADeviceContext: TGtkDeviceContext);
function NewDeviceContext: TGtkDeviceContext;
end;
TWidgetInfoFlag = (
@ -441,15 +573,6 @@ const
function InternalNewPGDIObject: PGDIObject;
procedure InternalDisposePGDIObject(GDIObject: PGdiObject);
function NewDeviceContext: TDeviceContext;
procedure DisposeDeviceContext(DeviceContext: TDeviceContext);
type
TCreateGCForDC = procedure(DC: TDeviceContext) of object;
TCreateGDIObjectForDC = procedure(DC: TDeviceContext; aGDIType: TGDIType) of object;
var
CreateGCForDC: TCreateGCForDC = nil;
CreateGDIObjectForDC: TCreateGDIObjectForDC = nil;
{$IFDEF DebugLCLComponents}
var
@ -467,9 +590,14 @@ function dbgs(r: PGDKRectangle): string; overload;
implementation
uses
// until all code is transfered to objects, these circles are needed;
gtkint, gtkproc, GtkFontCache, GTKWinApiWindow;
{$IFOpt R+}{$Define RangeChecksOn}{$Endif}
{$i gtkdevicecontext.inc}
// memory system for PGDIObject(s) ---------------------------------------------
type
TGDIObjectMemManager = class(TLCLMemManager)
@ -560,46 +688,14 @@ begin
end;
// memory system for TDeviceContext(s) ---------------------------------------------
type
TDeviceContextMemManager = class(TLCLMemManager)
protected
procedure FreeFirstItem; override;
public
procedure DisposeDeviceContext(ADeviceContext: TDeviceContext);
function NewDeviceContext: TDeviceContext;
end;
const
DeviceContextMemManager: TDeviceContextMemManager = nil;
function NewDeviceContext: TDeviceContext;
begin
if DeviceContextMemManager=nil then begin
DeviceContextMemManager:=TDeviceContextMemManager.Create;
DeviceContextMemManager.MinimumFreeCount:=1000;
end;
Result:=DeviceContextMemManager.NewDeviceContext;
{$IFDEF DebugLCLComponents}
DebugDeviceContexts.MarkCreated(Result,'NewDeviceContext');
{$ENDIF}
end;
procedure DisposeDeviceContext(DeviceContext: TDeviceContext);
begin
{$IFDEF DebugLCLComponents}
DebugDeviceContexts.MarkDestroyed(DeviceContext);
{$ENDIF}
DeviceContextMemManager.DisposeDeviceContext(DeviceContext);
end;
{ TDeviceContextMemManager }
procedure TDeviceContextMemManager.FreeFirstItem;
var ADeviceContext: TDeviceContext;
var ADeviceContext: TGtkDeviceContext;
begin
ADeviceContext:=TDeviceContext(FFirstFree);
TDeviceContext(FFirstFree):=ADeviceContext.SavedContext;
ADeviceContext:=TGtkDeviceContext(FFirstFree);
TGtkDeviceContext(FFirstFree):=ADeviceContext.SavedContext;
//DebugLn('TDeviceContextMemManager.FreeFirstItem FFreedCount=',FFreedCount);
ADeviceContext.Free;
{$R-}
@ -607,16 +703,23 @@ begin
{$IfDef RangeChecksOn}{$R+}{$Endif}
end;
procedure TDeviceContextMemManager.DisposeDeviceContext(
ADeviceContext: TDeviceContext);
constructor TDeviceContextMemManager.Create(AClass: TGtkDeviceContextClass);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
begin
inherited Create;
FDeviceContextClass := AClass;
end;
procedure TDeviceContextMemManager.DisposeDeviceContext(
ADeviceContext: TGtkDeviceContext);
begin
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio))
then begin
// add ADeviceContext to Free list
ADeviceContext.SavedContext:=TDeviceContext(FFirstFree);
TDeviceContext(FFirstFree):=ADeviceContext;
ADeviceContext.SavedContext:=TGtkDeviceContext(FFirstFree);
TGtkDeviceContext(FFirstFree):=ADeviceContext;
inc(FFreeCount);
end else begin
end
else begin
// free list full -> free the ANode
//DebugLn('TDeviceContextMemManager.DisposeDeviceContext FFreedCount=',FFreedCount);
ADeviceContext.Free;
@ -627,208 +730,30 @@ begin
dec(FCount);
end;
function TDeviceContextMemManager.NewDeviceContext: TDeviceContext;
function TDeviceContextMemManager.NewDeviceContext: TGtkDeviceContext;
begin
if FFirstFree<>nil then begin
if FFirstFree <> nil
then begin
// take from free list
Result:=TDeviceContext(FFirstFree);
TDeviceContext(FFirstFree):=Result.SavedContext;
dec(FFreeCount);
end else begin
Result := TGtkDeviceContext(FFirstFree);
TGtkDeviceContext(FFirstFree) := Result.SavedContext;
Dec(FFreeCount);
Result.Clear;
end
else begin
// free list empty -> create new node
Result:=TDeviceContext.Create;
Result := FDeviceContextClass.Create;
//DebugLn('TDeviceContextMemManager.NewDeviceContext FAllocatedCount=',FAllocatedCount);
{$R-}
inc(FAllocatedCount);
{$IfDef RangeChecksOn}{$R+}{$Endif}
end;
Result.Clear;
inc(FCount);
Inc(FCount);
end;
//------------------------------------------------------------------------------
{ TDeviceContext }
procedure TDeviceContext.SetClipRegion(const AValue: PGdiObject);
begin
ChangeGDIObject(fClipRegion,AValue);
end;
function TDeviceContext.GetGDIObjects(ID: TGDIType): PGdiObject;
begin
case ID of
gdiBitmap: Result:=CurrentBitmap;
gdiFont: Result:=CurrentFont;
gdiBrush: Result:=CurrentBrush;
gdiPen: Result:=CurrentPen;
gdiPalette: Result:=CurrentPalette;
gdiRegion: Result:=ClipRegion;
end;
end;
function TDeviceContext.GetOwnedGDIObjects(ID: TGDIType): PGdiObject;
begin
Result:=fOwnedGDIObjects[ID];
end;
procedure TDeviceContext.SetCurrentBitmap(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentBitmap,AValue);
end;
procedure TDeviceContext.SetCurrentBrush(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentBrush,AValue);
end;
procedure TDeviceContext.SetCurrentFont(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentFont,AValue);
end;
procedure TDeviceContext.SetCurrentPalette(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentPalette,AValue);
end;
procedure TDeviceContext.SetCurrentPen(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentPen,AValue);
end;
procedure TDeviceContext.ChangeGDIObject(var GDIObject: PGdiObject;
const NewValue: PGdiObject);
begin
if GdiObject=NewValue then exit;
if GdiObject<>nil then begin
dec(GdiObject^.DCCount);
if GdiObject^.DCCount<0 then
RaiseGDBException('');
end;
//if GdiObject<>nil then
// DebugLn(['TDeviceContext.ChangeGDIObject DC=',dbgs(Self),' OldGDIObject=',dbgs(GdiObject),' Old.DCCount=',GdiObject^.DCCount]);
GdiObject:=NewValue;
if GdiObject<>nil then
inc(GdiObject^.DCCount);
//if GdiObject<>nil then
// DebugLn(['TDeviceContext.ChangeGDIObject DC=',dbgs(Self),' NewGDIObject=',dbgs(GdiObject),' New.DCCount=',GdiObject^.DCCount]);
end;
procedure TDeviceContext.SetGDIObjects(ID: TGDIType; const AValue: PGdiObject);
begin
case ID of
gdiBitmap: ChangeGDIObject(fCurrentBitmap,AValue);
gdiFont: ChangeGDIObject(fCurrentFont,AValue);
gdiBrush: ChangeGDIObject(fCurrentBrush,AValue);
gdiPen: ChangeGDIObject(fCurrentPen,AValue);
gdiPalette: ChangeGDIObject(fCurrentPalette,AValue);
gdiRegion: ChangeGDIObject(fClipRegion,AValue);
end;
end;
procedure TDeviceContext.SetOwnedGDIObjects(ID: TGDIType;
const AValue: PGdiObject);
begin
if fOwnedGDIObjects[ID]=AValue then exit;
if fOwnedGDIObjects[ID]<>nil then
fOwnedGDIObjects[ID]^.Owner:=nil;
fOwnedGDIObjects[ID]:=AValue;
if fOwnedGDIObjects[ID]<>nil then
fOwnedGDIObjects[ID]^.Owner:=Self;
end;
procedure TDeviceContext.Clear;
var
g: TGDIType;
procedure WarnOwnedGDIObject;
begin
DebugLn(['TDeviceContext.Clear ',dbghex(PtrInt(Self)),' OwnedGDIObjects[',ord(g),']<>nil']);
end;
begin
DCWidget:=nil;
Drawable:=nil;
GC:=nil;
FillChar(GCValues, SizeOf(GCValues), #0);
Origin.X:=0;
Origin.Y:=0;
SpecialOrigin:=false;
PenPos.X:=0;
PenPos.Y:=0;
CurrentBitmap:=nil;
CurrentFont:=nil;
CurrentPen:=nil;
CurrentBrush:=nil;
CurrentPalette:=nil;
ClipRegion:=nil;
FillChar(CurrentTextColor,SizeOf(CurrentTextColor),0);
FillChar(CurrentBackColor,SizeOf(CurrentBackColor),0);
SelectedColors:=dcscCustom;
SavedContext:=nil;
DCFlags:=[];
for g:=Low(TGDIType) to high(TGDIType) do
if OwnedGDIObjects[g]<>nil then
WarnOwnedGDIObject;
end;
function TDeviceContext.GetGC: pgdkGC;
begin
if FGC = nil then
CreateGCForDC(Self);
Result := FGC;
end;
function TDeviceContext.GetFont: PGdiObject;
begin
if CurrentFont=nil then
CreateGDIObjectForDC(Self,gdiFont);
Result:=CurrentFont;
end;
function TDeviceContext.GetBrush: PGdiObject;
begin
if CurrentBrush=nil then
CreateGDIObjectForDC(Self,gdiBrush);
Result:=CurrentBrush;
end;
function TDeviceContext.GetPen: PGdiObject;
begin
if CurrentPen = nil then
CreateGDIObjectForDC(Self, gdiPen);
Result := CurrentPen;
end;
function TDeviceContext.HasGC: Boolean;
begin
Result := FGC <> nil;
end;
function TDeviceContext.IsNullBrush: boolean;
begin
Result := (FCurrentBrush <> nil) and (FCurrentBrush^.IsNullBrush);
end;
function TDeviceContext.IsNullPen: boolean;
begin
Result := (FCurrentPen <> nil) and (FCurrentPen^.IsNullPen);
end;
function TDeviceContext.GetBitmap: PGdiObject;
begin
if CurrentBitmap=nil then
CreateGDIObjectForDC(Self,gdiBitmap);
Result:=CurrentBitmap;
end;
procedure GtkDefInit;
begin
{$IFDEF DebugLCLComponents}
@ -842,8 +767,6 @@ procedure GtkDefDone;
begin
GDIObjectMemManager.Free;
GDIObjectMemManager:=nil;
DeviceContextMemManager.Free;
DeviceContextMemManager:=nil;
{$IFDEF DebugLCLComponents}
FreeAndNil(DebugGtkWidgets);
FreeAndNil(DebugGdiObjects);

838
lcl/interfaces/gtk/gtkdevicecontext.inc Normal file
View File

@ -0,0 +1,838 @@
{%MainUnit gtkdef.pp}
{******************************************************************************
TGtkDeviceContext
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
{ TDeviceContext }
procedure TGtkDeviceContext.SetClipRegion(const AValue: PGdiObject);
begin
ChangeGDIObject(fClipRegion, AValue);
end;
function TGtkDeviceContext.GetGDIObjects(ID: TGDIType): PGdiObject;
begin
case ID of
gdiBitmap: Result:=CurrentBitmap;
gdiFont: Result:=CurrentFont;
gdiBrush: Result:=CurrentBrush;
gdiPen: Result:=CurrentPen;
gdiPalette: Result:=CurrentPalette;
gdiRegion: Result:=ClipRegion;
end;
end;
{------------------------------------------------------------------------------
function GetOffset
Returns the DC offset for the DC Origin.
------------------------------------------------------------------------------}
function TGtkDeviceContext.GetOffset: TPoint;
var
Fixed : Pointer;
Adjustment: PGtkAdjustment;
begin
if Self = nil
then begin
Result.X := 0;
Result.Y := 0;
Exit;
end;
Result := FOrigin;
{$ifdef GTK2}
if (FWidget <> nil)
and GTK_WIDGET_NO_WINDOW(FWidget)
and not GtkWidgetIsA(FWidget, GTKAPIWidget_GetType)
then begin
Inc(Result.X, FWidget^.Allocation.x);
Inc(Result.y, FWidget^.Allocation.y);
end;
{$endIf}
if not FSpecialOrigin then Exit;
if FWidget = nil then Exit;
Fixed := GetFixedWidget(FWidget);
if not GtkWidgetIsA(Fixed, GTK_LAYOUT_GET_TYPE) then Exit;
Adjustment := gtk_layout_get_hadjustment(Fixed);
if Adjustment <> nil
then Dec(Result.X, Trunc(Adjustment^.Value - Adjustment^.Lower));
Adjustment := gtk_layout_get_vadjustment(Fixed);
if Adjustment <> nil
then Dec(Result.Y, Trunc(Adjustment^.Value-Adjustment^.Lower));
end;
function TGtkDeviceContext.GetOwnedGDIObjects(ID: TGDIType): PGdiObject;
begin
Result:=fOwnedGDIObjects[ID];
end;
procedure TGtkDeviceContext.SetCurrentBitmap(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentBitmap,AValue);
end;
procedure TGtkDeviceContext.SetCurrentBrush(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentBrush,AValue);
if FSelectedColors = dcscBrush
then FSelectedColors := dcscCustom;
end;
procedure TGtkDeviceContext.SetCurrentFont(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentFont,AValue);
end;
procedure TGtkDeviceContext.SetCurrentPalette(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentPalette,AValue);
end;
procedure TGtkDeviceContext.SetCurrentPen(const AValue: PGdiObject);
begin
ChangeGDIObject(FCurrentPen,AValue);
if FSelectedColors = dcscPen
then FSelectedColors := dcscCustom;
end;
procedure TGtkDeviceContext.ChangeGDIObject(var GDIObject: PGdiObject;
const NewValue: PGdiObject);
begin
if GdiObject = NewValue then exit;
if GdiObject <> nil
then begin
dec(GdiObject^.DCCount);
if GdiObject^.DCCount < 0 then
RaiseGDBException('');
end;
GdiObject := NewValue;
if GdiObject <> nil
then begin
inc(GdiObject^.DCCount);
end;
end;
procedure TGtkDeviceContext.SetGDIObjects(ID: TGDIType; const AValue: PGdiObject);
begin
case ID of
gdiBitmap: ChangeGDIObject(fCurrentBitmap,AValue);
gdiFont: ChangeGDIObject(fCurrentFont,AValue);
gdiBrush: ChangeGDIObject(fCurrentBrush,AValue);
gdiPen: ChangeGDIObject(fCurrentPen,AValue);
gdiPalette: ChangeGDIObject(fCurrentPalette,AValue);
gdiRegion: ChangeGDIObject(fClipRegion,AValue);
end;
end;
procedure TGtkDeviceContext.SetOwnedGDIObjects(ID: TGDIType;
const AValue: PGdiObject);
begin
//MWE: this is not right. all objects except bitmaps can be selected in more than one DC
if fOwnedGDIObjects[ID]=AValue then exit;
if fOwnedGDIObjects[ID]<>nil then
fOwnedGDIObjects[ID]^.Owner:=nil;
fOwnedGDIObjects[ID]:=AValue;
if fOwnedGDIObjects[ID]<>nil then
fOwnedGDIObjects[ID]^.Owner:=Self;
end;
procedure TGtkDeviceContext.SetROP2(AROP: Integer);
var
Func: TGdkFunction;
begin
case AROP of
R2_COPYPEN: Func := GDK_COPY;
R2_NOT: Func := GDK_INVERT;
R2_XORPEN: Func := GDK_XOR;
R2_BLACK: Func := GDK_CLEAR;
R2_MASKPEN: Func := GDK_AND;
R2_MASKPENNOT: Func := GDK_AND_REVERSE;
R2_MASKNOTPEN: Func := GDK_AND_INVERT;
R2_NOP: Func := GDK_NOOP;
R2_MERGEPEN: Func := GDK_OR;
R2_NOTXORPEN: Func := GDK_EQUIV;
R2_MERGEPENNOT: Func := GDK_OR_REVERSE;
R2_NOTCOPYPEN: Func := GDK_COPY_INVERT;
R2_NOTMASKPEN: Func := GDK_NAND;
//R2_NOTMERGEPEN: Func := GDK_NOR;
R2_WHITE: Func := GDK_SET;
else
Func := GDK_COPY;
end;
gdk_gc_set_function(GC, Func);
end;
procedure TGtkDeviceContext.SetSelectedColors(AValue: TDevContextSelectedColorsType);
begin
if FSelectedColors = AValue then Exit;
FSelectedColors := AValue;
case FSelectedColors of
dcscPen: SelectPenProps;
dcscBrush: SelectBrushProps;
dcscFont: SelectTextProps;
end;
end;
procedure TGtkDeviceContext.SetTextMetricsValid(AValid: Boolean);
begin
if AValid
then Include(FFlags, dcfTextMetricsValid)
else Exclude(FFlags, dcfTextMetricsValid);
end;
procedure TGtkDeviceContext.SetWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
AWithChildWindows: Boolean; ADoubleBuffer: PGdkDrawable);
procedure RaiseWidgetWithoutClientArea;
begin
RaiseGDBException('TGtkDeviceContext.SetWidget: widget ' + DbgS(AWidget) + ' has no client area');
end;
procedure RaiseWidgetAlreadySet;
begin
RaiseGDBException('TGtkDeviceContext.SetWidget: widget already set');
end;
procedure RaiseUnableToRealize;
begin
RaiseGDBException('TGtkDeviceContext.SetWidget: Unable to realize GdkWindow');
end;
var
ClientWidget: PGtkWidget;
begin
if FWidget <> nil
then RaiseWidgetAlreadySet;
FWithChildWindows := AWithChildWindows;
FWidget := AWidget;
if AWidget = nil
then begin
// screen: ToDo: multiple desktops
{$ifdef gtk1}
FDrawable := @gdk_root_parent;
{$else}
FDrawable := gdk_screen_get_root_window(gdk_screen_get_default);
{$endif}
end
else begin
if ADoubleBuffer <> nil
then begin
Include(FFlags, dcfDoubleBuffer);
FOriginalDrawable := AWindow;
FDrawable := ADoubleBuffer;
end
else begin
// create a new devicecontext for this window
Exclude(FFlags, dcfDoubleBuffer);
if AWindow = nil
then begin
ClientWidget := GetFixedWidget(AWidget);
if ClientWidget = nil then RaiseWidgetWithoutClientArea;
AWindow := GetControlWindow(ClientWidget);
if AWindow = nil
then begin
//force creation
gtk_widget_realize(ClientWidget);
AWindow := GetControlWindow(ClientWidget);
if AWindow = nil then RaiseUnableToRealize;
end;
end
else begin
ClientWidget := AWidget;
end;
FSpecialOrigin := GtkWidgetIsA(ClientWidget, GTK_LAYOUT_GET_TYPE);
FDrawable := AWindow;
{$IFDEF Gtk1}
{$note todo: check if this is still needed} // now gc is a property
GetGC;
{$ELSE}
// GC is created on demand
{$ENDIF}
end;
end;
gdk_color_black(gdk_colormap_get_system, @CurrentTextColor.Color);
BuildColorRefFromGDKColor(CurrentTextColor);
gdk_color_white(gdk_colormap_get_system, @CurrentBackColor.Color);
BuildColorRefFromGDKColor(CurrentBackColor);
{$ifdef GTK1}
GetFont;
GetBrush;
GetPen;
{$else}
// font, brush, pen are created on demand
{$endIf}
end;
procedure TGtkDeviceContext.Clear;
var
g: TGDIType;
procedure WarnOwnedGDIObject;
begin
DebugLn(['TDeviceContext.Clear ',dbghex(PtrInt(Self)),' OwnedGDIObjects[',ord(g),']<>nil']);
end;
begin
FWidget := nil;
FDrawable := nil;
FGC := nil;
FillChar(FGCValues, SizeOf(FGCValues), 0);
FOrigin.X := 0;
FOrigin.Y := 0;
FSpecialOrigin := False;
PenPos.X:=0;
PenPos.Y:=0;
CurrentBitmap:=nil;
CurrentFont:=nil;
CurrentPen:=nil;
CurrentBrush:=nil;
CurrentPalette:=nil;
ClipRegion:=nil;
FillChar(CurrentTextColor,SizeOf(CurrentTextColor),0);
FillChar(CurrentBackColor,SizeOf(CurrentBackColor),0);
SelectedColors:=dcscCustom;
SavedContext:=nil;
FFlags := [];
for g:=Low(TGDIType) to high(TGDIType) do
if OwnedGDIObjects[g]<>nil then
WarnOwnedGDIObject;
end;
{------------------------------------------------------------------------------
Function: CopyData - used by RestoreDC and SaveDC
Params: DestinationDC: a dc to copy data to
ClearSource: set true to make a move operation
MoveGDIOwnerShip: set true to pass the ownership of the GDI objects
to Destination
Returns: True if succesful
Creates a copy DC from the given DC
------------------------------------------------------------------------------}
function TGtkDeviceContext.CopyDataFrom(ASource: TGtkDeviceContext; AClearSource, AMoveGDIOwnerShip, ARestore: Boolean): Boolean;
procedure RaiseRestoreDifferentWidget;
begin
RaiseGDBException('TGtkDeviceContext.CopyDataFrom: restore widget differs');
end;
procedure RaiseWidgetAlreadySet;
begin
RaiseGDBException('TGtkDeviceContext.CopyDataFrom: widget already set');
end;
var
g: TGDIType;
CurGDIObject: PGDIObject;
begin
Result := (Self <> nil) and (ASource <> nil);
if not Result then Exit;
if ARestore
then begin
if FWidget <> ASource.FWidget
then RaiseRestoreDifferentWidget;
end
else begin
if FWidget <> nil
then RaiseWidgetAlreadySet;
FWidget := ASource.FWidget;
end;
FWithChildWindows := ASource.FWithChildWindows;
FDrawable := ASource.FDrawable;
FOriginalDrawable := ASource.FOriginalDrawable;
if FGC <> nil
then begin
// free old GC
gdk_gc_unref(FGC);
FGC := nil;
Exclude(FFlags, dcfPenSelected);
end;
if (ASource.FGC <> nil) and (FDrawable <> nil)
then begin
gdk_gc_get_values(ASource.FGC, @FGCValues);
FGC := gdk_gc_new_with_values(FDrawable, @FGCValues, 3 { $3FF});
Exclude(FFlags, dcfPenSelected);
end;
FOrigin := ASource.FOrigin;
FSpecialOrigin := ASource.FSpecialOrigin;
PenPos := ASource.PenPos;
if dcfTextMetricsValid in ASource.Flags
then begin
Include(FFlags, dcfTextMetricsValid);
DCTextMetric := ASource.DCTextMetric;
end
else
Exclude(FFlags, dcfTextMetricsValid);
for g:=Low(TGDIType) to High(TGDIType) do
begin
GDIObjects[g] := ASource.GDIObjects[g];
if AClearSource then
ASource.GDIObjects[g] := nil;
if AMoveGDIOwnerShip
then begin
if OwnedGDIObjects[g]<>nil
then begin
DeleteObject(HGDIOBJ(PtrUInt(OwnedGDIObjects[g])));
end;
CurGDIObject := ASource.OwnedGDIObjects[g];
if CurGDIObject<>nil
then begin
ASource.OwnedGDIObjects[g] := nil;
OwnedGDIObjects[g] := CurGDIObject;
end;
end;
end;
CopyGDIColor(ASource.CurrentTextColor, CurrentTextColor);
CopyGDIColor(ASource.CurrentBackColor, CurrentBackColor);
SelectedColors := dcscCustom;
SavedContext := nil;
end;
procedure TGtkDeviceContext.CreateBrush;
begin
if FCurrentBrush <> nil then Exit;
CurrentBrush := GtkWidgetset.CreateDefaultBrush;
OwnedGDIObjects[gdiBrush] := FCurrentBrush;
end;
procedure TGtkDeviceContext.CreateFont;
{$IFDEF Gtk2}
var
ClientWidget: PGtkWidget;
{$ENDIF}
begin
if FCurrentFont <> nil then exit;
// create font
{$ifdef gtk1}
if FGCValues.Font <> nil
then begin
CurrentFont := GtkWidgetset.NewGDIObject(gdiFont);
FCurrentFont^.GDIFontObject := FGCValues.Font;
FontCache.Reference(FCurrentFont^.GDIFontObject);
end
else
CurrentFont := GtkWidgetset.CreateDefaultFont;
{$else}
if FWidget <> nil
then begin
ClientWidget := GetFixedWidget(FWidget);
CurrentFont := GtkWidgetset.NewGDIObject(gdiFont);
FCurrentFont^.GDIFontObject := gtk_widget_create_pango_layout(ClientWidget, nil);
{$ifdef fontconsistencychecks}
if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) <> nil then
RaiseGDBException('inconsistency: font already in cache, maybe freed, but not removed from cache');
{$endif}
FontCache.AddWithoutName(FCurrentFont^.GDIFontObject);
{$ifdef fontconsistencychecks}
// MWE: are we paranoid or so ? (if you can't trust the cache, don't use it or stop coding)
if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) = nil then
RaiseGDBException('inconsistency: font added to cache, but can not be found');
{$endif}
end
else
CurrentFont := GtkWidgetset.CreateDefaultFont;
{$endif}
OwnedGDIObjects[gdiFont] := FCurrentFont;
end;
function TGtkDeviceContext.CreateGC: PGdkGC;
{$IFDEF Gtk1}
var
CurWidget: PGtkWidget;
CurWindow: PGdkWindow;
{$ENDIF}
begin
// create GC
if Drawable <> nil
then begin
if FWithChildWindows
then begin
FillChar(FGCValues, SizeOf(FGCValues), 0);
FGCValues.subwindow_mode := GDK_INCLUDE_INFERIORS;
Result := gdk_gc_new_with_values(Drawable, @FGCValues, GDK_GC_FUNCTION or GDK_GC_SUBWINDOW);
end
else begin
Result := gdk_gc_new(Drawable);
end;
end
else begin
// create default GC
{$IFDEF Gtk1}
CurWidget := GetStyleWidget(lgsWindow);
CurWindow := CurWidget^.window;
Result := gdk_gc_new(CurWindow);
{$ELSE}
Result := gdk_gc_new(gdk_screen_get_root_window(gdk_screen_get_default));
{$ENDIF}
end;
if Result = nil then Exit;
gdk_gc_set_function(Result, GDK_COPY);
gdk_gc_get_values(Result, @FGCValues);
end;
procedure TGtkDeviceContext.CreateBitmap;
begin
if FCurrentBitmap <> nil then Exit;
CurrentBitmap := GTKWidgetset.CreateDefaultGDIBitmap;
OwnedGDIObjects[gdiBitmap] := FCurrentBitmap;
end;
procedure TGtkDeviceContext.CreateGDIObject(AGDIType: TGDIType);
begin
case AGDIType of
gdiFont: CreateFont;
gdiBrush: CreateBrush;
gdiPen: CreatePen;
gdiBitmap: CreateBitmap;
else
RaiseGDBException('TGtkDeviceContext.CreateGDIObject');
end;
end;
procedure TGtkDeviceContext.CreatePen;
begin
if FCurrentPen <> nil then exit;
CurrentPen := GtkWidgetSet.CreateDefaultPen;
OwnedGDIObjects[gdiPen] := FCurrentPen;
end;
function TGtkDeviceContext.GetGC: pgdkGC;
begin
if FGC = nil
then FGC := CreateGC;
Result := FGC;
end;
function TGtkDeviceContext.GetFont: PGdiObject;
begin
if FCurrentFont = nil
then CreateFont;
Result := FCurrentFont;
end;
function TGtkDeviceContext.GetBrush: PGdiObject;
begin
if FCurrentBrush = nil
then CreateBrush;
Result := FCurrentBrush;
end;
function TGtkDeviceContext.GetPen: PGdiObject;
begin
if FCurrentPen = nil
then CreatePen;
Result := FCurrentPen;
end;
function TGtkDeviceContext.GetROP2: Integer;
begin
case GetFunction of
GDK_COPY: result := R2_COPYPEN;
GDK_INVERT: result := R2_NOT;
GDK_XOR: result := R2_XORPEN;
GDK_CLEAR: result := R2_BLACK;
GDK_AND: result := R2_MASKPEN;
GDK_AND_REVERSE: result := R2_MASKPENNOT;
GDK_AND_INVERT: result := R2_MASKNOTPEN;
GDK_NOOP: result := R2_NOP;
GDK_OR: result := R2_MERGEPEN;
GDK_EQUIV: result := R2_NOTXORPEN;
GDK_OR_REVERSE: result := R2_MERGEPENNOT;
GDK_COPY_INVERT: result := R2_NOTCOPYPEN;
GDK_NAND: result := R2_NOTMASKPEN;
//GDK_NOR: result := R2_NOTMERGEPEN;
GDK_SET: result := R2_WHITE;
else
result := R2_COPYPEN;
end;
end;
function TGtkDeviceContext.HasGC: Boolean;
begin
Result := FGC <> nil;
end;
function TGtkDeviceContext.IsNullBrush: boolean;
begin
Result := (FCurrentBrush <> nil) and (FCurrentBrush^.IsNullBrush);
end;
function TGtkDeviceContext.IsNullPen: boolean;
begin
Result := (FCurrentPen <> nil) and (FCurrentPen^.IsNullPen);
end;
procedure TGtkDeviceContext.ResetGCClipping;
begin
if FGC = nil then Exit;
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$endif}
gdk_gc_set_clip_mask(FGC, nil);
gdk_gc_set_clip_origin (FGC, 0,0);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$endif}
SelectRegion;
end;
function TGtkDeviceContext.SelectBitmap(AGdiObject: PGdiObject): PGdiObject;
var
NewDrawable: PGdkPixmap;
begin
// always create, because a valid GDIObject is needed to restore
Result := GetBitmap;
if CurrentBitmap = AGDIObject then Exit;
CurrentBitmap := AGDIObject;
with FCurrentBitmap^ do
case GDIBitmapType of
gbPixmap: NewDrawable := GDIPixmapObject.Image;
gbBitmap: NewDrawable := GDIBitmapObject;
else
DebugLn('[TGtkDeviceContext.SelectBitmap] - Unknown bitmaptype, DC=0x%p', [Pointer(Self)]);
Exit;
end;
// no drawable: this is normal, when restoring the default bitmap (FreeDC)
if NewDrawable = nil then Exit;
if FGC <> nil
then gdk_gc_unref(FGC);
FDrawable := NewDrawable;
FGC := gdk_gc_new(FDrawable);
gdk_gc_set_function(FGC, GDK_COPY);
SelectedColors := dcscCustom;
end;
{------------------------------------------------------------------------------
Procedure: TGtkDeviceContext.SelectBrushProps
Params:
Returns: Nothing
Sets the forecolor and fill according to the brush
------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectBrushProps;
begin
if IsNullBrush then Exit;
// Force brush
GetBrush;
EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(HDC(Self), dccGDIBrushColor, CurrentBrush^.GDIBrushFill = GDK_Solid, False);//Brush Color
if CurrentBrush^.GDIBrushFill = GDK_Solid then Exit;
if CurrentBrush^.GDIBrushPixmap = nil then Exit;
gdk_gc_set_fill(GC, CurrentBrush^.GDIBrushFill);
if CurrentBrush^.GDIBrushFill = GDK_STIPPLED
then gdk_gc_set_stipple(GC, CurrentBrush^.GDIBrushPixmap)
else gdk_gc_set_tile(GC, CurrentBrush^.GDIBrushPixmap);
gdk_gc_get_values(GC, @FGCValues);
end;
function TGtkDeviceContext.SelectObject(AGdiObject: PGdiObject): PGdiObject;
begin
case AGdiObject^.GDIType of
gdiBitmap: Result := SelectBitmap(AGdiObject);
gdiPen: Result := SelectPen(AGdiObject);
else
// we only handle bitmaps here atm
Result := PGdiObject(GTKWidgetSet.SelectObject(HDC(Self), HGDIOBJ(AGdiObject)));
end;
end;
function TGtkDeviceContext.SelectPen(AGdiObject: PGdiObject): PGdiObject;
begin
Result := GetPen;// always create, because a valid GDIObject is needed to restore
if CurrentPen = AGDIObject then Exit;
CurrentPen := AGDIObject;
Exclude(FFlags, dcfPenSelected);
if FGC <> nil
then SelectPenProps;
SelectedColors := dcscCustom;
end;
{------------------------------------------------------------------------------
Procedure: TGtkDeviceContext.SelectPenProps
Params: DC: a (LCL)devicecontext
Returns: Nothing
Sets the forecolor and fill according to the pen
------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectPenProps;
const
{$ifdef windows}
OS_multiplier = 1;
{$else}
OS_multiplier = 3;
{$endif}
procedure SetDashes(const ADashes: array of gint8);
begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
laz_gdk_gc_set_dashes(GC, 0, @ADashes[0], Length(ADashes));
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
begin
// if IsNullPen then Exit;
EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(HDC(Self), dccGDIPenColor, False, False);//Pen Color
if dcfPenSelected in FFlags then Exit;
Exclude(FFlags, dcfPenInvalid);
if GC = nil then Exit;
// force pen
GetPen;
CurrentPen^.IsNullPen := CurrentPen^.GDIPenStyle = PS_NULL;
if (CurrentPen^.GDIPenStyle = PS_SOLID)
or (CurrentPen^.GDIPenStyle = PS_INSIDEFRAME)
then begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, CurrentPen^.GDIPenWidth, GDK_LINE_SOLID, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end
else begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, CurrentPen^.GDIPenWidth, GDK_LINE_ON_OFF_DASH, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
// Paul Ishenin: I comparet patterns with windows and changed numbers to make them the same
// but under linux dot is thinner than in windows, so I added os_multiplier to make them the same
// in resulting image
case CurrentPen^.GDIPenStyle of
PS_DASH: SetDashes([6*OS_multiplier,2*OS_multiplier]);
PS_DOT: SetDashes([1*OS_multiplier,1*OS_multiplier]);
PS_DASHDOT: SetDashes([3*OS_multiplier,2*OS_multiplier,1*OS_multiplier,2*OS_multiplier]);
PS_DASHDOTDOT: SetDashes([3*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier]);
//This is DEADLY!!!
//PS_NULL: gdk_gc_set_dashes(GC, 0, [0,4], 2);
end;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
gdk_gc_get_values(GC,@FGCValues);
Include(FFlags, dcfPenSelected);
end;
{------------------------------------------------------------------------------
Procedure SelectRegion
Applies the current clipping region of the DC (DeviceContext) to the
gc (GDK Graphic context - pgdkGC)
------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectRegion;
var
RGNType : Longint;
begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
// force GC
GetGC;
// Clear
gdk_gc_set_clip_region(FGC, nil);
gdk_gc_set_clip_rectangle(FGC, nil);
if ClipRegion <> nil
then begin
RGNType := RegionType(ClipRegion^.GDIRegionObject);
if (RGNType <> ERROR) and (RGNType <> NULLREGION)
then gdk_gc_set_clip_region(FGC, ClipRegion^.GDIRegionObject);
end;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
{------------------------------------------------------------------------------
Procedure: TGtkDeviceContext.SelectTextProps
Params:
Returns: Nothing
Sets the forecolor and fill according to the Textcolor
------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectTextProps;
begin
EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(HDC(Self), dccCurrentTextColor, False, False);//Font Color
end;
function TGtkDeviceContext.GetBitmap: PGdiObject;
begin
if FCurrentBitmap = nil
then CreateBitmap;
Result := FCurrentBitmap;
end;

59
lcl/interfaces/gtk/gtkglobals.pp
View File

@ -98,65 +98,6 @@ procedure ResetDefaultIMContext;
var
LastFileSelectRow : gint;
// styles -------------------------------------------------------------------
type
TLazGtkStyle = (
lgsGTK_Default, // without anything
lgsDefault, // with rc file
lgsButton,
lgsLabel,
lgsWindow,
lgsCheckbox,
lgsRadiobutton,
lgsMenu,
lgsMenuBar,
lgsMenuitem,
lgsList,
lgsVerticalScrollbar,
lgsHorizontalScrollbar,
lgsTooltip,
lgsVerticalPaned,
lgsHorizontalPaned,
lgsNotebook,
lgsStatusBar,
lgsHScale,
lgsVScale,
lgsGroupBox,
lgsTreeView, // for gtk2
lgsToolBar, // toolbar
lgsToolButton, // button placed on toolbar
// user defined
lgsUserDefined
);
const
LazGtkStyleNames: array[TLazGtkStyle] of string = (
'gtk_default',
'default',
'button',
'label',
'window',
'checkbox',
'radiobutton',
'menu',
'menubar',
'menuitem',
'list',
'vertical scrollbar',
'horizontal scrollbar',
'tooltip',
'vertical paned',
'horizontal paned',
'statusbar',
'notebook',
'hscale',
'vscale',
'groupbox',
'treeview',
'toolbar',
'toolbutton',
''
);
var
Styles : TStrings;

28
lcl/interfaces/gtk/gtkint.pp
View File

@ -123,8 +123,11 @@ type
FExtUTF8OutCache: Pointer;
FExtUTF8OutCacheSize: integer;
FGlobalCursor: HCursor;
FDCManager: TDeviceContextMemManager;
function CreateThemeServices: TThemeServices; override;
function GetDeviceContextClass: TGtkDeviceContextClass; virtual; abstract;
public
procedure InitStockItems; virtual;
procedure FreeStockItems; virtual;
@ -163,17 +166,11 @@ type
// device contexts
function IsValidDC(const DC: HDC): Boolean;virtual;
function NewDC: TDeviceContext;virtual;
function FindDCWithGDIObject(GDIObject: PGdiObject): TDeviceContext;virtual;
procedure DisposeDC(aDC: TDeviceContext);virtual;
function CreateDCForWidget(TheWidget: PGtkWidget; TheWindow: PGdkWindow;
WithChildWindows: boolean): HDC;
procedure OnCreateGCForDC(DC: TDeviceContext);
procedure OnCreateGDIObjectForDC(DC: TDeviceContext; aGDIType: TGDIType);
procedure OnCreateFontForDC(DC: TDeviceContext);
procedure OnCreateBrushForDC(DC: TDeviceContext);
procedure OnCreatePenForDC(DC: TDeviceContext);
procedure OnCreateGDIBitmapForDC(DC: TDeviceContext);
function NewDC: TGtkDeviceContext;virtual;
function FindDCWithGDIObject(GDIObject: PGdiObject): TGtkDeviceContext;virtual;
procedure DisposeDC(aDC: TGtkDeviceContext);virtual;
function CreateDCForWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
AWithChildWindows: Boolean; ADoubleBuffer: PgdkDrawable = nil): HDC;
function GetDoubleBufferedDC(Handle: HWND): HDC;
// GDIObjects
@ -182,19 +179,16 @@ type
const GDIType: TGDIType): Boolean;virtual;
function NewGDIObject(const GDIType: TGDIType): PGdiObject;virtual;
procedure DisposeGDIObject(GdiObject: PGdiObject);virtual;
procedure SelectGDKBrushProps(DC: HDC);virtual;
procedure SelectGDKTextProps(DC: HDC);virtual;
procedure SelectGDKPenProps(DC: HDC);virtual;
function CreateDefaultBrush: PGdiObject;virtual;
function CreateDefaultFont: PGdiObject;virtual;
function CreateDefaultPen: PGdiObject;virtual;
function CreateDefaultGDIBitmap: PGdiObject;virtual;
procedure UpdateDCTextMetric(DC: TDeviceContext); virtual;
procedure UpdateDCTextMetric(DC: TGtkDeviceContext); virtual;
{$Ifdef GTK2}
function GetDefaultFontDesc(IncreaseReferenceCount: boolean): PPangoFontDescription;
{$Endif}
function GetDefaultGtkFont(IncreaseReferenceCount: boolean): TGtkIntfFont;
function GetGtkFont(DC: TDeviceContext): TGtkIntfFont;
function GetGtkFont(DC: TGtkDeviceContext): TGtkIntfFont;
function CreateRegionCopy(SrcRGN: hRGN): hRGN; override;
function DCClipRegionValid(DC: HDC): boolean; override;
function CreateEmptyRegion: hRGN; override;
@ -240,8 +234,6 @@ type
procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);virtual;
procedure RemoveCallbacks(Widget: PGtkWidget); virtual;
function ROP2ModeToGdkFunction(Mode: Integer): TGdkFunction;
function gdkFunctionToROP2Mode(const aFunction: TGdkFunction): Integer;
// for gtk specific components:
procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String

24
lcl/interfaces/gtk/gtklclintf.inc
View File

@ -42,8 +42,8 @@ var
IsDBCSFont: Boolean;
NewCount: Integer;
begin
UpdateDCTextMetric(TDeviceContext(DC));
IsDBCSFont:=TDeviceContext(DC).DCTextMetric.IsDoubleByteChar;
UpdateDCTextMetric(TGtkDeviceContext(DC));
IsDBCSFont:=TGtkDeviceContext(DC).DCTextMetric.IsDoubleByteChar;
if IsDBCSFont then begin
NewCount:=Count*2;
if FExtUTF8OutCacheSize<NewCount then begin
@ -63,8 +63,8 @@ var
IsDBCSFont: Boolean;
NewCount: Integer;
begin
UpdateDCTextMetric(TDeviceContext(DC));
IsDBCSFont:=TDeviceContext(DC).DCTextMetric.IsDoubleByteChar;
UpdateDCTextMetric(TGtkDeviceContext(DC));
IsDBCSFont:=TGtkDeviceContext(DC).DCTextMetric.IsDoubleByteChar;
if IsDBCSFont then begin
NewCount:=Count*2;
if FExtUTF8OutCacheSize<NewCount then begin
@ -407,7 +407,7 @@ end;
------------------------------------------------------------------------------}
function TGtkWidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescription): boolean;
var
DevCon: TDeviceContext absolute ADC;
DevCon: TGtkDeviceContext absolute ADC;
Drawable: PGdkDrawable;
UseAlpha: Boolean;
@ -511,7 +511,7 @@ end;
------------------------------------------------------------------------------}
function TGtkWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): boolean;
var
DevCon: TDeviceContext absolute ADC;
DevCtx: TGtkDeviceContext absolute ADC;
DCOrigin: TPoint;
R: TRect;
Drawable: PGdkDrawable;
@ -520,26 +520,24 @@ begin
if not IsValidDC(ADC)
then begin
DebugLn('WARNING: TGtkWidgetSet.GetRawImageFromDevice invalid SrcDC');
exit;
Exit(False);
end;
DCOrigin := GetDCOffset(TDeviceContext(ADC));
DCOrigin := DevCtx.Offset;
{$IFDEF VerboseRawImage}
DebugLn('TGtkWidgetSet.GetRawImageFromDevice A DCOrigin=',dbgs(DCOrigin.X),',',dbgs(DCOrigin.Y),' SrcRect=',dbgs(ARect.Left),',',dbgs(ARect.Top),',',dbgs(ARect.Right),',',dbgs(ARect.Bottom));
{$ENDIF}
R := ARect;
OffSetRect(R, DCOrigin.x, DCOrigin.y);
if DevCon.DCWidget <> nil
Drawable := DevCtx.Drawable;
if Drawable = nil
then begin
Drawable := DevCon.Drawable;
end
else begin
// get screen shot
{$IFDEF Gtk1}
exit;
{$ELSE}
Drawable := gdk_screen_get_root_window(gdk_screen_get_default);
Drawable := gdk_screen_get_root_window(gdk_screen_get_default);
{$ENDIF}
end;
Result := RawImage_FromDrawable(ARawImage, Drawable, nil, R);

184
lcl/interfaces/gtk/gtkproc.inc
View File

@ -966,16 +966,16 @@ end;
procedure FinalizePaintMessage(Msg: PLMessage);
var
PS : PPaintStruct;
DC : TDeviceContext;
DC : TGtkDeviceContext;
begin
if (Msg^.Msg=LM_PAINT) or (Msg^.Msg=LM_INTERNALPAINT) then begin
If Msg^.LParam <> 0 then begin
PS := PPaintStruct(Msg^.LParam);
If Msg^.WParam<>0 then
DC := TDeviceContext(Msg^.WParam)
DC := TGtkDeviceContext(Msg^.WParam)
else
DC := TDeviceContext(PS^.hdc);
EndPaint(THandle(PtrUInt(DC.DCWidget)), PS^);
DC := TGtkDeviceContext(PS^.hdc);
EndPaint(THandle(PtrUInt(DC.Widget)), PS^);
Dispose(PS);
Msg^.LParam:=0;
Msg^.WParam:=0;
@ -993,16 +993,16 @@ end;
procedure FinalizePaintTagMsg(Msg: PMsg);
var
PS : PPaintStruct;
DC : TDeviceContext;
DC : TGtkDeviceContext;
begin
if (Msg^.Message=LM_PAINT) or (Msg^.Message=LM_INTERNALPAINT) then begin
If Msg^.LParam <> 0 then begin
PS := PPaintStruct(Msg^.LParam);
If Msg^.WParam<>0 then
DC := TDeviceContext(Msg^.WParam)
DC := TGtkDeviceContext(Msg^.WParam)
else
DC := TDeviceContext(PS^.hdc);
EndPaint(THandle(PtrUInt(DC.DCWidget)), PS^);
DC := TGtkDeviceContext(PS^.hdc);
EndPaint(THandle(PtrUInt(DC.Widget)), PS^);
Dispose(PS);
Msg^.LParam:=0;
Msg^.WParam:=0;
@ -1047,7 +1047,7 @@ begin
end;
end;
procedure MergeClipping(DestinationDC: TDeviceContext; DestinationGC: PGDKGC;
procedure MergeClipping(DestinationDC: TGtkDeviceContext; DestinationGC: PGDKGC;
X, Y, Width, Height: integer; ClipMergeMask: PGdkPixmap;
ClipMergeMaskX, ClipMergeMaskY: integer;
var NewClipMask: PGdkPixmap);
@ -1069,7 +1069,7 @@ begin
{$ENDIF}
// activate clipping region of destination
SelectGDIRegion(HDC(DestinationDC));
DestinationDC.SelectRegion;
NewClipMask := nil;
if (ClipMergeMask = nil) then exit;
@ -1128,15 +1128,6 @@ begin
EndGDKErrorTrap;
end;
procedure ResetGCClipping(DC: HDC; GC: PGDKGC);
begin
BeginGDKErrorTrap;
gdk_gc_set_clip_mask(GC, nil);
gdk_gc_set_clip_origin (GC, 0,0);
SelectGDIRegion(DC);
EndGDKErrorTrap;
end;
function ScalePixmapAndMask(AScaleGC: PGDKGC; AScaleMethod: TGdkInterpType;
ASrc: PGdkPixmap; ASrcX, ASrcY, ASrcWidth, ASrcHeight: integer;
ASrcColorMap: PGdkColormap; ASrcMask: PGdkBitmap;
@ -1546,83 +1537,6 @@ begin
{$ENDIF}
end;
{------------------------------------------------------------------------------
Function: CopyDCData - used by RestoreDC and SaveDC
Params: DestinationDC: a dc to copy data to
SourceDC: a dc to copy data from
ClearSource: set true to make a move operation
MoveGDIOwnerShip: set true to pass the ownership of the GDI objects
to Destination
Returns: True if succesful
Creates a copy DC from the given DC
------------------------------------------------------------------------------}
function CopyDCData(SourceDC, DestinationDC: TDeviceContext;
ClearSource, MoveGDIOwnerShip: boolean): Boolean;
var
g: TGDIType;
CurGDIObject: PGDIObject;
begin
// Assert(False, Format('Trace:> [CopyDCData] DestDC:0x%x, SourceDC:0x%x', [Integer(DestinationDC), Integer(SourceDC)]));
Result := (DestinationDC <> nil) and (SourceDC <> nil);
if Result
then begin
with DestinationDC do
begin
DCWidget := SourceDC.DCWidget;
WithChildWindows := SourceDC.WithChildWindows;
Drawable := SourceDC.Drawable;
OriginalDrawable := SourceDC.OriginalDrawable;
if GC<>nil then begin
// free old GC
BeginGDKErrorTrap;
gdk_gc_unref(GC);
EndGDKErrorTrap;
GC:=nil;
DCFlags:=DCFlags-[dcfPenSelected];
end;
if (SourceDC.GC <> nil) and (Drawable <> nil) then begin
{$IFDEF DebugGDK} BeginGDKErrorTrap; {$ENDIF}
gdk_gc_get_values(SourceDC.GC, @GCValues);
GC := gdk_gc_new_with_values(Drawable, @GCValues, 3 { $3FF});
{$IFDEF DebugGDK} EndGDKErrorTrap; {$ENDIF}
DCFlags:=DCFlags-[dcfPenSelected];
end;
Origin := SourceDC.Origin;
SpecialOrigin := SourceDC.SpecialOrigin;
PenPos := SourceDC.PenPos;
if (dcfTextMetricsValid in SourceDC.DCFlags) then begin
Include(DCFlags,dcfTextMetricsValid);
DCTextMetric := SourceDC.DCTextMetric;
end else
Exclude(DCFlags,dcfTextMetricsValid);
for g:=Low(TGDIType) to High(TGDIType) do begin
GDIObjects[g]:=SourceDC.GDIObjects[g];
if ClearSource then
SourceDC.GDIObjects[g]:=nil;
if MoveGDIOwnerShip then begin
if OwnedGDIObjects[g]<>nil then begin
DeleteObject(HGDIOBJ(PtrUInt(OwnedGDIObjects[g])));
end;
CurGDIObject:=SourceDC.OwnedGDIObjects[g];
if CurGDIObject<>nil then begin
SourceDC.OwnedGDIObjects[g]:=nil;
OwnedGDIObjects[g]:=CurGDIObject;
end;
end;
end;
CopyGDIColor(SourceDC.CurrentTextColor,CurrentTextColor);
CopyGDIColor(SourceDC.CurrentBackColor,CurrentBackColor);
SelectedColors := dcscCustom;
SavedContext := nil;
end;
end;
// Assert(False, Format('Trace:< [CopyDCData] DestDC:0x%x, SourceDC:0x%x --> %d', [Integer(DestinationDC), Integer(SourceDC), Integer(Result)]));
end;
Function RegionType(RGN: PGDKRegion) : Longint;
var
@ -1651,34 +1565,6 @@ begin
{$ENDIF}
end;
{------------------------------------------------------------------------------
Procedure SelectGDIRegion(const DC: HDC);
Applies the current clipping region of the DC (DeviceContext) to the
gc (GDK Graphic context - pgdkGC)
------------------------------------------------------------------------------}
Procedure SelectGDIRegion(const DC: HDC);
var
RGNType : Longint;
begin
with TDeviceContext(DC) do
begin
{$IFDEF DebugGDK}
BeginGDKErrorTrap;
{$ENDIF}
gdk_gc_set_clip_region(GC, nil);
gdk_gc_set_clip_rectangle (GC, nil);
If (ClipRegion <> nil) then begin
RGNType := RegionType(ClipRegion^.GDIRegionObject);
If (RGNType <> ERROR) and (RGNType <> NULLREGION) then begin
gdk_gc_set_clip_region(GC, ClipRegion^.GDIRegionObject);
end;
end;
{$IFDEF DebugGDK}
EndGDKErrorTrap;
{$ENDIF}
end;
end;
function GDKRegionAsString(RGN: PGDKRegion): string;
var
@ -1745,7 +1631,7 @@ begin
Pixel := 0;
end;
{with TDeviceContext(DC) do
{with TGtkDeviceContext(DC) do
If CurrentPalette <> nil then
GDIColor.Colormap := CurrentPalette^.PaletteColormap
else}
@ -1763,7 +1649,7 @@ begin
Include(GDIColor.ColorFlags,cfColorAllocated);
end;
Procedure EnsureGCColor(DC: hDC; ColorType: TDevContextsColorType;
procedure EnsureGCColor(DC: hDC; ColorType: TDevContextsColorType;
IsSolidBrush, AsBackground: Boolean);
var
GC: PGDKGC;
@ -1780,14 +1666,14 @@ var
);
end;
Procedure EnsureAsGCValues;
procedure EnsureAsGCValues;
var
AllocFG : Boolean;
SysGCValues: TGdkGCValues;
begin
FreeGDIColor(GDIColor);
SysGCValues:=GetSysGCValues(GDIColor^.ColorRef,
TDeviceContext(DC).DCWidget);
TGtkDeviceContext(DC).Widget);
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
With SysGCValues do begin
gdk_gc_set_fill(GC, fill);
@ -1835,9 +1721,9 @@ var
end;
begin
GC:=TDeviceContext(DC).GC;
GC:=TGtkDeviceContext(DC).GC;
GDIColor:=nil;
with TDeviceContext(DC) do
with TGtkDeviceContext(DC) do
begin
case ColorType of
dccCurrentBackColor: GDIColor:=@CurrentBackColor;
@ -4115,42 +4001,6 @@ begin
RaiseGDBException('GetControlWindow Widget=nil');
end;
{------------------------------------------------------------------------------
function GetDCOffset(DC: TDeviceContext): TPoint;
Returns the DC offset for the DC Origin.
------------------------------------------------------------------------------}
function GetDCOffset(DC: TDeviceContext): TPoint;
var
Fixed : PGTKWIdget;
Adjustment: PGtkAdjustment;
begin
if (DC<>nil) then begin
Result:=DC.Origin;
{$Ifdef GTK2}
if (DC.DCWidget<>nil) and GTK_WIDGET_NO_WINDOW(DC.DCWidget)
and (not GtkWidgetIsA(DC.DCWidget,GTKAPIWidget_GetType))
then begin
Inc(Result.X, DC.DCWidget^.Allocation.x);
Inc(Result.y, DC.DCWidget^.Allocation.y);
end;
{$EndIf}
if (DC.SpecialOrigin) and (DC.DCWidget<>nil) then begin
Fixed := GetFixedWidget(DC.DCWidget);
if GtkWidgetIsA(Fixed,GTK_LAYOUT_GET_TYPE) then begin
Adjustment:=gtk_layout_get_hadjustment(PGtkLayout(Fixed));
if Adjustment<>nil then
dec(Result.X,TruncToInt(Adjustment^.Value-Adjustment^.Lower));
Adjustment:=gtk_layout_get_vadjustment(PGtkLayout(Fixed));
if Adjustment<>nil then
dec(Result.Y,TruncToInt(Adjustment^.Value-Adjustment^.Lower));
end;
end;
end else begin
Result.X:=0;
Result.Y:=0;
end;
end;
@ -9806,7 +9656,7 @@ begin
end;
function GetTextHeight(DCTextMetric: TDevContextTextMetric): integer;
// IMPORTANT: Before this call: UpdateDCTextMetric(TDeviceContext(DC));
// IMPORTANT: Before this call: UpdateDCTextMetric(TGtkDeviceContext(DC));
begin
{$IfDef Win32}
Result := DCTextMetric.TextMetric.tmHeight div 2;

9
lcl/interfaces/gtk/gtkproc.pp
View File

@ -401,14 +401,8 @@ function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;
procedure FinalizePaintMessage(Msg: PLMessage);
procedure FinalizePaintTagMsg(Msg: PMsg);
// DC
function GetDCOffset(DC: TDeviceContext): TPoint;
function CopyDCData(SourceDC, DestinationDC: TDeviceContext;
ClearSource, MoveGDIOwnerShip: boolean): Boolean;
// region
Function RegionType(RGN: PGDKRegion): Longint;
Procedure SelectGDIRegion(const DC: HDC);
function CreateRectGDKRegion(const ARect: TRect): PGDKRegion;
function GDKRegionAsString(RGN: PGDKRegion): string;
@ -662,11 +656,10 @@ function CreatePixbufFromDrawable(ASource: PGdkDrawable; AColorMap:PGdkColormap;
procedure GetGdkPixmapFromGraphic(AGraphic: TGraphic; out AImage: PGdkPixmap;
out AMask: PGdkBitmap; out AWidth, AHeight: Integer);
Procedure SetGCRasterOperation(TheGC: PGDKGC; Rop: Cardinal);
Procedure MergeClipping(DestinationDC: TDeviceContext; DestinationGC: PGDKGC;
Procedure MergeClipping(DestinationDC: TGtkDeviceContext; DestinationGC: PGDKGC;
X,Y,Width,Height: integer; ClipMergeMask: PGdkBitmap;
ClipMergeMaskX, ClipMergeMaskY: integer;
var NewClipMask: PGdkBitmap);
procedure ResetGCClipping(DC: HDC; GC: PGDKGC);
function ScalePixmapAndMask(AScaleGC: PGDKGC; AScaleMethod: TGdkInterpType;
ASrc: PGdkPixmap; ASrcX, ASrcY, ASrcWidth, ASrcHeight: integer;
ASrcColorMap: PGdkColormap; ASrcMask: PGdkBitmap;

315
lcl/interfaces/gtk/gtkthemes.pas
View File

@ -142,180 +142,179 @@ end;
function TGtkThemeServices.GetGtkStyleParams(DC: HDC;
Details: TThemedElementDetails; AIndex: Integer): TGtkStyleParams;
var
DevCtx: TGtkDeviceContext absolute DC;
ClientWidget: PGtkWidget;
begin
Result.Style := nil;
if GTKWidgetSet.IsValidDC(DC) then
with TDeviceContext(DC) do
begin
Result.Widget := DCWidget;
ClientWidget := GetFixedWidget(Result.Widget);
if ClientWidget <> nil then
Result.Widget := ClientWidget;
Result.Window := Drawable;
Result.Origin := GetDCOffset(TDeviceContext(DC));
Result.Style := gtk_widget_get_style(Result.Widget);
if Result.Style = nil then
Result.Style := gtk_widget_get_default_style();
if not GTKWidgetSet.IsValidDC(DC) then Exit;
Result.Widget := DevCtx.Widget;
ClientWidget := GetFixedWidget(Result.Widget);
if ClientWidget <> nil then
Result.Widget := ClientWidget;
Result.Window := DevCtx.Drawable;
Result.Origin := DevCtx.Offset;
Result.Style := gtk_widget_get_style(Result.Widget);
if Result.Style = nil then
Result.Style := gtk_widget_get_default_style();
Result.Painter := gptDefault;
Result.State := GTK_STATE_NORMAL;
Result.Detail := '';
Result.Shadow := GTK_SHADOW_NONE;
Result.ArrowType := GTK_ARROW_UP;
Result.Fill := False;
Result.IsHot := False;
Result.Painter := gptDefault;
Result.State := GTK_STATE_NORMAL;
Result.Detail := '';
Result.Shadow := GTK_SHADOW_NONE;
Result.ArrowType := GTK_ARROW_UP;
Result.Fill := False;
Result.IsHot := False;
case Details.Element of
teButton:
begin
case Details.Part of
BP_PUSHBUTTON:
begin
Result.Widget := GetStyleWidget(lgsButton);
Result.State := GtkButtonMap[Details.State];
if Details.State = PBS_PRESSED then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.IsHot:= Result.State = GTK_STATE_PRELIGHT;
case Details.Element of
teButton:
begin
case Details.Part of
BP_PUSHBUTTON:
begin
Result.Widget := GetStyleWidget(lgsButton);
Result.State := GtkButtonMap[Details.State];
if Details.State = PBS_PRESSED then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.IsHot:= Result.State = GTK_STATE_PRELIGHT;
Result.Detail := 'button';
Result.Detail := 'button';
Result.Painter := gptBox;
end;
BP_RADIOBUTTON:
begin
Result.Widget := GetStyleWidget(lgsRadiobutton);
Result.State := GtkRadioCheckBoxMap[Details.State];
if Details.State >= RBS_CHECKEDNORMAL then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.Detail := 'radiobutton';
Result.Painter := gptOption;
end;
BP_CHECKBOX:
begin
Result.Widget := GetStyleWidget(lgsCheckbox);
Result.State := GtkRadioCheckBoxMap[Details.State];
Result.Detail := 'checkbutton';
if Details.State >= CBS_MIXEDNORMAL then
result.Shadow := GTK_SHADOW_ETCHED_IN
else
if Details.State >= CBS_CHECKEDNORMAL then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.Painter := gptCheck;
end;
end;
end;
teHeader:
begin
Result.Widget := GetStyleWidget(lgsButton);
Result.State := GtkButtonMap[Details.State];
if Details.State = PBS_PRESSED then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.IsHot:= Result.State = GTK_STATE_PRELIGHT;
Result.Detail := 'button';
Result.Painter := gptBox;
end;
teToolBar:
begin
case Details.Part of
TP_BUTTON,
TP_DROPDOWNBUTTON,
TP_SPLITBUTTON,
TP_SPLITBUTTONDROPDOWN:
begin
if (Details.Part = TP_SPLITBUTTONDROPDOWN) and (AIndex = 1) then
begin
Result.Detail := 'arrow';
Result.ArrowType := GTK_ARROW_DOWN;
Result.Fill := True;
Result.Painter := gptArrow;
end
else
begin
Result.Widget := GetStyleWidget(lgsToolButton);
Result.State := GtkButtonMap[Details.State];
if Details.State in [TS_PRESSED, TS_CHECKED, TS_HOTCHECKED] then
Result.Shadow := GTK_SHADOW_IN
else
if Details.State in [TS_HOT] then
Result.Shadow := GTK_SHADOW_ETCHED_IN
else
Result.Shadow := GTK_SHADOW_NONE;
Result.IsHot := Details.State in [TS_HOT, TS_HOTCHECKED];
Result.Detail := 'button';
if Result.Shadow = GTK_SHADOW_NONE then
Result.Painter := gptNone
else
Result.Painter := gptBox;
end;
BP_RADIOBUTTON:
begin
Result.Widget := GetStyleWidget(lgsRadiobutton);
Result.State := GtkRadioCheckBoxMap[Details.State];
if Details.State >= RBS_CHECKEDNORMAL then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.Detail := 'radiobutton';
Result.Painter := gptOption;
end;
BP_CHECKBOX:
begin
Result.Widget := GetStyleWidget(lgsCheckbox);
Result.State := GtkRadioCheckBoxMap[Details.State];
Result.Detail := 'checkbutton';
if Details.State >= CBS_MIXEDNORMAL then
result.Shadow := GTK_SHADOW_ETCHED_IN
else
if Details.State >= CBS_CHECKEDNORMAL then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.Painter := gptCheck;
end;
end;
end;
end;
teHeader:
begin
Result.Widget := GetStyleWidget(lgsButton);
Result.State := GtkButtonMap[Details.State];
if Details.State = PBS_PRESSED then
Result.Shadow := GTK_SHADOW_IN
else
Result.Shadow := GTK_SHADOW_OUT;
Result.IsHot:= Result.State = GTK_STATE_PRELIGHT;
Result.Detail := 'button';
Result.Painter := gptBox;
end;
teToolBar:
begin
case Details.Part of
TP_BUTTON,
TP_DROPDOWNBUTTON,
TP_SPLITBUTTON,
TP_SPLITBUTTONDROPDOWN:
begin
if (Details.Part = TP_SPLITBUTTONDROPDOWN) and (AIndex = 1) then
begin
Result.Detail := 'arrow';
Result.ArrowType := GTK_ARROW_DOWN;
Result.Fill := True;
Result.Painter := gptArrow;
end
else
begin
Result.Widget := GetStyleWidget(lgsToolButton);
Result.State := GtkButtonMap[Details.State];
if Details.State in [TS_PRESSED, TS_CHECKED, TS_HOTCHECKED] then
Result.Shadow := GTK_SHADOW_IN
else
if Details.State in [TS_HOT] then
Result.Shadow := GTK_SHADOW_ETCHED_IN
else
Result.Shadow := GTK_SHADOW_NONE;
Result.IsHot := Details.State in [TS_HOT, TS_HOTCHECKED];
Result.Detail := 'button';
if Result.Shadow = GTK_SHADOW_NONE then
Result.Painter := gptNone
else
Result.Painter := gptBox;
end;
end;
TP_SEPARATOR,
TP_SEPARATORVERT:
begin
Result.State := GTK_STATE_NORMAL;
Result.Shadow := GTK_SHADOW_NONE;
Result.Detail := 'toolbar';
if Details.Part = TP_SEPARATOR then
Result.Painter := gptVLine
else
Result.Painter := gptHLine;
end;
TP_SEPARATOR,
TP_SEPARATORVERT:
begin
Result.State := GTK_STATE_NORMAL;
Result.Shadow := GTK_SHADOW_NONE;
Result.Detail := 'toolbar';
if Details.Part = TP_SEPARATOR then
Result.Painter := gptVLine
else
Result.Painter := gptHLine;
end;
end;
teRebar:
begin
case Details.Part of
RP_GRIPPER, RP_GRIPPERVERT:
begin
Result.State := GTK_STATE_NORMAL;
Result.Shadow := GTK_SHADOW_NONE;
end;
end;
teRebar:
begin
case Details.Part of
RP_GRIPPER, RP_GRIPPERVERT:
begin
Result.State := GTK_STATE_NORMAL;
Result.Shadow := GTK_SHADOW_NONE;
{ This code has problems with some (is not most) of gtk1 themes.
But at least Ubuntu >= 6.10 works fine. So it is commented out and switched
to alternate splitter painting}
But at least Ubuntu >= 6.10 works fine. So it is commented out and switched
to alternate splitter painting}
if Details.Part = RP_GRIPPER then
begin
Result.Detail := 'hpaned';
Result.Widget := GetStyleWidget(lgsHorizontalPaned);
end
else
begin
Result.Detail := 'vpaned';
Result.Widget := GetStyleWidget(lgsVerticalPaned);
end;
Result.Painter := gptBox;
if Details.Part = RP_GRIPPER then
begin
Result.Detail := 'hpaned';
Result.Widget := GetStyleWidget(lgsHorizontalPaned);
end
else
begin
Result.Detail := 'vpaned';
Result.Widget := GetStyleWidget(lgsVerticalPaned);
end;
Result.Painter := gptBox;
{ Result.Detail := 'paned';
Result.Painter := gptHandle;
if Details.Part = RP_GRIPPER then
Result.Orientation := GTK_ORIENTATION_VERTICAL
else
Result.Orientation := GTK_ORIENTATION_HORIZONTAL;}
end;
RP_BAND:
begin
Result.State := GtkButtonMap[Details.State];
Result.Shadow := GTK_SHADOW_NONE;
Result.Detail := 'paned';
Result.Painter := gptFlatBox;
end;
Result.Painter := gptHandle;
if Details.Part = RP_GRIPPER then
Result.Orientation := GTK_ORIENTATION_VERTICAL
else
Result.Orientation := GTK_ORIENTATION_HORIZONTAL;}
end;
end;
RP_BAND:
begin
Result.State := GtkButtonMap[Details.State];
Result.Shadow := GTK_SHADOW_NONE;
Result.Detail := 'paned';
Result.Painter := gptFlatBox;
end;
end;
end;
end;
end;
end;
function TGtkThemeServices.InitThemes: Boolean;

544
lcl/interfaces/gtk/gtkwidgetset.inc
View File

@ -178,8 +178,6 @@ begin
// DCs, GDIObjects
FDeviceContexts := TDynHashArray.Create(-1);
FDeviceContexts.Options:=FDeviceContexts.Options+[dhaoCacheContains];
CreateGCForDC:=@OnCreateGCForDC;
CreateGDIObjectForDC:=@OnCreateGDIObjectForDC;
FGDIObjects := TDynHashArray.Create(-1);
FGDIObjects.Options:=FGDIObjects.Options+[dhaoCacheContains];
@ -364,9 +362,6 @@ var
QueueItem : TGtkMessageQueueItem;
NextQueueItem : TGtkMessageQueueItem;
begin
CreateGCForDC:=nil;
CreateGDIObjectForDC:=nil;
ReAllocMem(FExtUTF8OutCache,0);
FExtUTF8OutCacheSize:=0;
@ -524,6 +519,7 @@ begin
FTimerData.Free;
GtkDefDone;
FreeAndNil(FDCManager);
// finally remove our loghandler
g_log_remove_handler(nil, FLogHandlerID);
@ -2453,8 +2449,8 @@ function TGtkWidgetSet.StretchCopyArea(DestDC: HDC; X, Y, Width, Height: Integer
Mask: HBITMAP; XMask, YMask: Integer;
Rop: Cardinal): Boolean;
var
SrcDevContext: TDeviceContext absolute SrcDC;
DstDevContext: TDeviceContext absolute DestDC;
SrcDevContext: TGtkDeviceContext absolute SrcDC;
DstDevContext: TGtkDeviceContext absolute DestDC;
TempPixmap: PGdkPixmap;
TempMaskBitmap: PGdkBitmap;
SizeChange, ROpIsSpecial: Boolean;
@ -2559,7 +2555,7 @@ var
{$IFDEF VerboseStretchCopyArea}
DebugLn('ROPFillBuffer ROp='+dbgs(ROp));
{$ENDIF}
with TDeviceContext(DC) do
with TGtkDeviceContext(DC) do
begin
// Temporarily hold the old brush to
// replace it with the given brush
@ -2570,15 +2566,13 @@ var
else
Brush := GetStockObject(BLACK_BRUSH);
CurrentBrush := PGdiObject(Brush);
SelectedColors := dcscCustom;
SelectGDKBrushProps(DC);
SelectedColors := dcscBrush;
if not IsNullBrush
then begin
gdk_draw_rectangle(TempPixmap, GC, 1, 0, 0, Width, Height);
end;
// Restore current brush
SelectedColors := dcscCustom;
CurrentBrush := OldCurrentBrush;
end;
end;
@ -2618,7 +2612,6 @@ var
{$ENDIF}
gdk_window_copy_area(DstDevContext.Drawable, DstDevContext.GC, X, Y,
SrcPixmap, XSrc, YSrc, Width, Height);
Exit;
end;
@ -2674,7 +2667,7 @@ var
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
// unset clipping mask for transparency
ResetGCClipping(DestDC, DstDevContext.GC);
DstDevContext.ResetGCClipping;
if ClipMask <> nil
then gdk_bitmap_unref(ClipMask);
@ -2700,42 +2693,12 @@ var
Result:=SrcDevBitmapToDrawable;
end;
function ImageToImage: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] ImageToImage unimplemented!');
Result:=false;
end;
function ImageToDrawable: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] ImageToDrawable unimplemented!');
Result:=false;
end;
function ImageToBitmap: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] ImageToBitmap unimplemented!');
Result:=false;
end;
function PixmapToImage: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] PixmapToImage unimplemented!');
Result:=false;
end;
function PixmapToBitmap: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] PixmapToBitmap unimplemented!');
Result:=false;
end;
function BitmapToImage: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] BitmapToImage unimplemented!');
Result:=false;
end;
function BitmapToPixmap: Boolean;
begin
DebugLn('WARNING: [TGtkWidgetSet.StretchCopyArea] BitmapToPixmap unimplemented!');
@ -2793,7 +2756,7 @@ var
procedure RaiseSrcDrawableNil;
begin
DebugLn(['RaiseSrcDrawableNil ',GetWidgetDebugReport(SrcDevContext.DCWidget)]);
DebugLn(['RaiseSrcDrawableNil ',GetWidgetDebugReport(SrcDevContext.Widget)]);
RaiseGDBException(Format('TGtkWidgetSet.StretchCopyArea SrcDC=%p Drawable=nil', [Pointer(SrcDevContext)]));
end;
@ -2823,30 +2786,25 @@ begin
SizeChange := (Width <> SrcWidth) or (Height <> SrcHeight);
ROpIsSpecial := (ROp <> SRCCOPY);
SrcDCOrigin := GetDCOffset(SrcDevContext);
with SrcDevContext do
begin
Inc(XSrc, SrcDCOrigin.X);
Inc(YSrc, SrcDCOrigin.Y);
if Drawable = nil then RaiseSrcDrawableNil;
gdk_window_get_size(PGdkWindow(Drawable), @SrcWholeWidth, @SrcWholeHeight);
end;
SrcDCOrigin := SrcDevContext.Offset;
Inc(XSrc, SrcDCOrigin.X);
Inc(YSrc, SrcDCOrigin.Y);
if SrcDevContext.Drawable = nil then RaiseSrcDrawableNil;
gdk_window_get_size(PGdkWindow(SrcDevContext.Drawable), @SrcWholeWidth, @SrcWholeHeight);
DstDCOrigin := GetDCOffset(DstDevContext);
with DstDevContext do
begin
Inc(X, DstDCOrigin.X);
Inc(Y, DstDCOrigin.Y);
if Drawable = nil then RaiseDestDrawableNil;
gdk_window_get_size(PGdkWindow(Drawable), @DstWholeWidth, @DstWholeHeight);
end;
DstDCOrigin := DstDevContext.Offset;
Inc(X, DstDCOrigin.X);
Inc(Y, DstDCOrigin.Y);
if DstDevContext.Drawable = nil then RaiseDestDrawableNil;
gdk_window_get_size(PGdkWindow(DstDevContext.Drawable), @DstWholeWidth, @DstWholeHeight);
{$IFDEF VerboseStretchCopyArea}
DebugLn('TGtkWidgetSet.StretchCopyArea BEFORE CLIPPING X='+dbgs(X),' Y='+dbgs(Y),' Width='+dbgs(Width),' Height='+dbgs(Height),
' XSrc='+dbgs(XSrc)+' YSrc='+dbgs(YSrc)+' SrcWidth='+dbgs(SrcWidth)+' SrcHeight='+dbgs(SrcHeight),
' SrcDrawable=',DbgS(TDeviceContext(SrcDC).Drawable),
' SrcDrawable=',DbgS(TGtkDeviceContext(SrcDC).Drawable),
' SrcOrigin='+dbgs(SrcDCOrigin),
' DestDrawable='+DbgS(TDeviceContext(DestDC).Drawable),
' DestDrawable='+DbgS(TGtkDeviceContext(DestDC).Drawable),
' DestOrigin='+dbgs(DestDCOrigin),
' Mask='+DbgS(Mask)+' XMask='+dbgs(XMask)+' YMask='+dbgs(YMask),
' SizeChange='+dbgs(SizeChange)+' ROpIsSpecial='+dbgs(ROpIsSpecial),
@ -2958,6 +2916,7 @@ begin
end;
{$ENDIF}
{$note tode remove, earlier checks require drawable <> nil}
if SrcDevContext.Drawable = nil
then begin
if DstDevContext.Drawable = nil
@ -5338,22 +5297,21 @@ end;
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor);
var
aDC : TDeviceContext;
DC : TGtkDeviceContext absolute CanvasHandle;
DCOrigin: TPoint;
GDKColor: TGDKColor;
begin
aDC := TDeviceContext(CanvasHandle);
if (aDC = nil) or (aDC.Drawable = nil) then exit;
if (DC = nil) or (DC.Drawable = nil) then exit;
DCOrigin:=GetDCOffset(aDC);
DCOrigin := DC.Offset;
inc(X,DCOrigin.X);
inc(Y,DCOrigin.Y);
aDC.SelectedColors := dcscCustom;
GDKColor:=AllocGDKColor(AColor);
gdk_gc_set_foreground(aDC.GC, @GDKColor);
DC.SelectedColors := dcscCustom;
GDKColor := AllocGDKColor(AColor);
gdk_gc_set_foreground(DC.GC, @GDKColor);
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_draw_point(aDC.Drawable, aDC.GC, X, Y);
gdk_draw_point(DC.Drawable, DC.GC, X, Y);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
@ -5395,7 +5353,7 @@ end;
------------------------------------------------------------------------------}
function TGtkWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor;
var
aDC : TDeviceContext;
DC : TGtkDeviceContext absolute CanvasHandle;
Image : pGDKImage;
GDKColor: TGDKColor;
Colormap : PGDKColormap;
@ -5404,30 +5362,29 @@ var
Pixel: LongWord;
begin
Result := clNone;
aDC := TDeviceContext(CanvasHandle);
if (aDC = nil) or (aDC.Drawable = nil) then exit;
if (DC = nil) or (DC.Drawable = nil) then Exit;
DCOrigin:=GetDCOffset(TDeviceContext(aDC));
DCOrigin := DC.Offset;
inc(X,DCOrigin.X);
inc(Y,DCOrigin.Y);
gdk_drawable_get_size(aDC.Drawable, @MaxX, @MaxY);
gdk_drawable_get_size(DC.Drawable, @MaxX, @MaxY);
if (X<0) or (Y<0) or (X>=MaxX) or (Y>=MaxY) then exit;
Image := gdk_drawable_get_image(aDC.Drawable,X,Y,1,1);
Image := gdk_drawable_get_image(DC.Drawable,X,Y,1,1);
if Image = nil then exit;
{$ifdef Gtk1}
// previously gdk_image_get_colormap(image) was used, implementation
// was casting GdkImage to GdkWindow which is not valid and cause AVs
if gdk_window_get_type(PGdkWindow(aDC.Drawable))= GDK_WINDOW_PIXMAP then
if gdk_window_get_type(PGdkWindow(DC.Drawable))= GDK_WINDOW_PIXMAP then
colormap := nil // pixmaps are created with null colormap, get system one instead
else
colormap := gdk_window_get_colormap(PGdkWindow(aDC.Drawable));
colormap := gdk_window_get_colormap(PGdkWindow(DC.Drawable));
{$else}
colormap := gdk_image_get_colormap(image);
if colormap = nil then
colormap := gdk_drawable_get_colormap(aDC.Drawable);
colormap := gdk_drawable_get_colormap(DC.Drawable);
{$endif}
@ -5435,7 +5392,7 @@ begin
colormap := gdk_colormap_get_system;
Pixel:=gdk_image_get_pixel(Image,0,0);
FillChar(GDKColor,SizeOf(GDKColor),0);
FillChar(GDKColor, SizeOf(GDKColor),0);
// does not work with TBitmap.Canvas
gdk_colormap_query_color(colormap, Pixel, @GDKColor);
@ -5494,130 +5451,7 @@ begin
and (PGdiObject(GDIObject)^.GDIType = GDIType);
end;
{------------------------------------------------------------------------------
Procedure: TGtkWidgetSet.SelectGDKBrushProps
Params: DC: a (LCL)devicecontext
Returns: Nothing
Sets the forecolor and fill according to the brush
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SelectGDKBrushProps(DC: HDC);
var
DevCon: TDeviceContext absolute DC;
begin
if (DevCon.SelectedColors=dcscBrush) or DevCon.IsNullBrush
then
exit;
with DevCon do
begin
//DebugLn('TGtkWidgetSet.SelectGDKBrushProps Setting BKColor ...');
EnsureGCColor(DC, dccCurrentBackColor, True, True);//BKColor
//DebugLn('TGtkWidgetSet.SelectGDKBrushProps Setting Brush Color ...');
EnsureGCColor(DC, dccGDIBrushColor, GetBrush^.GDIBrushFill = GDK_Solid, False);//Brush Color
if GetBrush^.GDIBrushFill <> GDK_Solid then
if GetBrush^.GDIBrushPixmap <> nil then
begin
gdk_gc_set_fill(GC, GetBrush^.GDIBrushFill);
if GetBrush^.GDIBrushFill = GDK_STIPPLED then
gdk_gc_set_stipple(GC, GetBrush^.GDIBrushPixmap)
else
gdk_gc_set_tile(GC, GetBrush^.GDIBrushPixmap);
gdk_gc_get_values(GC, @GCValues);
end
end;
DevCon.SelectedColors := dcscBrush;
end;
{------------------------------------------------------------------------------
Procedure: TGtkWidgetSet.SelectGDKTextProps
Params: DC: a (LCL)devicecontext
Returns: Nothing
Sets the forecolor and fill according to the Textcolor
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SelectGDKTextProps(DC: HDC);
begin
if TDeviceContext(DC).SelectedColors=dcscFont then exit;
with TDeviceContext(DC) do
begin
EnsureGCColor(DC, dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(DC, dccCurrentTextColor, False, False);//Font Color
end;
TDeviceContext(DC).SelectedColors:=dcscFont;
end;
{------------------------------------------------------------------------------
Procedure: TGtkWidgetSet.TGtkWidgetSet.SelectGDKPenProps
Params: DC: a (LCL)devicecontext
Returns: Nothing
Sets the forecolor and fill according to the pen
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.SelectGDKPenProps(DC: HDC);
const
{$ifdef windows}
OS_multiplier = 1;
{$else}
OS_multiplier = 3;
{$endif}
var
DevCon: TDeviceContext absolute DC;
procedure SetDashes(const Dashes: array of gint8);
begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
laz_gdk_gc_set_dashes(DevCon.GC,0,Pgint8(@Dashes[Low(Dashes)]),
High(Dashes)-Low(Dashes)+1);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
begin
if DevCon.SelectedColors<>dcscPen
then begin
EnsureGCColor(DC, dccCurrentBackColor, True, True);//BKColor
EnsureGCColor(DC, dccGDIPenColor, False, False);//Pen Color
DevCon.SelectedColors:=dcscPen;
end;
if dcfPenSelected in Devcon.DCFlags then Exit;
Exclude(DevCon.DCFlags,dcfPenInvalid);
if DevCon.GC = nil then Exit;
with DevCon, GetPen^ do
begin
IsNullPen := GDIPenStyle = PS_NULL;
if (GDIPenStyle = PS_SOLID) or (GDIPenStyle = PS_INSIDEFRAME)
then begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, GDIPenWidth, GDK_LINE_SOLID, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end
else begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
gdk_gc_set_line_attributes(GC, GDIPenWidth, GDK_LINE_ON_OFF_DASH, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
// Paul Ishenin: I comparet patterns with windows and changed numbers to make them the same
// but under linux dot is thinner than in windows, so I added os_multiplier to make them the same
// in resulting image
case GDIPenStyle of
PS_DASH: SetDashes([6*OS_multiplier,2*OS_multiplier]);
PS_DOT: SetDashes([1*OS_multiplier,1*OS_multiplier]);
PS_DASHDOT: SetDashes([3*OS_multiplier,2*OS_multiplier,1*OS_multiplier,2*OS_multiplier]);
PS_DASHDOTDOT: SetDashes([3*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier]);
//This is DEADLY!!!
//PS_NULL: gdk_gc_set_dashes(GC, 0, [0,4], 2);
end;
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;
gdk_gc_get_values(GC,@GCValues);
end;
Include(DevCon.DCFlags,dcfPenSelected);
end;
{------------------------------------------------------------------------------
Function: NewDC
@ -5628,11 +5462,22 @@ end;
Used internally by: CreateCompatibleDC, CreateDCForWidget and SaveDC
------------------------------------------------------------------------------}
function TGtkWidgetSet.NewDC: TDeviceContext;
function TGtkWidgetSet.NewDC: TGtkDeviceContext;
begin
Assert(False, Format('Trace:> [TGtkWidgetSet.NewDC]', []));
Result:=NewDeviceContext;
if FDCManager = nil
then begin
FDCManager := TDeviceContextMemManager.Create(GetDeviceContextClass);
FDCManager.MinimumFreeCount := 1000;
end;
Result := FDCManager.NewDeviceContext;
{$IFDEF DebugLCLComponents}
DebugDeviceContexts.MarkCreated(Result,'TGtkWidgetSet.NewDC');
{$ENDIF}
FDeviceContexts.Add(Result);
{$ifdef TraceGdiCalls}
FillStackAddrs(get_caller_frame(get_frame), @Result.StackAddrs);
{$endif}
@ -5641,10 +5486,10 @@ begin
end;
function TGTKWidgetSet.FindDCWithGDIObject(GDIObject: PGdiObject
): TDeviceContext;
): TGtkDeviceContext;
var
HashItem: PDynHashArrayItem;
DC: TDeviceContext;
DC: TGtkDeviceContext;
g: TGDIType;
Cnt: Integer;
begin
@ -5653,7 +5498,7 @@ begin
HashItem:=FDeviceContexts.FirstHashItem;
Cnt:=0;
while HashItem<>nil do begin
DC:=TDeviceContext(HashItem^.Item);
DC:=TGtkDeviceContext(HashItem^.Item);
for g:=Low(TGDIType) to High(TGDIType) do
if DC.GDIObjects[g]=GdiObject then exit(DC);
inc(Cnt);
@ -5668,12 +5513,16 @@ end;
Disposes a DC
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.DisposeDC(aDC: TDeviceContext);
procedure TGtkWidgetSet.DisposeDC(aDC: TGtkDeviceContext);
begin
if FDeviceContexts.Contains(aDC) then begin
FDeviceContexts.Remove(aDC);
GtkDef.DisposeDeviceContext(aDC);
end;
if not FDeviceContexts.Contains(aDC) then Exit;
FDeviceContexts.Remove(aDC);
{$IFDEF DebugLCLComponents}
DebugDeviceContexts.MarkDestroyed(ADC);
{$ENDIF}
FDCManager.DisposeDeviceContext(ADC);
end;
{------------------------------------------------------------------------------
@ -5682,194 +5531,15 @@ end;
Creates an initial DC
------------------------------------------------------------------------------}
function TGtkWidgetSet.CreateDCForWidget(TheWidget: PGtkWidget;
TheWindow: PGdkWindow; WithChildWindows: boolean): HDC;
procedure RaiseWidgetWithoutClientArea;
begin
RaiseGDBException('TGtkWidgetSet.CreateWindowDC widget '
+DbgS(TheWidget)+' has no client area');
end;
procedure WriteWidgetNotRealized(aWidget: PGtkWidget);
begin
{DebugLn(['NOTE: TGtkWidgetSet.CreateDCForWidget: ',
'creating a DC for a widget, which has not been realized yet: ',
GetWidgetDebugReport(aWidget),'. ',
'This means normally you do a visual operation on a control, that is not yet on any screen. ',
'Forcing .... ']);}
//DumpStack;
end;
function TGtkWidgetSet.CreateDCForWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
AWithChildWindows: Boolean; ADoubleBuffer: PGdkDrawable): HDC;
var
aDC: TDeviceContext;
ClientWidget: PGtkWidget;
DC: TGtkDeviceContext absolute Result;
begin
aDC := nil;
aDC := NewDC;
aDC.WithChildWindows := WithChildWindows;
aDC.DCWidget := TheWidget;
ClientWidget := nil;
if TheWidget = nil
then begin
// screen: ToDo: multiple desktops
end
else begin
// create a new devicecontext for this window
if TheWindow=nil then begin
ClientWidget := GetFixedWidget(TheWidget);
if ClientWidget = nil then RaiseWidgetWithoutClientArea;
TheWindow:=GetControlWindow(ClientWidget);
if TheWindow=nil then begin
//force creation
if not GTK_WIDGET_REALIZED(ClientWidget) then
WriteWidgetNotRealized(ClientWidget);
gtk_widget_realize(ClientWidget);
TheWindow := GetControlWindow(ClientWidget);
if TheWindow=nil then
RaiseGDBException('TGtkWidgetSet.CreateDCForWidget: Unable to realize GdkWindow');
end;
end else
ClientWidget:=TheWidget;
aDC.SpecialOrigin:=GtkWidgetIsA(ClientWidget,GTK_LAYOUT_GET_TYPE);
aDC.Drawable := TheWindow;
{$IFDEF Gtk1}
{$note todo: check if this is still needed} // now gc is a property
aDC.GC;
{$ELSE}
// GC is created on demand
{$ENDIF}
end;
with aDC do
begin
gdk_color_black(gdk_colormap_get_system, @CurrentTextColor.Color);
BuildColorRefFromGDKColor(CurrentTextColor);
gdk_color_white(gdk_colormap_get_system, @CurrentBackColor.Color);
BuildColorRefFromGDKColor(CurrentBackColor);
end;
{$Ifdef GTK1}
aDC.GetFont;
aDC.GetBrush;
aDC.GetPen;
{$ELSE}
// font, brush, pen are created on demand
{$EndIf}
Result := HDC(aDC);
Assert(False, Format('trace:< [TGtkWidgetSet.CreateDCForWidget] Got 0x%x', [Result]));
end;
procedure TGTKWidgetSet.OnCreateGCForDC(DC: TDeviceContext);
{$IFDEF Gtk1}
var
CurWidget: PGtkWidget;
CurWindow: PGdkWindow;
{$ENDIF}
begin
if DC.HasGC
then begin
debugLN('[WARNING] OnCreateGCForDC called while GC exists');
Exit;
end;
// create GC
if DC.Drawable<>nil then begin
if DC.WithChildWindows then begin
FillChar(DC.GCValues, SizeOf(DC.GCValues), #0);
DC.GCValues.subwindow_mode := GDK_INCLUDE_INFERIORS;
DC.GC:=gdk_gc_new_with_values(DC.Drawable,
@DC.GCValues,GDK_GC_FUNCTION or GDK_GC_SUBWINDOW);
end else begin
DC.GC:=gdk_gc_new(DC.Drawable);
end;
end else begin
// create default GC
{$IFDEF Gtk1}
CurWidget:=GetStyleWidget(lgsWindow);
CurWindow:=CurWidget^.window;
DC.GC:=gdk_gc_new(CurWindow);
{$ELSE}
DC.GC:=gdk_gc_new(gdk_screen_get_root_window(gdk_screen_get_default));
{$ENDIF}
end;
if DC.HasGC
then begin
gdk_gc_set_function(DC.GC, GDK_COPY);
gdk_gc_get_values(DC.GC, @DC.GCValues);
end;
end;
procedure TGTKWidgetSet.OnCreateGDIObjectForDC(DC: TDeviceContext;
aGDIType: TGDIType);
begin
case aGDIType of
gdiFont: OnCreateFontForDC(DC);
gdiBrush: OnCreateBrushForDC(DC);
gdiPen: OnCreatePenForDC(DC);
gdiBitmap: OnCreateGDIBitmapForDC(DC);
else RaiseGDBException('TGTKWidgetSet.OnCreateGDIObjectForDC');
end;
end;
procedure TGTKWidgetSet.OnCreateFontForDC(DC: TDeviceContext);
{$IFDEF Gtk2}
var
ClientWidget: PGtkWidget;
{$ENDIF}
begin
if DC.CurrentFont<>nil then exit;
// create font
{$IFDEF Gtk1}
if DC.GCValues.Font <> nil then begin
DC.CurrentFont:=NewGDIObject(gdiFont);
DC.CurrentFont^.GDIFontObject := DC.GCValues.Font;
FontCache.Reference(DC.CurrentFont^.GDIFontObject);
end else
DC.CurrentFont:=CreateDefaultFont;
{$ELSE}
if DC.DCWidget<>nil then begin
ClientWidget:=GetFixedWidget(DC.DCWidget);
//DebugLn(['TGTKWidgetSet.OnCreateFontForDC ClientWidget=',GetWidgetDebugReport(ClientWidget)]);
DC.CurrentFont:=NewGDIObject(gdiFont);
DC.CurrentFont^.GDIFontObject:=
gtk_widget_create_pango_layout(ClientWidget,nil);
if FontCache.FindGTKFont(GetGtkFont(DC))<>nil then
RaiseGDBException('inconsistency: font already in cache, maybe freed, but not removed from cache');
FontCache.AddWithoutName(DC.CurrentFont^.GDIFontObject);
if FontCache.FindGTKFont(GetGtkFont(DC))=nil then
RaiseGDBException('inconsistency: font added to cache, but can not be found');
end else
DC.CurrentFont:=CreateDefaultFont;
//DebugLn(['TGTKWidgetSet.OnCreateFontForDC DC=',dbghex(PtrInt(DC)),' Font=',dbghex(PtrInt(DC.CurrentFont)),' DC.DCWidget=',GetWidgetDebugReport(DC.DCWidget)]);
{$ENDIF}
DC.OwnedGDIObjects[gdiFont]:=DC.CurrentFont;
end;
procedure TGTKWidgetSet.OnCreateBrushForDC(DC: TDeviceContext);
begin
if DC.CurrentBrush<>nil then exit;
DC.CurrentBrush := CreateDefaultBrush;
DC.OwnedGDIObjects[gdiBrush]:=DC.CurrentBrush;
end;
procedure TGTKWidgetSet.OnCreatePenForDC(DC: TDeviceContext);
begin
if DC.CurrentPen<>nil then exit;
DC.CurrentPen := CreateDefaultPen;
DC.OwnedGDIObjects[gdiPen]:=DC.CurrentPen;
end;
procedure TGTKWidgetSet.OnCreateGDIBitmapForDC(DC: TDeviceContext);
begin
if DC.CurrentBitmap<>nil then exit;
DC.CurrentBitmap := CreateDefaultGDIBitmap;
DC.OwnedGDIObjects[gdiBitmap]:=DC.CurrentBitmap;
DC := NewDC;
DC.SetWidget(AWidget, AWindow, AWithChildWindows, ADoubleBuffer);
end;
{------------------------------------------------------------------------------
@ -5884,7 +5554,7 @@ var
BufferWidth, BufferHeight: integer;
DoubleBuffer: PGdkPixmap;
BufferCreated: Boolean;
DevContext: TDeviceContext absolute Result;
DevContext: TGtkDeviceContext absolute Result;
CaretWasVisible: Boolean;
MainWidget: PGtkWidget;
GC: PGdkGC;
@ -5930,17 +5600,16 @@ begin
' Width=',Width,' Height=',Height);
{$ENDIF}
DoubleBuffer:=gdk_pixmap_new(AWindow,Width,Height,-1);
WidgetInfo^.DoubleBuffer:=DoubleBuffer;
WidgetInfo^.DoubleBuffer := DoubleBuffer;
BufferCreated:=true;
end;
// create DC for double buffer
Result:=CreateDCForWidget(Widget,PGDKWindow(DoubleBuffer),false);
Result := CreateDCForWidget(Widget, Widget^.Window, False, DoubleBuffer);
DevContext.OriginalDrawable:=Widget^.Window;
Include(DevContext.DCFlags,dcfDoubleBuffer);
if BufferCreated then begin
if BufferCreated
then begin
// create GC
GC:=DevContext.GC;
// copy old context to buffer
@ -6077,11 +5746,11 @@ begin
end;
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.UpdateDCTextMetric(DC: TDeviceContext);
procedure TGtkWidgetSet.UpdateDCTextMetric(DC: TGtkDeviceContext);
Sets the gtk resource file and parses it.
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.UpdateDCTextMetric(DC: TDeviceContext);
procedure TGtkWidgetSet.UpdateDCTextMetric(DC: TGtkDeviceContext);
const
TestString: array[boolean] of string = (
// single byte char font
@ -6108,12 +5777,12 @@ var
aRect: TPangoRectangle;
{$ENDIF}
begin
with TDeviceContext(DC) do begin
if dcfTextMetricsValid in DCFlags then begin
with TGtkDeviceContext(DC) do begin
if dcfTextMetricsValid in Flags then begin
// cache valid
exit;
end;
UseFont:=GetGtkFont(TDeviceContext(DC));
UseFont:=GetGtkFont(TGtkDeviceContext(DC));
FillChar(DCTextMetric, SizeOf(DCTextMetric), 0);
CachedFont:=FontCache.FindGTKFont(UseFont);
if (CachedFont=nil) and (UseFont <> GetDefaultGtkFont(false)) then begin
@ -6165,7 +5834,7 @@ begin
TextMetric.tmMaxCharWidth:=TextMetric.tmAveCharWidth;
{$ELSE Gtk2}
// get pango context (= association to a widget)
AWidget:=DCWidget;
AWidget:=Widget;
if AWidget=nil then
AWidget:=GetStyleWidget(lgsLabel);
APangoContext := gtk_widget_get_pango_context(AWidget);
@ -6236,7 +5905,7 @@ begin
CachedFont.MetricsValid:=true;
end;
end;
Include(DCFlags,dcfTextMetricsValid);
Include(Flags,dcfTextMetricsValid);
end;
end;
@ -6277,7 +5946,7 @@ begin
ReferenceGtkIntfFont(Result); // mark again
end;
function TGTKWidgetSet.GetGtkFont(DC: TDeviceContext): TGtkIntfFont;
function TGTKWidgetSet.GetGtkFont(DC: TGtkDeviceContext): TGtkIntfFont;
begin
{$IFDEF Gtk}
if (DC.CurrentFont = nil) or (DC.CurrentFont^.GDIFontObject = nil)
@ -6308,7 +5977,7 @@ var
begin
Result:=false;
if not IsValidDC(DC) then exit;
CurClipRegion:=HRGN(PtrUInt(TDeviceContext(DC).ClipRegion));
CurClipRegion:=HRGN(PtrUInt(TGtkDeviceContext(DC).ClipRegion));
if (CurClipRegion<>0) and (not IsValidGDIObject(CurClipRegion)) then exit;
Result:=true;
end;
@ -6589,7 +6258,7 @@ var
procedure InitFont;
begin
UseFont:=GetGtkFont(TDeviceContext(DC));
UseFont:=GetGtkFont(TGtkDeviceContext(DC));
end;
var
@ -6668,53 +6337,6 @@ begin
LinesList.Free;
end;
function TGtkWidgetSet.ROP2ModeToGdkFunction(Mode: Integer): TGdkFunction;
begin
case Mode of
R2_COPYPEN: result := GDK_COPY;
R2_NOT: result := GDK_INVERT;
R2_XORPEN: result := GDK_XOR;
R2_BLACK: result := GDK_CLEAR;
R2_MASKPEN: result := GDK_AND;
R2_MASKPENNOT: result := GDK_AND_REVERSE;
R2_MASKNOTPEN: result := GDK_AND_INVERT;
R2_NOP: result := GDK_NOOP;
R2_MERGEPEN: result := GDK_OR;
R2_NOTXORPEN: result := GDK_EQUIV;
R2_MERGEPENNOT: result := GDK_OR_REVERSE;
R2_NOTCOPYPEN: result := GDK_COPY_INVERT;
R2_NOTMASKPEN: result := GDK_NAND;
//R2_NOTMERGEPEN: result := GDK_NOR;
R2_WHITE: result := GDK_SET;
else
result := GDK_COPY;
end;
end;
function TGtkWidgetSet.GdkFunctionToROP2Mode(const aFunction: TGdkFunction
): Integer;
begin
case aFunction of
GDK_COPY: result := R2_COPYPEN;
GDK_INVERT: result := R2_NOT;
GDK_XOR: result := R2_XORPEN;
GDK_CLEAR: result := R2_BLACK;
GDK_AND: result := R2_MASKPEN;
GDK_AND_REVERSE: result := R2_MASKPENNOT;
GDK_AND_INVERT: result := R2_MASKNOTPEN;
GDK_NOOP: result := R2_NOP;
GDK_OR: result := R2_MERGEPEN;
GDK_EQUIV: result := R2_NOTXORPEN;
GDK_OR_REVERSE: result := R2_MERGEPENNOT;
GDK_COPY_INVERT: result := R2_NOTCOPYPEN;
GDK_NAND: result := R2_NOTMASKPEN;
//GDK_NOR: result := R2_NOTMERGEPEN;
GDK_SET: result := R2_WHITE;
else
result := R2_COPYPEN;
end;
end;
function TGtkWidgetSet.ForceLineBreaks(DC: hDC; Src: PChar;
MaxWidthInPixels: Longint;
ConvertAmpersandsToUnderScores: Boolean) : PChar;

1833
lcl/interfaces/gtk/gtkwinapi.inc
View File

File diff suppressed because it is too large Load Diff

2
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -199,7 +199,7 @@ Function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;
function SetROP2(DC: HDC; Mode: Integer): Integer; override;
function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;
function SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): Boolean; override;
Function SetTextCharacterExtra(_hdc : hdc; nCharExtra : Integer):Integer; override;
Function SetTextCharacterExtra(DC : hdc; nCharExtra : Integer):Integer; override;
function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; override;
function SetWindowLong(Handle: HWND; Idx: Integer; NewLong: PtrInt): PtrInt; override;
function SetWindowOrgEx(dc : hdc; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; override;

6
lcl/interfaces/gtk/gtkwsextctrls.pp
View File

@ -521,7 +521,7 @@ var
Area: TGdkRectangle;
Style: PGtkStyle;
AWindow: PGdkWindow;
DevContext: TDeviceContext;
DevContext: TGtkDeviceContext;
ARect: TRect;
{$IFDEF Gtk1}
Detail: PChar;
@ -530,7 +530,7 @@ var
{$ENDIF}
begin
if not ASplitter.HandleAllocated then exit;
DevContext:=TDeviceContext(ASplitter.Canvas.Handle);
DevContext:=TGtkDeviceContext(ASplitter.Canvas.Handle);
Widget:=PGtkWidget(ASplitter.Handle);
ClientWidget:=GetFixedWidget(Widget);
if ClientWidget<>nil then
@ -541,7 +541,7 @@ begin
if Style = nil then
Style:=GetStyle(lgsButton);
DCOrigin:=GetDCOffset(DevContext);
DCOrigin := DevContext.Offset;
Area.X:=DCOrigin.X;
Area.Y:=DCOrigin.Y;
Area.Width:=ASplitter.Width;

55
lcl/interfaces/gtk2/gtk2def.pp Normal file
View File

@ -0,0 +1,55 @@
{ $Id$
-------------------------------
gtk2def.pp - Type definitions
-------------------------------
@created(Tue Nov 20st WET 2007)
@lastmod($Date$)
@author(Marc Weustink <marc@@dommelstein.net>)
This unit contains type definitions needed in the GTK2 <-> LCL interface
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
unit Gtk2Def;
{$mode objfpc} {$H+}
interface
uses
glib2, gdk2pixbuf, pango, gdk2, gtk2,
// Classes, SysUtils, LCLIntf, LCLProc, LCLType, DynHashArray,
// GraphType, GtkExtra,
GtkDef;
type
{ TGtk2DeviceContext }
TGtk2DeviceContext = class(TGtkDeviceContext)
private
protected
function GetFunction: TGdkFunction; override;
public
end;
implementation
{$i gtk2devicecontext.inc}
end.

34
lcl/interfaces/gtk2/gtk2devicecontext.inc Normal file
View File

@ -0,0 +1,34 @@
{%MainUnit gtk2def.pp}
{******************************************************************************
TGtk2DeviceContext
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
{ TGtk2DeviceContext }
function TGtk2DeviceContext.GetFunction: TGdkFunction;
begin
Result := GCValues._function;
end;

3
lcl/interfaces/gtk2/gtk2int.pas
View File

@ -48,7 +48,7 @@ uses
GTKWinApiWindow, StdCtrls, ComCtrls,
Dialogs, ExtDlgs, Themes, LResources, Math, GTKGlobals,
{Buttons, CListBox, Calendar, Arrow, Spin, FileCtrl, CommCtrl, ExtCtrls, }
gtkDef, gtkFontCache, gtkInt, GtkExtra;
GtkDef, Gtk2Def, GtkFontCache, GtkInt, GtkExtra;
type
@ -81,6 +81,7 @@ type
PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget); override;
function CreateThemeServices: TThemeServices; override;
function GetDeviceContextClass: TGtkDeviceContextClass; override;
public
constructor Create;
destructor Destroy; override;

6
lcl/interfaces/gtk2/gtk2widgetset.inc
View File

@ -298,6 +298,8 @@ begin
end;
{$EndIf}
{ TGtk2WidgetSet }
{------------------------------------------------------------------------------
procedure TGtk2WidgetSet.AppendText(Sender: TObject; Str: PChar);
------------------------------------------------------------------------------}
@ -327,6 +329,10 @@ begin
end;
end;
function TGtk2WidgetSet.GetDeviceContextClass: TGtkDeviceContextClass;
begin
Result := TGtk2DeviceContext;
end;
function TGtk2WidgetSet.GetText(Sender: TComponent; var Text: String): Boolean;
var

235
lcl/interfaces/gtk2/gtk2winapi.inc
View File

@ -35,32 +35,35 @@
//##apiwiz##sps## // Do not remove
function TGtk2WidgetSet.BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc;
function TGtk2WidgetSet.BeginPaint(Handle: hWnd; var PS : TPaintStruct) : hdc;
var
paintrect : TGDKRectangle;
Control: TWinControl;
begin
result := Inherited BeginPaint(Handle, PS);
result := inherited BeginPaint(Handle, PS);
if Handle <> 0 then Control := TWinControl(GetLCLObject(Pointer(Handle)))
if Handle <> 0
then Control := TWinControl(GetLCLObject(Pointer(Handle)))
else Control := nil;
If (Control <> nil) and (not GTK_WIDGET_DOUBLE_BUFFERED((PGTKWidget(Handle))))
and (Control.DoubleBuffered)
if (Control <> nil)
and Control.DoubleBuffered
and not GTK_WIDGET_DOUBLE_BUFFERED(PGTKWidget(Handle))
then begin
//DebugLn(['TGtk2WidgetSet.BeginPaint ',DbgSName(Control)]);
paintrect.x := PS.rcPaint.Left;
paintrect.y := PS.rcPaint.Top;
paintrect.width := PS.rcPaint.Right- PS.rcPaint.Left;
paintrect.height := PS.rcPaint.Bottom - PS.rcPaint.Top;
if (paintrect.width <= 0) or (paintrect.height <=0) then begin
if (paintrect.width <= 0) or (paintrect.height <=0)
then begin
paintrect.x := 0;
paintrect.y := 0;
gdk_drawable_get_size(TDeviceContext(Result).Drawable,
gdk_drawable_get_size(TGtkDeviceContext(Result).Drawable,
@paintrect.width, @paintrect.height);
end;
gdk_window_freeze_updates(TDeviceContext(Result).Drawable);
gdk_window_begin_paint_rect (TDeviceContext(Result).Drawable, @paintrect);
gdk_window_freeze_updates(TGtkDeviceContext(Result).Drawable);
gdk_window_begin_paint_rect (TGtkDeviceContext(Result).Drawable, @paintrect);
end;
end;
@ -311,8 +314,8 @@ begin
If (Control <> nil) and (not GTK_WIDGET_DOUBLE_BUFFERED((PGTKWidget(Handle)))) and (Control.DoubleBuffered) then
begin
if PS.HDC <> 0 then begin
gdk_window_thaw_updates(TDeviceContext(PS.HDC).Drawable);
gdk_window_end_paint (TDeviceContext(PS.HDC).Drawable);
gdk_window_thaw_updates(TGtkDeviceContext(PS.HDC).Drawable);
gdk_window_end_paint (TGtkDeviceContext(PS.HDC).Drawable);
end;
end;
@ -329,6 +332,8 @@ end;
function TGtk2WidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
var
DevCtx: TGtkDeviceContext absolute DC;
LineStart, LineEnd, StrEnd: PChar;
Width, Height: Integer;
TopY, LineLen, LineHeight: Integer;
@ -341,12 +346,11 @@ var
procedure DoTextOut(X,Y : Integer; Str: Pchar; CurCount: Integer);
var
DevCtx: TDeviceContext;
CurScreenX: LongInt;
CharLen: LongInt;
begin
DevCtx:=TDeviceContext(DC);
if (Dx<>nil) then begin
if (Dx<>nil)
then begin
CurScreenX:=X;
while CurCount>0 do begin
CharLen:=UTF8CharacterLength(CurStr);
@ -360,7 +364,8 @@ var
inc(CurStr,CharLen);
dec(CurCount,CharLen);
end;
end else begin
end
else begin
pango_layout_set_text(UseFont, Str, Count);
gdk_draw_layout_with_colors(DevCtx.drawable, DevCtx.GC, X, Y, UseFont,
Foreground, nil);
@ -371,80 +376,81 @@ begin
//DebugLn(['TGtk2WidgetSet.ExtTextOut X=',X,' Y=',Y,' Str="',copy(Str,1,Count),'" Count=',Count,' DX=',dbgs(DX)]);
Assert(False, Format('trace:> [TGtk2WidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
Result := IsValidDC(DC);
if Result
then with TDeviceContext(DC) do
begin
if GC <> nil then; // create GC
if ((Options and (ETO_OPAQUE+ETO_CLIPPED)) <> 0)
and (Rect=nil) then begin
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Rect=nil');
Result := False;
exit;
end;
if not Result then Exit;
if DevCtx.GC <> nil then; // create GC
UseFont:=GetGtkFont(TDeviceContext(DC));
// to reduce flickering calculate first and then paint
DCOrigin:=GetDCOffset(TDeviceContext(DC));
if (Options and ETO_CLIPPED) <> 0 then begin
X := Rect^.Left;
Y := Rect^.Top;
IntersectClipRect(DC, Rect^.Left, Rect^.Top,
Rect^.Right, Rect^.Bottom);
end;
LineLen := FindLineLen(Str,Count);
TopY := Y;
UpdateDCTextMetric(TDeviceContext(DC));
TxtPt.X := X + DCOrigin.X;
LineHeight := DCTextMetric.TextMetric.tmHeight;
TxtPt.Y := TopY + DCOrigin.Y;
SelectedColors := dcscCustom;
if ((Options and ETO_OPAQUE) <> 0) then
begin
Width := Rect^.Right - Rect^.Left;
Height := Rect^.Bottom - Rect^.Top;
EnsureGCColor(DC, dccCurrentBackColor, True, False);
gdk_draw_rectangle(Drawable, GC, 1,
Rect^.Left+DCOrigin.X, Rect^.Top+DCOrigin.Y,
Width, Height);
end;
EnsureGCColor(DC, dccCurrentTextColor, True, False);
Foreground := nil;//StyleForegroundColor(CurrentTextColor.ColorRef, nil);
CurDx:=Dx;
CurStr:=Str;
LineStart:=Str;
if LineLen < 0 then begin
LineLen:=Count;
if Count> 0 then
DoTextOut(TxtPt.X, TxtPt.Y, LineStart, LineLen);
end else
Begin //write multiple lines
StrEnd:=Str+Count;
while LineStart < StrEnd do begin
LineEnd:=LineStart+LineLen;
if LineLen>0 then
DoTextOut(TxtPt.X, TxtPt.Y, LineStart, LineLen);
inc(TxtPt.Y,LineHeight);
LineStart:=LineEnd+1; // skip #13
if (LineStart<StrEnd) and (LineStart^ in [#10,#13])
and (LineStart^ <> LineEnd^) then
inc(LineStart); // skip #10
Count:=StrEnd-LineStart;
LineLen:=FindLineLen(LineStart,Count);
if LineLen<0 then
LineLen:=Count;
end;
end;
Result := True;
if ((Options and (ETO_OPAQUE+ETO_CLIPPED)) <> 0)
and (Rect=nil)
then begin
DebugLn('WARNING: [TGtk2WidgetSet.ExtTextOut] Rect=nil');
Result := False;
exit;
end;
UseFont:=GetGtkFont(DevCtx);
// to reduce flickering calculate first and then paint
DCOrigin:=DevCtx.Offset;
if (Options and ETO_CLIPPED) <> 0
then begin
X := Rect^.Left;
Y := Rect^.Top;
IntersectClipRect(DC, Rect^.Left, Rect^.Top,
Rect^.Right, Rect^.Bottom);
end;
LineLen := FindLineLen(Str,Count);
TopY := Y;
UpdateDCTextMetric(DevCtx);
TxtPt.X := X + DCOrigin.X;
LineHeight := DevCtx.DCTextMetric.TextMetric.tmHeight;
TxtPt.Y := TopY + DCOrigin.Y;
DevCtx.SelectedColors := dcscCustom;
if ((Options and ETO_OPAQUE) <> 0) then
begin
Width := Rect^.Right - Rect^.Left;
Height := Rect^.Bottom - Rect^.Top;
EnsureGCColor(DC, dccCurrentBackColor, True, False);
gdk_draw_rectangle(DevCtx.Drawable, DevCtx.GC, 1,
Rect^.Left+DCOrigin.X, Rect^.Top+DCOrigin.Y,
Width, Height);
end;
EnsureGCColor(DC, dccCurrentTextColor, True, False);
Foreground := nil;//StyleForegroundColor(CurrentTextColor.ColorRef, nil);
CurDx:=Dx;
CurStr:=Str;
LineStart:=Str;
if LineLen < 0 then begin
LineLen:=Count;
if Count> 0 then
DoTextOut(TxtPt.X, TxtPt.Y, LineStart, LineLen);
end else
Begin //write multiple lines
StrEnd:=Str+Count;
while LineStart < StrEnd do begin
LineEnd:=LineStart+LineLen;
if LineLen>0 then
DoTextOut(TxtPt.X, TxtPt.Y, LineStart, LineLen);
inc(TxtPt.Y,LineHeight);
LineStart:=LineEnd+1; // skip #13
if (LineStart<StrEnd) and (LineStart^ in [#10,#13])
and (LineStart^ <> LineEnd^) then
inc(LineStart); // skip #10
Count:=StrEnd-LineStart;
LineLen:=FindLineLen(LineStart,Count);
if LineLen<0 then
LineLen:=Count;
end;
end;
Result := True;
Assert(False, Format('trace:< [TGtk2WidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
end;
@ -472,19 +478,17 @@ var
begin
//inherited GetTextExtentPoint;
Result := IsValidDC(DC);
if Result and (Count>0)
then with TDeviceContext(DC) do
begin
UseFont:=GetGtkFont(TDeviceContext(DC));
if not Result then Exit;
if COunt <= 0 then Exit;
UpdateDCTextMetric(TDeviceContext(DC));
UseFont:=GetGtkFont(TGtkDeviceContext(DC));
pango_layout_set_text(UseFont, Str, Count);
pango_layout_get_pixel_size(UseFont, @Size.cX, @Size.cY);
//DebugLn(['TGtk2WidgetSet.GetTextExtentPoint Str="',copy(Str,1,Count),' Count=',Count,' X=',Size.cx,' Y=',Size.cY]);
UpdateDCTextMetric(TGtkDeviceContext(DC));
pango_layout_set_text(UseFont, Str, Count);
pango_layout_get_pixel_size(UseFont, @Size.cX, @Size.cY);
//DebugLn(['TGtk2WidgetSet.GetTextExtentPoint Str="',copy(Str,1,Count),' Count=',Count,' X=',Size.cx,' Y=',Size.cY]);
Result := True;
end;
end;
function TGtk2WidgetSet.SetCursorPos(X, Y: Integer): Boolean;
@ -548,38 +552,35 @@ end;
Returns:
------------------------------------------------------------------------------}
Function TGtk2WidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar;
function TGtk2WidgetSet.TextOut(DC: HDC; X,Y : Integer; Str : Pchar;
Count: Integer) : Boolean;
var
DevCtx: TGtkDeviceContext absolute DC;
DCOrigin: TPoint;
yOffset: integer;
UseFont: PPangoLayout;
begin
Result := IsValidDC(DC);
if Result and (Count>0)
then with TDeviceContext(DC) do
begin
UseFont:=GetGtkFont(TDeviceContext(DC));
UpdateDCTextMetric(TDeviceContext(DC));
DCOrigin:=GetDCOffset(TDeviceContext(DC));
with DCTextMetric.TextMetric do
yOffset:= tmHeight-tmDescent-tmAscent;
if yOffset<0 then yOffset:=0;
if not Result then Exit;
if Count <= 0 then Exit;
UseFont := GetGtkFont(DevCtx);
UpdateDCTextMetric(DevCtx);
DCOrigin := DevCtx.Offset;
with DevCtx.DCTextMetric.TextMetric do
yOffset:= tmHeight-tmDescent-tmAscent;
if yOffset<0 then yOffset:=0;
SelectedColors := dcscCustom;
EnsureGCColor(DC, dccCurrentTextColor, True, False);
DevCtx.SelectedColors := dcscCustom;
EnsureGCColor(DC, dccCurrentTextColor, True, False);
pango_layout_set_text(UseFont, Str, Count);
EnsureGCColor(DC, dccCurrentTextColor, True, False);
pango_layout_set_text(UseFont, Str, Count);
EnsureGCColor(DC, dccCurrentTextColor, True, False);
//DebugLn(['TGtk2WidgetSet.TextOut Str="',copy(Str,1,Count),'" X=',X+DCOrigin.X,',',Y+DCOrigin.Y+yOffset]);
gdk_draw_layout_with_colors(drawable, GC,
gdk_draw_layout_with_colors(DevCtx.drawable, DevCtx.GC,
X+DCOrigin.X, Y+DCOrigin.Y+yOffset, UseFont, nil, nil);
Result := True;
end;
end;
function TGtk2WidgetSet.UpdateWindow(Handle: HWND): Boolean;