请教各位大侠!!!(100分)

  • 主题发起人 主题发起人 JacksonLiu
  • 开始时间 开始时间
J

JacksonLiu

Unregistered / Unconfirmed
GUEST, unregistred user!
本人在编制一套软件时,需要根据Windows字体的名称和字号得到对应的以[mm]为单位的
汉字,英文字母高度与宽度,使用[Windows API]函数[GetTextExtentPoint32]可以得到
结果,但是该函数在调用时需要传入一个[Canvas]句柄,我采用如下的方法动态生成
[Canvas],总是在调用[GetTextExtentPoint32]时出现
[Canvas does not allow drawing]错误:
......
try
ACanvas:=TCanvas.Create;
......
GetTextExtentPoint32(ACanvas.Handle,PChar(AText),Length(AText),ASize);
......
finally
ACanvas.Free;
......

但是如果传入的句柄是一个窗体设计时组件的[Canvas]属性,如
PaintBox1: TPaintBox;
GetTextExtentPoint32(PaintBox1.Canvas.Handle,PChar(AText),Length(AText),ASize);
则完全正确,不知是何原因?(PaintBox1: TPaintBox;也应该是动态生成的?) 请大侠明示?

又对上述问题有无更好的方法,也请不吝赐教!

 
试一试这个:
try
ACanvas:=TCanvas.Create;......
ACanvas.Control := Form1; // 要获得字体信息的控件
GetTextExtentPoint32(ACanvas.Handle,PChar(AText),Length(AText),ASize);......
finally
ACanvas.Free;......
 
你只是TCanvas.Create一个实例,但没有赋值,也就是你要把它指向一存在的Canvas,
以下代码我试过,没出错:
procedure TForm1.Button1Click(Sender: TObject);
var
ASize:tagSize;
Str:String;
begin
Str:=Edit1.Text;
GetTextExtentPoint32(Handle,PChar(Str),Length(Str),ASize);
end;
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
private
function GetWidthAsMM(Dot: Integer): Integer;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var Str1: String;
TWidth,THeight: Integer;
begin
Canvas.Font.Size := 20;
Str1 := 'How do you do?';
Canvas.TextOut(20,20,Str1);
TWidth := Canvas.TextWidth(Str1);
THeight := Canvas.TextHeight(Str1);
Caption := 'Width: '+IntToStr(GetWidthAsMM(TWidth))+'mm, Height: '
+IntToStr(GetWidthAsMM(THeight))+'mm';
Canvas.MoveTo(20,30+THeight);
Canvas.LineTo(20+TWidth,30+THeight);
end;

function TForm1.GetWidthAsMM(Dot: Integer): Integer;
var dpi: Integer;
FV: Double;
begin
with Canvas do
dpi := GetDeviceCaps(Handle,logPixelsX);
FV := (Dot * dpi)/254;
Result := Round(FV);
end;

end.
 
问题本人已经解决了,谢谢大家!正确的做法如下:

// 根据给定字体的名称与字号得到该种字体的以[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;



 
后退
顶部