Hello,
I am trying to install TTF fonts at runtime from my application and use the font to create a Text Layer and save the file in .ien format.
Here is the code that I am using:
function GetFontResourceInfo(lpszFilename: PChar; var cbBuffer: DWORD; lpBuffer: PChar; dwQueryType: DWORD): DWORD; stdcall; external 'gdi32.dll' name 'GetFontResourceInfoW';
function InstallTtfFont(FntFName: string): string;
const
QFR_DESCRIPTION =1;
FR_PRIVATE = $10;
var
FileRec : TSearchRec;
cbBuffer : DWORD;
lpBuffer: array[0..MAX_PATH-1] of Char;
FFontLoaded: Integer;
begin
if FileExists(FntFName) then
begin
//FFontLoaded := AddFontResourceEx(Pointer(FntFName), FR_PRIVATE, nil) > 0;
if AddFontResource(PWideChar(FntFName)) <> 0 then
begin
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
cbBuffer:=SizeOf(lpBuffer);
GetFontResourceInfo(PWideChar(FntFName), cbBuffer, lpBuffer, QFR_DESCRIPTION);
Result := Format('%s',[lpBuffer]);
end;
end;
Procedure UnInstallTtfFont(FntFName: string);
Begin
If FileExists(FntFName) Then
begin
If RemoveFontResource(PWideChar(FntFName)) Then
begin
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
end;
End;
procedure AddTextLayer(MyIE: TImageEnView; TextToAdd: string; FntName: string);
var
lyr: TIETextLayer;
ImgLyr, TxtLyr: Integer;
begin
//Add Empty Layer
ImgLyr := MyIE.LayersAdd( ielkImage );
MyIE.Proc.AlphaFill(1);
TxtLyr := MyIE.LayersAdd( ielkText ); // add a new textlayer
lyr := TIETextLayer( MyIE.CurrentLayer );
// Text props
lyr.Text := TextToAdd;
lyr.Font.Size := 300;
lyr.Font.Color := clRed;
lyr.AutoSize := True;
lyr.WordWrap := False;
lyr.Font.Style := [];
lyr.Font.Name := FntName;
// General props
lyr.PosX := 0;
lyr.PosY := 0;
lyr.Rotate := 0;
lyr.Opacity := 100 / 100;
MyIE.Update();
MyIE.Layers[ImgLyr].Width := MyIE.Layers[TxtLyr].Width;
MyIE.Layers[ImgLyr].Height := MyIE.Layers[TxtLyr].Height;
// Merge text into the background image to convert ielkText to ielkImage
MyIE.LayersMerge(ImgLyr, TxtLyr);
MyIE.Update();
end;
LogoChar := txtText.Text;
procedure TfrmMainForm.btnGenerateClick(Sender: TObject);
var
TTFPath, TtfFntName: string;
TTFIdx: Integer;
FntName: string;
ieTemp: TImageEnView;
begin
ieTemp := TImageEnView.Create(Self);
TTFPath := ExtractFilePath(Application.ExeName) + 'TTF_FONT\';
TtfFntName := TTFPath + 'Grotto.ttf';
FntName := InstallTtfFont(TtfFntName);
if FntName <> '' then
begin
Application.ProcessMessages;
AddTextLayer(ieTemp, 'AbCdEfG', FntName);
end
else
begin
AddTextLayer(ieTemp, 'AbCdEfG', 'Calibri');
end;
//Uninstall the font as we do not need it
UnInstallTtfFont(TtfFntName);
//Resize BG to enclose Text Layer
if (ieTemp.CurrentLayer.Width > ieTemp.Layers[0].Width) or (ieTemp.CurrentLayer.Height > ieTemp.Layers[0].Height) then
begin
ieTemp.LayersCurrent := 0;
ieTemp.Proc.Resample(Round( ieTemp.Layers[1].Width * 1.25 ), Round( ieTemp.Layers[1].Height * 1.25 ), rfBSpline);
ieTemp.LayersCurrent := 1;
ieTemp.Update;
end;
ieTemp.IO.SaveToFileIEN(ExtractFilePath(Application.ExeName) + 'MyTestFile.ien');
FreeAndNil(ieTemp);
end;
Now the funny technical part.
If I put a break point at the line: AddTextLayer(ieTemp, 'AbCdEfG', FntName); and then open any other software like MS Word and select the font in MS Word and then run my code further the text is rendered perfectly but not otherwise.
What must be the problem and how to solve it?
TIA
attach/yogiyang/2021177914_Grotto.zip
63.1 KB
Yogi Yang