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

Gtk2: implemented TGtk2WidgetSet.GetTextExtentExPoint(), pango_extents_to_pixels() is mimicked by theo's pango_extents_to_pixels_wa() from issue #16908.

Browse Source 
git-svn-id: trunk@27412 -
This commit is contained in:
zeljko 2010-09-19 15:31:09 +00:00
parent f8157f184d
commit f7c1c5ee34
2 changed files with 71 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5501,6 +5501,76 @@ begin
end; end;
end; end;
function TGtk2WidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; Count,
MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize
): Boolean;
var
layout: PPangoLayout;
i: Integer;
Rect: TPangoRectangle;
iter : PPangoLayoutIter;
{pango_extents_to_pixels is available from pango 1.16, so we
must use theo's function to have proper result.
function taken from http://bugs.freepascal.org/view.php?id=16908.
}
procedure pango_extents_to_pixels_wa(inclusive:PPangoRectangle;
nearest:PPangoRectangle);
var
orig_x, orig_y: Integer;
begin
orig_x := nearest^.x;
orig_y := nearest^.y;
nearest^.x := PANGO_PIXELS(nearest^.x);
nearest^.y := PANGO_PIXELS(nearest^.y);
nearest^.width := PANGO_PIXELS(orig_x + nearest^.width ) - nearest^.x;
nearest^.height := PANGO_PIXELS(orig_y + nearest^.height) - nearest^.y;
end;
begin
Result := IsValidDC(DC);
if Result then
with TGtkDeviceContext(DC) do
begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) then
layout := GetDefaultGtkFont(false)
else
layout := CurrentFont^.GDIFontObject;
pango_layout_set_text(layout, Str, Count);
if PartialWidths = nil then
pango_layout_get_pixel_size (layout, @Size.cx, @Size.cy)
else
begin
i := 0;
Size.cx := 0;
Size.cy := 0;
iter := pango_layout_get_iter(layout);
try
repeat
pango_layout_iter_get_char_extents(iter, @Rect);
pango_extents_to_pixels_wa(nil, @Rect);
inc(Size.cx, Rect.Width);
if MaxCount <> nil then
begin
if Size.cx <= MaxWidth then
begin
inc(MaxCount^);
PartialWidths[i] := Size.cx;
end else
break;
end else
PartialWidths[i] := Size.cx;
if Size.cy < Rect.Height then
Size.cy := Rect.Height;
inc(i);
until not pango_layout_iter_next_char(iter);
finally
pango_layout_iter_free(iter);
end;
end;
end;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: GetTextExtentPoint Function: GetTextExtentPoint
Params: none Params: none

1
lcl/interfaces/gtk2/gtk2winapih.inc
View File

@ -140,6 +140,7 @@ function GetSysColor(nIndex: Integer): DWORD; override;
function GetSysColorBrush(nIndex: Integer): HBrush; override; function GetSysColorBrush(nIndex: Integer): HBrush; override;
function GetSystemMetrics(nIndex: Integer): Integer; override; function GetSystemMetrics(nIndex: Integer): Integer; override;
function GetTextColor(DC: HDC) : TColorRef; override; function GetTextColor(DC: HDC) : TColorRef; override;
function GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize): Boolean; override;
function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override; function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override; function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override; function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;