نصب فونت در ویندوز 7

با عرض سلام و خسته نباشید.
در ویندوز xp یه روال نوشته بودم که باهاش فونتهای برنامه رو نصب میکردم.
اما در سون جواب نمیده.
چی کارش باید کرد.
ممنون.

procedure InstallFont(PathDirFontLocal: String);

var

  F : TSearchRec;

  FileName : TFileName;

  i:Byte;

  List:TStringList;

  DirFontSystem :string;

  DirWin: array [0..MAX_PATH] of Char;

begin

  try

    GetWindowsDirectory(DirWin, MAX_PATH);

    DirFontSystem :=strpas(DirWin)+'\Fonts\';

    PathDirFontLocal:=IncludeTrailingBackslash(PathDir  FontLocal);

    List:=TStringList.Create;

    try

      if DirectoryExists(PathDirFontLocal)then

      begin

        if (FindFirst(PathDirFontLocal + '*.*',faAnyFile - faDirectory,F) = 0)then

        begin

          try

            repeat

              FileName := F.Name;

              List.Add(F.Name)

            until FindNext(F) <> 0;

          finally

            FindClose(F);

          end;

        end;

        for i:=0 to List.Count-1 do

        begin

          FileSetAttr(PathDirFontLocal +List[i], faArchive);

          AddFontResource(pchar(PathDirFontLocal+List[i]));

//OR          CopyFile(pchar(PathDirFontLocal+List[i]),pchar(DirFontSystem + List[i]),false);

          SendMessage(HWND_BROADCAST,WM_FONTCHANGE, 0, 0 );

        end;

      end;

    finally

      List.Free;

    end;

  except

  end;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

InstallFont(ExtractFilePath(Application.ExeName)+'  Fonts');

end;

فکر کنم مشکل UAC باشه. چون حداقل باید کار کپی فونتها را انجام بده

دوستان نظری ندارند.؟

سلام

نوع فونت هایی که ویندوز 7 قبول میکنه با ایکس پی فرق میکنه .

شما باید فونتهایی که مال ویندوز 7 هست رو نصب کنید .

یه راه امتحانش اینه که خودتون بتونید اونا رو نصب کنید .


موفق باشید .

کد بالا فونت مورد نظر رو به Font Table اضافه میکنه و بعد از بسته شدن هم ویندوز به صورت خودکار حذفش میکنه ، برای اینکه فونت رو به صورت دائمی نصبش کنید باید در رجیستری ثبتش کنید ، یا توجه به مستندات MSDN کدتون رو تغییر دادم ( از اول نوشتم ! ) ولی تو 7 تستش نکردم ( رو سیستم ویندوز سرور نصب هست ) :

procedure InstallFont(LocalFontPath: String);

const

  CSIDL_Fonts = $0014;

var

  FontDir: array [0 .. MAX_PATH] of Char;

  Font: string;

  Reg: TRegistry;

begin

  if not SUCCEEDED(SHGetFolderPath(0, CSIDL_Fonts, 0, SHGFP_TYPE_CURRENT,

    @FontDir[0])) then

    raise Exception.Create('Can not find system Font directory');



  LocalFontPath := IncludeTrailingBackslash(LocalFontPath);



  Reg := TRegistry.Create(KEY_ALL_ACCESS);

  try

    for Font in TDirectory.GetFiles(LocalFontPath, '*.*',

      TSearchoption.soTopDirectoryOnly) do

    begin

      if SysUtils.FileExists(FontDir + SysUtils.ExtractFileName(Font)) then

        raise Exception.CreateFmt('%s is exists in system font directory',

          [SysUtils.ExtractFileName(Font)]);



      TFile.Copy(Font, FontDir + SysUtils.ExtractFileName(Font));

      Reg.RootKey := HKEY_LOCAL_MACHINE;

      Reg.LazyWrite := False;

      Reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts', False);

      Reg.WriteString(SysUtils.ExtractFileName(Font) + ' (TrueType)',

        SysUtils.ExtractFileName(Font));

      Reg.CloseKey;

      AddFontResource(PChar(FontDir + SysUtils.ExtractFileName(Font)));

    end;

  finally

    Reg.Free;

  end;

  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

end;

برای استفاده از کد ، کتابخانه های IOUtils و Types رو به برنامه اضافه کنید .

اگر مشکل داشت بگید تا بررسیش کنم .

در ضمن ، اون کدی که در پست اول قرار دادی عملا Spaghetti Code هست !

