有谁知道在矢量图形上写汉字的方法?(100分)

  • 主题发起人 主题发起人 lxggc
  • 开始时间 开始时间
L

lxggc

Unregistered / Unconfirmed
GUEST, unregistred user!
现有一个 Image 控件,包含的图片格式为 MetaFile ,能否在现有的图形上输出汉字,输
出汉字后要求图片格式不变,仍为 metaFile
 
先转化为BMP,在BMP上输出汉字,再转回WMF。
procedure WmfToBmp(FicheroWmf,FicheroBmp:string);
var
MetaFile:TMetafile;
Bmp:TBitmap;
begin
Metafile:=TMetaFile.create;
{Create a Temporal Bitmap}
Bmp:=TBitmap.create;
{Load the Metafile}
MetaFile.LoadFromFile(FicheroWmf);
{Draw the metafile in Bitmap's canvas}
with Bmp do
begin
Height:=Metafile.Height;
Width:=Metafile.Width;
Canvas.Draw(0,0,MetaFile);
{Save the BMP}
SaveToFile(FicheroBmp);
{Free BMP}
Free;
end;
{Free Metafile}
MetaFile.Free;
end;

procedure BmpToWmf (BmpFile,WmfFile:string);
var
MetaFile : TMetaFile;
MFCanvas : TMetaFileCanvas;
BMP : TBitmap;
begin
{Create temps}
MetaFile := TMetaFile.Create;
BMP := TBitmap.create;
BMP.LoadFromFile(BmpFile);
{Igualemos tama駉s}
{Equalizing sizes}
MetaFile.Height := BMP.Height;
MetaFile.Width := BMP.Width;
{Create a canvas for the Metafile}
MFCanvas:=TMetafileCanvas.Create(MetaFile, 0);
with MFCanvas do
begin
{Draw the BMP into canvas}
Draw(0, 0, BMP);
{Free the Canvas}
Free;
end;
{Free the BMP}
BMP.Free;
with MetaFile do
begin
{Save the Metafile}
SaveToFile(WmfFile);
{Free it...}
Free;
end;
end;
 
我写了一个简单的例子:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Button2: TButton;
Button3: TButton;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Assigned(Image1.Picture.MetaFile) then //这句有错,后面更正
begin
with TMetafileCanvas.Create(Image1.Picture.MetaFile, 0) do
try
Draw(0,0, Image1.Picture.MetaFile);
Font.Name := 'Arial Black';
Font.Size := 14;
TextOut(80,50,'This is a Sample Text to MetaFile');
Brush.Color := clBlue;
Ellipse(100, 100, 200, 200);
finally
Free;
end;
end
else
ShowMessage('The Image is not a MetaFile');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;

end.

花了十几分钟,希望有帮助。

判断是否为METAFILE那一句有错,应该是:

if Assigned(Image1.Picture.Graphic) and (Image1.Picture.Graphic is TMetaFile) then
 
to 卷起千堆雪tyn:
Bmp.Canvas.Draw(0,0,MetaFile);
怎么图像不出来呀。
 
to 卷起千堆雪tyn:
sorry,是我搞错了。
 
这个问题我已解决,谢谢各位的解答. 我采用的方法 与 huzzz 类似
 
后退
顶部