取得字符串的宽度和高度

I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
我以前的解决方法是利用窗体的Canvas。先保存,然后把label的Font赋值给FormCanvas,TextWidth()然后,恢复窗体的Canvas。应该由简单的方法。
如下:
procedure TForm1.Button1Click(Sender: TObject);
var
size:tagsize;
begin
GetTextExtentPoint32(label1.Canvas.Handle,pchar(label1.Caption),label1.GetTextLen,size);
caption:=format('X:%d,Y:%d',[size.cx,size.cy]);
end;
**************
JacksonLiu 时间:01-2-15 20:40:16 ID:455452
问题本人已经解决了,谢谢大家!正确的做法如下:
// 根据给定字体的名称与字号得到该种字体的以[mm]为单位的汉字与英文大小
procedure GetFontMMSize(FontName:string; FontSize:Integer; var H,W,EW:Integer);
var
AText :string;
Ratio1 :Real;
AFont :TFont;
fhGdi :HGDIOBJ;
DC :HDC;
ASize :TSize;
begin
try
AFont:=TFont.Create;
with AFont do
begin
Name:=FontName;
Size:=FontSize;
end;
Ratio1:=AFont.PixelsPerInch / 2540;
DC:=GetDC(0);
fhGDI:=SelectObject(DC,AFont.Handle);
AText:='中';
GetTextExtentPoint32(DC,PChar(AText),Length(AText),ASize);
W:=Round(ASize.cx/Ratio1);
H:=Round(ASize.cy/Ratio1);
AText:='A';
GetTextExtentPoint32(DC,PChar(AText),Length(AText),ASize);
EW:=Round(ASize.cx/Ratio1);
SelectObject(DC,fhGDI);
finally
AFont.Free;
ReleaseDC(0,DC);
end;
end;
 
顶部