نقل قول:

---

نوشته شده توسط مجتبی تاجیک

برای استفاده از کد ، کتابخانه های IOUtils و Types رو به برنامه اضافه کنید .

اگر مشکل داشت بگید تا بررسیش کنم .

---

وکتابخانه ی SHFolder :لبخندساده:

جواب نمیده مخصوصا تو سون ، من یه فایل دسته ای (.bat) درست کردم که کار کپی و رجیستری رو انجام میده اما یه مشکلی هست اول اینکه باید ریست بشه تا فونتا بیان دوم اینکه وقتی روش کلیک میکنی خوب کار میکنه ها اما وقتی با دستور shellexecute اجراش میکنم خطا میده چکار کنم ؟

Install.bat:



@title Install Fonts

@copy *.ttf %systemroot%\fonts

@fonts.reg

@pause



fonts.reg:

Windows Registry Editor Version 5.00



[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts]

"B Titr Bold (TrueType)"="B Titr Bold.TTF"

"B Traffic Bold (TrueType)"="B Traffic Bold.TTF"

"B Traffic (TrueType)"="B Traffic.TTF"

"B Zar Bold (TrueType)"="B Zar Bold.TTF"

"B Zar (TrueType)"="B Zar.TTF"

سلام

ببینید یه راه خیلی خیلی سادش اینه که شما فونت ها رو تو پوشه فونت ویندوز کپی کنید بعد پوشه رو تو اکسپلورر نشون بدین ( یعنی یه بار پوشه رو باز کنید Explorer %WinDir%\Fonts ) خود ویندوز نصبشون میکنه .

یعنی کدتون اینجوری میشه :

Install.bat:

@title Install Fonts

@copy *.ttf %systemroot%\fonts

explorer %systemroot%\fonts

البته من از این systemroot ی که نوشتین مطمئن نیستم ، فکر کنم قدیما همون windir رو میزاشتم . تو راهنمای ویندوز یه جستجو بکنید


موفق باشید

اینم جواب نمیده (چون اگه نصب و رجیسترش از این طریق هم درست بشه توی دلفی نمیشه اجراش کرد) اگه میشه یه روشی بگید که هم تو XP و هم تو Seven بتونم فونتامو نصب کنم

نقل قول:

---

نوشته شده توسط arkia

اینم جواب نمیده (چون اگه نصب و رجیسترش از این طریق هم درست بشه توی دلفی نمیشه اجراش کرد) اگه میشه یه روشی بگید که هم تو XP و هم تو Seven بتونم فونتامو نصب کنم

---

سلام

چرا جواب نده؟

کپی کردن رو که تو دلفی بلدین ؟ بعد از اون از این دستور استفاده کنید :

ShellExecute(0,nil ,'Explorer' , 'C:\Windows\Fonts',nil,SW_SHOWNOACTIVATE);

فقط شما جای C:\Windows از دستوراتی که برای پیدا کردن فولدر ویندوز وجود داره استفاده کنید و جایگزین کنید .


موفق باشید

نقل قول:

---

نوشته شده توسط MohsenB

سلام

چرا جواب نده؟

کپی کردن رو که تو دلفی بلدین ؟ بعد از اون از این دستور استفاده کنید :

ShellExecute(0,nil ,'Explorer' , 'C:\Windows\Fonts',nil,SW_SHOWNOACTIVATE);

فقط شما جای C:\Windows از دستوراتی که برای پیدا کردن فولدر ویندوز وجود داره استفاده کنید و جایگزین کنید .


موفق باشید

---

دوست عزیز .نصب فونت در ویندوز سون با xp فرق میکنه. فرقش رو آقای تاجیک گفتند.
فرقش اینه که در win xp فقط کپی کردن فونت کفایت میکرد.اما در سون باید فونتها در رجیستری هم رجیستر بشه.
از کد زیر استفاده کنید: هم در سون و هم در xp کار میکنه : و هم از دلفی 7 به بالا:لبخندساده:

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs,Types,Registry, StdCtrls, ComCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    ProgressBar1: TProgressBar;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



function ExtractOnlyFileName(const FileName: string): string;

var

  I: Integer;

  S:string;

begin

  S:=ExtractFileName(FileName);

  I := LastDelimiter('.' + PathDelim + DriveDelim, S);

  if (I > 0) and (S[I] = '.') then

    Result := Copy(S,0, I-1) else

    Result := '';

