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

Introduces TCanvas.TextFitInfo and implements LCLIntf.GetTextExtentExPoint for Win32

Browse Source 
git-svn-id: trunk@33215 -
This commit is contained in:
sekelsenmat 2011-11-02 11:11:28 +00:00
parent ee45c154a1
commit 2ce733728d
4 changed files with 49 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/graphics.pp
View File

@ -1158,6 +1158,7 @@ type
function TextExtent(const Text: string): TSize; virtual;
function TextHeight(const Text: string): Integer; virtual;
function TextWidth(const Text: string): Integer; virtual;
function TextFitInfo(const Text: string; MaxWidth: Integer): Integer;
function HandleAllocated: boolean; virtual;
function GetUpdatedHandle(ReqState: TCanvasState): HDC; virtual;
public

16
lcl/include/canvas.inc
View File

@ -1683,6 +1683,22 @@ begin
Result := TextExtent(Text).cX;
end;
{------------------------------------------------------------------------------
Function: TCanvas.TextFitInfo
Params: Text: The text in consideration
MaxWidth: The size, the major input
Returns: The number of characters which will fit into MaxWidth
Returns how many characters will fit in a specified width
------------------------------------------------------------------------------}
function TCanvas.TextFitInfo(const Text: string; MaxWidth: Integer): Integer;
var
lSize: TSize;
begin
LCLIntf.GetTextExtentExPoint(Self.Handle, PChar(Text), Length(Text),
MaxWidth, @Result, nil, lSize);
end;
{------------------------------------------------------------------------------
Function: TCanvas.TextHeight
Params: Text: The text to measure

31
lcl/interfaces/win32/win32winapi.inc
View File

@ -2050,6 +2050,37 @@ begin
Result := TColorRef(Windows.GetTextColor(DC));
end;
function TWin32WidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar;
Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize): Boolean;
var
LCLStr: utf8string;
s: AnsiString;
w: WideString;
begin
// use temp buffer, if count is set, there might be no null terminator
if count = -1 then
LCLStr := Str
else
begin
SetLength(LCLStr, count);
move(str^, PChar(LCLStr)^, count);
end;
// the length of utf8 vs Wide/Ansi the strings differ, so recalc.
if UnicodeEnabledOS then
begin
// TODO: use the real number of chars (and not the length)
w := UTF8ToUTF16(LCLStr);
Result := Windows.GetTextExtentExPointW(DC, PWideChar(W), Length(W),
MaxWidth, MaxCount, PartialWidths, Size);
end
else
begin
s := Utf8ToAnsi(LCLStr);
Result := Windows.GetTextExtentExPoint(DC, pchar(s), length(s),
MaxWidth, MaxCount, PartialWidths, Size);
end;
end;
{------------------------------------------------------------------------------
Method: GetTextExtentPoint
Params: DC - handle of device context

1
lcl/interfaces/win32/win32winapih.inc
View File

@ -127,6 +127,7 @@ 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;