Formula One只支持WMF格式,而当Delphi处理MetaFile时会自动地将WMF转化为EMF,所以传
给objCreaetPicture函数的Handle实际是EMF格式的,Formula One不能处理,所以会出错。
解决办法是自己用API SetMetaFileBitsEx创建WMF格式的MetaFile.整理后的代码被我误删
了,以下是我做测试时的代码,关键步骤都有了,大家自己整理吧。
unit uCreatePic;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, AxCtrls, OleCtrls, TTF160_TLB;
const
WMFKey = Integer($9AC6CDD7);
WMFWord = $CDD7;
type
PMetafileHeader = ^TMetafileHeader;
TMetafileHeader = packed record
Key: Longint;
Handle: SmallInt;
Box: TSmallRect;
Inch: Word;
Reserved: Longint;
CheckSum: Word;
end;
TForm1 = class(TForm)
F16Book1: TF16Book;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function TestEmf(Stream: TStream):Boolean;
var
Form1: TForm1;
implementation
uses uMyUtils;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
MetaStream: TMemoryStream;
hWMF: HMETAFILE;
BitMem: Pointer;
nLength: LongInt;
begin
MetaStream := TMemoryStream.Create;
try
MetaStream.LoadFromFile('c:/temp/VDT1.wmf');
if TestEmf(MetaStream) then
begin
MetaStream.Seek(SizeOf(TEnhMetaHeader),soFromBeginning);
nLength := MetaStream.Size - SizeOf(TEnhMetaHeader);
End
else
begin
MetaStream.Seek(SizeOf(TMetaFileHeader),soFromBeginning);
nLength := MetaStream.Size - SizeOf(TMetaFileHeader);
end;
GetMem(Bitmem, nLength);
try
MetaStream.Read(Bitmem^,nLength);
hWMF := SetMetaFileBitsEx(nLength,Bitmem);
if hWMF = 0 then
begin
ShowMessage('aaaa');
Exit;
End;
F16Book1.ObjCreatePicture(0,0,1,5,hWMF,8,0,0);
finally // wrap up
FreeMem(Bitmem,nLength);
end
// try/finally
finally // wrap up
MetaStream.Free;
MetaStream := nil;
end
// try/finally
end;
function TestEmf(Stream: TStream):Boolean;
var
Size: Longint;
Header: TEnhMetaHeader;
begin
Size := Stream.Size - Stream.Position;
if Size > Sizeof(Header) then
begin
Stream.Read(Header, Sizeof(Header));
Stream.Seek(-Sizeof(Header), soFromCurrent);
end;
Result := (Size > Sizeof(Header)) and
(Header.iType = EMR_HEADER) and (Header.dSignature = ENHMETA_SIGNATURE);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
MetaStream: TMemoryStream;
begin
MetaStream := TMemoryStream.Create;
try
MetaStream.LoadFromFile('c:/temp/37100000099102601996.emf');
DrawF1Picture(MetaStream,F16Book1);
Finally
MetaStream.Free;
MetaStream := nil;
End;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ShowMessage(IntToStr(SizeOf(TEnhMetaHeader))+' '+ IntToStr(SizeOf(TMetaFileHeader)));
end;
end.