end;



procedure SetRegStr(Root:HKEY;Key,Value,Data:string);

var R:TRegistry;

begin

  try

    R:=TRegistry.Create;

    try

      R.RootKey:=Root;

      R.OpenKey(Key,True);

      R.WriteString(Value,Data);

    finally

      R.CloseKey;

      R.Free

    end;

  except

    ShowMessage('Write to Registry Error');

    halt;

  end;

end;



procedure InstallFont(LocalFontPath: String);

var

  F : TSearchRec;

  FileName : TFileName;

  i:Byte;

  List:TStringList;

  DirFontSystem :string;

  WinDir: Array[0..MAX_PATH -1] of char;

  Result: string;

begin

  SetString(Result,winDir,GetWindowsDirectory(WinDir  ,MAX_PATH));

  try

    DirFontSystem :=WinDir+'\Fonts\';

    LocalFontPath:=IncludeTrailingBackslash(LocalFontP  ath);

    List:=TStringList.Create;

    try

      if DirectoryExists(LocalFontPath)then

      begin

        if (FindFirst(LocalFontPath + '*.*',faAnyFile - faDirectory,F) = 0)then

        begin

          try

            repeat

              FileName := F.Name;

              List.Add(F.Name)

            until FindNext(F) <> 0;

          finally

            FindClose(F);

          end;

        end;

        for i:=0 to List.Count-1 do

        begin

          FileSetAttr(LocalFontPath +List[i], faArchive);

          CopyFile(pchar(LocalFontPath+List[i]),pchar(DirFontSystem + List[i]),false);

          SetRegStr(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\W  indows NT\CurrentVersion\Fonts',ExtractOnlyFileName(List[i])+' (TrueType)',List[i]);

          Form1.ProgressBar1.Position:=form1.ProgressBar1.Po  sition+1;

        end;

      end;

    finally

      List.Free;

      Form1.ProgressBar1.Position:=100;

      ShowMessage('install fonts complit');

    end;

  except

    ShowMessage('error');

    Application.Terminate;

  end;

end;





procedure TForm1.Button1Click(Sender: TObject);

begin

InstallFont(ExtractFilePath(Application.ExeName)+'  fonts');

end;



end.

نقل قول:

---

نوشته شده توسط MohsenB

سلام

چرا جواب نده؟

کپی کردن رو که تو دلفی بلدین ؟ بعد از اون از این دستور استفاده کنید :

ShellExecute(0,nil ,'Explorer' , 'C:\Windows\Fonts',nil,SW_SHOWNOACTIVATE);

فقط شما جای C:\Windows از دستوراتی که برای پیدا کردن فولدر ویندوز وجود داره استفاده کنید و جایگزین کنید .


موفق باشید

---

سلام، این چه کاریه که بیایم مسیر فونت ها رو باز کنیم؟ واسه Refresh یا Update شدن لیست فونت ها این کار رو انجام بدم؟ منن این کارو با کد زیر انجام دادم :

SendMessage(HWND_BROADCAST, WM_FONTCHANGE,0,0);

اما برنامم هنگ کرد اما با کد زیر درست شد

postMessage(HWND_BROADCAST, WM_FONTCHANGE,0,0);

ولی بازم به ریستارت نیاز داره! :متفکر:

کار کپی و نوشتن تو رجیستری رو بلدم اما من دنبال روشی بودم که آنی نصب بشه و به ریست نیازی نداشته باشه اون فایل دسته ای هم نوشتم دیدم بازم همینه
راستی من هنوز نمیتونم فایل دسته ای رو تو دلفی باز کنم باز میشه ها اما خطا میده

نقل قول:

---

نوشته شده توسط arkia

سلام، این چه کاریه که بیایم مسیر فونت ها رو باز کنیم؟ واسه Refresh یا Update شدن لیست فونت ها این کار رو انجام بدم؟ ...

---

سلام

من که همون اول گفتم که "این یک روش خیلی خیلی ساده هست" ( که البته مخصوص ویندوز xp هست ) شما از هر روشی که خواستین استفاده کنید .


موفق باشید

ویندوز سون حتما باید ریست بشه.

با سلام

خواستم بدونم چطور میشه فونت رو از سیستم حذف کرد؟

من فایل رو هم توی پوشه فونت ها و هم توی رجیستری میبینم و با دستور هم تایید پیدا کردنش رو میده اما دستور دیلیت چیزی رو حذف نمیکنه!


لطفا راهنمایی کنید

ممنون

سلام مجدد

ویندوز xp

همچین کدی نوشتم

deletefile(fontdir+'tahoma.ttf');

البته وقتی وجودشو چک میکنم اوکی میده اما حذفش نمیکنه!

منکه عرض کردم پوشه فونت سیستم رو چک میکنه

اینم کد برای مطمئا شدن

procedure TForm_Main.BitBtn_DeleteFontsClick(Sender: TObject);

var

  F : TSearchRec;

  FileName : TFileName;

  i:Byte;

  List:TStringList;

  DirFontSystem :string;

  WinDir: Array[0..MAX_PATH -1] of char;

  Result: string;

begin

  SetString(Result,winDir,GetWindowsDirectory(WinDir  ,MAX_PATH));

    DirFontSystem :=WinDir+'\Fonts\';

//    LocalFontPath:=IncludeTrailingBackslash(LocalFontP  ath);

  if FileExists(DirFontSystem+'Skoodkbd.ttf') then

    ShowMessage('existed');



  if (System.SysUtils.DeleteFile(DirFontSystem+'Skoodkb  d.ttf)')) then

    ShowMessage('deleted')

  else

    ShowMessage('no deleted');

end;

شما نام فونتتو از این قسمت رجیستری اول حذف کن. درست میشه.

SetRegStr(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\W  indows NT\CurrentVersion\Fonts'

سلام

نام فونت مورد نظر رو از رجیستری حذف کردم اما باز هم نشد!

regkey.DeleteValue('Akram (True Type)')

البته بقیه کدهارو ننوشتم!

مشکل کجاست؟

سلام

اینکه نمیتونستم فایل رو حذف کنم به خاطر این بود که خاصیت Read-only اش تیک خورده بود!با SetAttr مقدارشو نرمال کردم و بعدش حذفش کردم!


سوال:آیا میشه همه فونت هاتی سیستم رو حذف کرد؟آیا ویندوز همچین اجازه ای رو میده؟اگه حذف بشه خودش دوباره ضروری ها رو برمیگردونه یا ویندوز از کار می افته؟

نقل قول:

---

نوشته شده توسط hp1361

سلام

اینکه نمیتونستم فایل رو حذف کنم به خاطر این بود که خاصیت Read-only اش تیک خورده بود!با SetAttr مقدارشو نرمال کردم و بعدش حذفش کردم!

---

ویندوزت چیه؟

سلام

ویندوزم XP بود.البته من میخوام برای ویندوز سرور2003 و 2008 هم انجام بدم و البته 7

من برای نصب فونت این برنامه رو نوشتم که حداقل برای خودم روی ویندوز سون و بدون نیاز به Restart کار می کنه و پس از اجرا اگه فونتی کنار خودش باشه نصب می کنه.
اگه درست کار کرد و به درد کسی خورد بگید تا سورس رو هم آپلود کنم.

اين هم سورس:

سلام

میشه نوع ارجاع List رو برام توضیح بدید؟و همچنین دلیل تغییر نوعش؟

اینجا TStringList هستش

procedure InstallAllFonts;

var

  List:TStringList;

begin

  List:=TStringList.Create;

  FindFiles(ExtractFilePath(Application.ExeName),'*.  ttf',List);

  InstallFonts(List);

  List.Free;

end;

اما اینجا TStrings

procedure FindFiles(StartDir, FileMask: string;  FilesList:TStrings);

var

  SR: TSearchRec;

  DirList: TStringList;

  IsFound: Boolean;

  i: integer;

begin

  if StartDir[length(StartDir)] <> '\' then

    StartDir := StartDir + '\';



  { Build a list of the files in directory StartDir(not the directories!) }



  IsFound :=FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0;

  while IsFound do

  begin

    FilesList.Add(StartDir + SR.Name);

    IsFound := FindNext(SR) = 0;

  end;

  FindClose(SR);



  // Build a list of subdirectories

  DirList := TStringList.Create;

  IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;

  while IsFound do

  begin

    if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') then

      DirList.Add(StartDir + SR.Name);

    IsFound := FindNext(SR) = 0;

  end;

  FindClose(SR);



  // Scan the list of subdirectories

  for i := 0 to DirList.Count - 1 do

    FindFiles(DirList[i], FileMask,FilesList);



  DirList.Free;

end;

سلام.
دلیلش چند ریختی یا PolyMorphism هست.
شما می تونید در این حالت آبجکتهای مشتق شده از TStrings رو بهش بدید. مثل Items کمبو یا Lines ممو.

ممنون

اما قسمت اول سوالمو چیزی نگفتید(البته قسمت اول هم دلیلش رو خواستم،اینکه چرا از اول از همون Tstrings استفاده نکردند)

اینکه برای ارجاع با رفرنس احتیاج به نوشتن Var هست اما در اینجا ازش استفاده نشده!

FindFiles(ExtractFilePath(Application.ExeName),'*.  ttf',List);

  InstallFonts(List);

procedure FindFiles(StartDir, FileMask: string;  FilesList:TStrings);

فکر کنم یادم اومد!
استرینگ ها اشاره گر هستند و ارجاع اشاره گر همون ارجاع با رفرنس هستش!

TStrings کلاسی نیست که بتونید ازش شی بسازید. نه اینکه اصلا نتونید. در حقیقت برای این کارها نیست.
چون پیاده سازی آیتم هاش رو موکول کرده به کلاسهای فرزند. اگر به تعریفش نگاه بندازید می بینید که اجزای Abstract داره.
String ها اشاره گر نیستند.
قانون:
تمام اشیا در حالت پارامتری فقط Pointer شون پاس داده می شه.

نقل قول:

---

String ها اشاره گر نیستند.

---

چرا هستن ، برای همین هست که وقتی با تابع SizeOf اندازه یک متغییر رشته ای رو واکشی میکنیم بدون توجه به مقدار رشته ( یعنی چه خالی باشه چه چند هزار کاراکتر داخلش باشه ) اندازه برابر با 4 هست که سایز Pointer ی هست که به اون رشته در حافظه اشاره میکنه نه سایز Data اون رشته .

البته این فقط مربوط به رشته ها نمیشه و Object ها ، Interface ها و Dynamic Array ها هم مثل String ها در پشت صحنه فقط یک اشاره گر هستند و واقعا حاوی اطلاعاتن مربوطه نیستند و برای همین هم هست که برای گرفتن طول رشته ها و Dynamic Array ها تابع Length و برای اشیاء متد InstanceSize در نظر گرفته شده .

در کل رشته ها Data Type های بسیار جالبی در Delphi هستند ، آقای کشاورز مقاله ای در سایتشون در این مورد قرار داده بودند که بسیار روان نوشته شده بود ولی سایتشون فعلا غیر فعال هست ، میتونید ازشون درخواست کنید در صورت امکان مقاله رو در اختیارتون بزارن .

موفق باشید .

سلام مجدد

نقل قول:

---

تمام اشیا در حالت پارامتری فقط Pointer شون پاس داده می شه.

---

خوب چجوری بفهمیم در حالت پارامتری ارجاع داد شده یا غیر پارامتری؟(تا اونجایی که من از دلفی یادم میاد برای ارجاع با رفرنس از Var استفاده میشد در غیر این صورت ارجاع با مقدار بود،اما در کدهای بالا اینطور نیست)

منظور من از رشته ها اینه که وقتی ارسال می شن به متد اشاره گرشون فرستاده نمی شه.

قانونش رو گفتم دیگه. اگر شی بود همیشه ارجاع هست. برای انواع داده ای ساده که روی Stack حافظه می گیرن ارجاع نیست مگر اینکه تصریح بشه.

پست ها رو دقیق مطالعه کردید ؟ اشیاء یک Object هستن ، Object ها اشاره گر هستند ، پس نیازی به پاس دادن به وسیله Var نیست ، شما وقتی یک شئ رو به عنوان یک پارامتر پاس میدید در حقیقت دارید آدرس اون رو به تابع میدید و تابع هم مستقیم با خود شئ کار میکنه نه یک کپی از اون شئ پس تغییرات کستقیم روی اون شئ اعمال میبشه .

سلام


یه یونیت تغریبا کامل برای فونت نوشتم که تقدیم به همه میکنم


موفق و پیروز باشید

دانلود

نقل قول:

---

نوشته شده توسط zidane

من برای نصب فونت این برنامه رو نوشتم که حداقل برای خودم روی ویندوز سون و بدون نیاز به Restart کار می کنه و پس از اجرا اگه فونتی کنار خودش باشه نصب می کنه.
اگه درست کار کرد و به درد کسی خورد بگید تا سورس رو هم آپلود کنم.

---

دقیقا درست کار می کنه... (ممنون)