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

LCL-GTK3: Refactor GetObject winapi wrapper in OO-style. Issue #36888, patch from Anton Kavalenka.

Browse Source 
git-svn-id: trunk@62923 -
This commit is contained in:
juha 2020-04-09 15:51:45 +00:00
parent c92875cb38
commit 1bc57e8667
3 changed files with 43 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lcl/interfaces/gtk3/gtk3objects.pas
View File

@ -21,13 +21,13 @@ unit gtk3objects;
interface
uses
Classes, SysUtils, Types, FPCanvas,
Classes, SysUtils, Types, math, FPCanvas,
// LazUtils
LazUTF8, IntegerList, LazStringUtils,
// LCL
LCLType, LCLProc, Graphics,
LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazGdkPixbuf2,
LazPango1, LazPangoCairo1, LazCairo1;
LazPango1, LazPangoCairo1, LazCairo1, gtk3procs;
type
TGtk3DeviceContext = class;
@ -54,6 +54,7 @@ type
public
constructor Create; override;
function Select(ACtx:TGtk3DeviceContext):TGtk3ContextObject;virtual;
function Get(szbuf:integer;pbuf:pointer):integer;virtual;abstract;
property Shared: Boolean read FShared write FShared;
end;
@ -69,6 +70,7 @@ type
constructor Create(ACairo: Pcairo_t; AWidget: PGtkWidget = nil);
constructor Create(ALogFont: TLogFont; const ALongFontName: String);
function Select(ACtx:TGtk3DeviceContext):TGtk3ContextObject;override;
function Get(szbuf:integer;pbuf:pointer):integer;override;
destructor Destroy; override;
procedure UpdateLogFont;
property FontName: String read FFontName write FFontName;
@ -91,6 +93,7 @@ type
LogBrush: TLogBrush;
constructor Create; override;
function Select(ACtx:TGtk3DeviceContext):TGtk3ContextObject;override;
function Get(szbuf:integer;pbuf:pointer):integer;override;
destructor Destroy;override;
procedure UpdatePattern;
property Color: TColor read FColor write SetColor;
@ -117,6 +120,7 @@ type
LogPen: TLogPen;
constructor Create; override;
function Select(ACtx:TGtk3DeviceContext):TGtk3ContextObject;override;
function Get(szbuf:integer;pbuf:pointer):integer;override;
property Color: TColor read FColor write SetColor;
property Context: TGtk3DeviceContext read FContext write FContext;
@ -139,6 +143,7 @@ type
constructor Create(CreateHandle: Boolean); virtual; overload;
constructor Create(CreateHandle: Boolean; X1,Y1,X2,Y2: Integer); virtual; overload;
function Select(ACtx:TGtk3DeviceContext):TGtk3ContextObject;override;
function Get(szbuf:integer;pbuf:pointer):integer;override;
destructor Destroy; override;
function GetExtents: TRect;
function ContainsRect(ARect: TRect): Boolean;
@ -159,6 +164,7 @@ type
constructor Create(AData: PByte; width: Integer; height: Integer; format: cairo_format_t; const ADataOwner: Boolean = False); overload;
constructor Create(AData: PByte; width: Integer; height: Integer; bytesPerLine: Integer; format: cairo_format_t; const ADataOwner: Boolean = False); overload;
function Select(ACtx:TGtk3DeviceContext):TGtk3ContextObject;override;
function Get(szbuf:integer;pbuf:pointer):integer;override;
destructor Destroy; override;
procedure CopyFrom(AImage: PGdkPixbuf; x, y, w, h: integer);
function height: Integer;
@ -290,7 +296,7 @@ function ReplaceAmpersandsWithUnderscores(const S: string): string; inline;
implementation
uses gtk3int, gtk3procs;
uses gtk3int;
const
PixelOffset = 0.5; // Cairo API needs 0.5 pixel offset to not make blurry lines
@ -486,6 +492,11 @@ begin
Result:=Self;
end;
function TGtk3Region.Get(szbuf: integer; pbuf: pointer): integer;
begin
Result:=0;
end;
destructor TGtk3Region.Destroy;
begin
if Assigned(FHandle) then
@ -677,6 +688,14 @@ begin
fContext.CurrentFont:= Self;
end;
function TGtk3Font.Get(szbuf: integer; pbuf: pointer): integer;
begin
Result:=sizeof(Self.LogFont);
if pbuf=nil then exit;
Self.UpdateLogFont;
move(LogFont,pbuf^,min(szbuf,Result));
end;
destructor TGtk3Font.Destroy;
begin
if Assigned(FLayout) then
@ -852,6 +871,11 @@ begin
fContext.SetImage(Self);
end;
function TGtk3Image.Get(szbuf: integer; pbuf: pointer): integer;
begin
Result:=0;
end;
destructor TGtk3Image.Destroy;
begin
if FHandle <> nil then
@ -965,6 +989,13 @@ begin
fContext.CurrentPen := Self;
end;
function TGtk3Pen.Get(szbuf: integer; pbuf: pointer): integer;
begin
Result:=sizeof(LogPen);
if pbuf=nil then exit;
move(LogPen,pbuf^,min(result,szbuf));
end;
procedure TGtk3Pen.setCosmetic(b: Boolean);
begin
FCosmetic := B;
@ -1019,6 +1050,13 @@ begin
fContext.CurrentBrush := Self;
end;
function TGtk3Brush.Get(szbuf: integer; pbuf: pointer): integer;
begin
Result:=sizeof(LogBrush);
if pbuf=nil then exit;
move(LogBrush,pbuf^,min(Result,szbuf));
end;
destructor TGtk3Brush.Destroy;
begin
if Assigned(brush_pattern) then

