M
meet
Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TMyDataModule.DataModuleCreate(Sender: TObject);
var
WinPath: array [0..255] of Char;
FontPath, AppPath: string;
begin
AppPath := ExtractFilepath(Application.ExeName);
GetWindowsDirectory(WinPath,256);
FontPath := StrPas(WinPath);
CopyFile(PChar(AppPath + '/Font/Wenyuan.TTF'), PChar(FontPath + '/Fonts/Wenyuan.TTF'), False);
end;
我的目的很简单,就是把字体拷到系统字体目录下,代码如上,可这样会在有些系统执行不成功,不知为什么?
后来我就改成以下:
CreateScalableFontResource(0, 'd:/myfont.fot', 'd:/myfont.ttf','d;');
AddFontResource('d:/myfont.fot')
SendMessage(HWM_FONTCHANGE, WND_BROADCAST, 0, 0)
可这样还是不行,,,,一个字体都装安装不上,,,
真是烦,,,,,
再后来我就用InstallShield做了个安装程序,,,,这个是是可以,不知InstallShield是用什么方法,,,,
实在没办法我又试了
procedure TForm1.Button1Click(Sender: TObject);
var
FontFBuf, FontTBuf: array[0..255] of Char;
begin
FillChar(FontFBuf, Sizeof(FontFBuf), 0);
FillChar(FontTBuf, Sizeof(FontTBuf), 0);
StrPCopy(FontFBuf, 'E:/MyFile/Test/DelphiTest/FontFont/IP769292.TTF');
StrPCopy(FontTBuf, 'E:/IP769292.TTF');
try
with FontInfo do
begin
Wnd := Form1.Handle;
wFunc := FO_COPY;
pFrom := FontFBuf;
pTo := FontTBuf;
fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation(FontInfo);
except
end;
end;
这个也不行,,老提示无法读源文件或磁盘,,,,真是烦,,,,大虾们这段代码有问题吗?
还请大虾指教,,,,,
var
WinPath: array [0..255] of Char;
FontPath, AppPath: string;
begin
AppPath := ExtractFilepath(Application.ExeName);
GetWindowsDirectory(WinPath,256);
FontPath := StrPas(WinPath);
CopyFile(PChar(AppPath + '/Font/Wenyuan.TTF'), PChar(FontPath + '/Fonts/Wenyuan.TTF'), False);
end;
我的目的很简单,就是把字体拷到系统字体目录下,代码如上,可这样会在有些系统执行不成功,不知为什么?
后来我就改成以下:
CreateScalableFontResource(0, 'd:/myfont.fot', 'd:/myfont.ttf','d;');
AddFontResource('d:/myfont.fot')
SendMessage(HWM_FONTCHANGE, WND_BROADCAST, 0, 0)
可这样还是不行,,,,一个字体都装安装不上,,,
真是烦,,,,,
再后来我就用InstallShield做了个安装程序,,,,这个是是可以,不知InstallShield是用什么方法,,,,
实在没办法我又试了
procedure TForm1.Button1Click(Sender: TObject);
var
FontFBuf, FontTBuf: array[0..255] of Char;
begin
FillChar(FontFBuf, Sizeof(FontFBuf), 0);
FillChar(FontTBuf, Sizeof(FontTBuf), 0);
StrPCopy(FontFBuf, 'E:/MyFile/Test/DelphiTest/FontFont/IP769292.TTF');
StrPCopy(FontTBuf, 'E:/IP769292.TTF');
try
with FontInfo do
begin
Wnd := Form1.Handle;
wFunc := FO_COPY;
pFrom := FontFBuf;
pTo := FontTBuf;
fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation(FontInfo);
except
end;
end;
这个也不行,,老提示无法读源文件或磁盘,,,,真是烦,,,,大虾们这段代码有问题吗?
还请大虾指教,,,,,