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

Removes the implementations of GetTextExtentExPoint from Qt and Gtk2 because they were wrong and because the default implementation is cross-platform and correct

Browse Source 
git-svn-id: trunk@33506 -
This commit is contained in:
sekelsenmat 2011-11-13 09:09:44 +00:00
parent cd481f499c
commit 51b8e33ac9
4 changed files with 0 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5707,79 +5707,6 @@ begin
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
begin
dec(Size.cx, Rect.Width);
break;
end;
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
Params: none

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

@ -143,7 +143,6 @@ function GetSysColor(nIndex: Integer): DWORD; override;
function GetSysColorBrush(nIndex: Integer): HBrush; override;
function GetSystemMetrics(nIndex: Integer): Integer; 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 GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;

51
lcl/interfaces/qt/qtwinapi.inc
View File

@ -4021,57 +4021,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
Function: GetTextExtentExPoint
Params: http://msdn.microsoft.com/en-us/library/dd144935%28VS.85%29.aspx
Returns: True on success
------------------------------------------------------------------------------}
function TQtWidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; Count,
MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize
): Boolean;
var
i: Integer;
w: Integer;
AStr: WideString;
begin
Result := False;
if not IsValidDC(DC) then Exit;
with TQtDeviceContext(DC) do
begin
AStr := GetUtf8String(Str);
if PartialWidths = nil then
begin
Size.cX := Font.Metrics.Width(@AStr, Count);
Size.cY := Font.Metrics.Height;
end else
begin
Size.cx := 0;
Size.cY := Font.Metrics.Height;
if MaxCount <> nil then
MaxCount^ := 0;
for i := 0 to Count - 1 do
begin
w := QFontMetrics_charWidth(Font.Metrics.FHandle, @AStr, i);
Inc(Size.cx, w);
if MaxCount <> nil then
begin
if Size.cx <= MaxWidth then
begin
inc(MaxCount^);
PartialWidths[i] := Size.cx;
end else
begin
Dec(Size.cx, w);
break;
end;
end else
PartialWidths[i] := Size.cx;
end;
end;
end;
Result := True;
end;
{------------------------------------------------------------------------------
Function: GetTextExtentPoint
Params: none

1
lcl/interfaces/qt/qtwinapih.inc
View File

@ -129,7 +129,6 @@ function GetSysColor(nIndex: Integer): DWORD; override;
function GetSysColorBrush(nIndex: Integer): HBrush; override;
function GetSystemMetrics(nIndex: Integer): Integer; 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 GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;