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

gtk2 intf: cache for DC textout operations from Paul

Browse Source 
git-svn-id: trunk@15010 -
This commit is contained in:
mattias 2008-04-29 12:12:27 +00:00
parent d91c22d7db
commit a62a570ffd
5 changed files with 35 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -323,6 +323,7 @@ type
function SelectBitmap(AGdiObject: PGdiObject): PGdiObject; virtual;
function SelectPen(AGdiObject: PGdiObject): PGdiObject; virtual;
public
constructor Create; virtual;
procedure CreateGDIObject(AGDIType: TGDIType);
procedure SelectBrushProps; virtual;
procedure SelectTextProps; virtual;

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

@ -727,6 +727,11 @@ begin
SelectedColors := dcscCustom;
end;
constructor TGtkDeviceContext.Create;
begin
// nothing
end;
{------------------------------------------------------------------------------
Procedure: TGtkDeviceContext.SelectPenProps
Params: DC: a (LCL)devicecontext

9
lcl/interfaces/gtk2/gtk2def.pp
View File

@ -37,13 +37,22 @@ uses
type
TSetTextArgs = record
Font: PPangoLayout;
Len: LongInt;
Text: array of char;
end;
{ TGtk2DeviceContext }
TGtk2DeviceContext = class(TGtkDeviceContext)
private
OldText: TSetTextArgs;
protected
function GetFunction: TGdkFunction; override;
public
constructor Create; override;
procedure SetText(AFont: PPangoLayout; AText: PChar; ALength: LongInt);
procedure DrawTextWithColors(AText: PChar; ALength: LongInt; X, Y: Integer; FGColor, BGColor: PGdkColor);
end;

20
lcl/interfaces/gtk2/gtk2devicecontext.inc
View File

@ -31,6 +31,24 @@ begin
Result := GCValues._function;
end;
constructor TGtk2DeviceContext.Create;
begin
inherited Create;
FillChar(OldText, SizeOf(OldText), 0);
end;
procedure TGtk2DeviceContext.SetText(AFont: PPangoLayout; AText: PChar; ALength: LongInt);
begin
if (OldText.Font <> AFont) or (OldText.Len <> ALength) or (CompareChar(AText^, OldText.Text[0], ALength) <> 0) then
begin
pango_layout_set_text(AFont, AText, ALength);
OldText.Font := AFont;
OldText.Len := ALength;
SetLength(OldText.Text, ALength);
Move(AText^, OldText.Text[0], ALength);
end;
end;
procedure TGtk2DeviceContext.DrawTextWithColors(AText: PChar; ALength: LongInt;
X, Y: Integer; FGColor, BGColor: PGdkColor);
var
@ -50,7 +68,7 @@ var
begin
AFont := GetFont;
pango_layout_set_text(AFont^.GDIFontObject, AText, ALength);
SetText(AFont^.GDIFontObject, AText, ALength);
if AFont^.LogFont.lfEscapement <> 0 then
begin

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

@ -488,7 +488,7 @@ begin
UpdateDCTextMetric(TGtkDeviceContext(DC));
pango_layout_set_text(UseFont, Str, Count);
TGtk2DeviceContext(DC).SetText(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]);