2
lcl/interfaces/gtk3/gtk3widgets.pas
View File

@ -6552,7 +6552,7 @@ begin
else
begin
for i := 0 to Parent.ControlCount - 1 do
if Parent.Controls[i] is TRadioButton and
if (Parent.Controls[i] is TRadioButton) and
TWinControl(Parent.Controls[i]).HandleAllocated then
begin
rb := TRadioButton(Parent.Controls[i]);

50
lcl/interfaces/gtk3/gtk3winapi.inc
View File

@ -2209,12 +2209,6 @@ end;
function TGtk3WidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer;
Buf: Pointer): Integer;
var
aObject: TObject;
ALogFont: PLogFont absolute Buf;
ALogPen: PLogPen absolute Buf;
//AExtLogPen: PExtLogPen absolute Buf;
ALogBrush: PLogBrush absolute Buf;
begin
Result := 0;
if not IsValidGDIObject(GDIObj) then
@ -2224,49 +2218,7 @@ begin
{$endif}
Exit;
end;
aObject := TObject(GdiObj);
DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject));
if aObject is TGtk3Pen then
begin
if Buf = nil then
Result := SizeOf(TLogPen)
else
begin
Result := SizeOf(TLogPen);
ALogPen^ := TGtk3Pen(aObject).LogPen;
end;
end else
if aObject is TGtk3Brush then
begin
if Buf = nil then
begin
// DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject),' Buffer is empty ',dbgHex(PtrUInt(ALogBrush)));
Result := SizeOf(TLogBrush);
end else
if BufSize >= SizeOf(TLogBrush) then
begin
Result := SizeOf(TLogBrush);
// ALogBrush^ := TGtk3Brush(aObject).Color;
ALogBrush^ := TGtk3Brush(AObject).LogBrush;
// DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject),' ALogBrush ',dbgHex(PtrUInt(ALogBrush)));
end;
end else
if aObject is TGtk3Font then
begin
if Buf = nil then
begin
// DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject),' Buffer is empty ',dbgHex(PtrUInt(ALogBrush)));
Result := SizeOf(TLogFont);
end else
if BufSize >= SizeOf(TLogFont) then
begin
Result := SizeOf(TLogFont);
// ALogBrush^ := TGtk3Brush(aObject).Color;
TGtk3Font(AObject).UpdateLogFont;
ALogFont^ := TGtk3Font(AObject).LogFont;
// DebugLn('TGtk3WidgetSet.GetObject ',dbgsName(aObject),' ALogBrush ',dbgHex(PtrUInt(ALogBrush)));
end;
end;
Result:=TGtk3ContextObject(GDIObj).Get(bufsize, buf);
end;
function TGtk3WidgetSet.GetParent(Handle: HWND): HWND;