نصب فونت autorun

[neda_barnamenevis]

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

[vcldeveloper]

قبلا مراحل نصب فونت روی سیستم کاربر توضیح داده شده، لطفا جستجو کنید.

[dkhatibi]

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

autorun شما باید شامل یک فایل اجرایی برای نصب فونت باشه که مسیر فونت به راحتی به دست می اد. کافیست Autorun مذکور اون برنامه را اجرا کنه تا فونت به پوشه ی فونت کپی بشه!

[Arman_1367]

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

[Saeid59_m]

بوسیله توابع API می تونی فونت رو نصب کنی (زمانی که برنامه باز می شه )

[m-khorsandi]

دوستان لطف کنید راه حل را بنویسید یا اجازه دهید دوستمون جستجو کند.

[Hamid_PaK]

با تابع API با نام AddFontResource مشکلت حل می شه .
این تابع با دریافت مسیر فایل فونت (اگه Windows SDK رو بخونی می بینی که چه فرمتهایی رو پشتیبانی می کنه) تا زمانی که ویندوز مجدد اجرای نشده و یا تابع RemoveFontResource فراخوانی نشده فونت مورد نظر در برنامه شما قابل استفاده می باشد .

جستجو هم کنی همینها رو پیدا میکنی فقط کمتر وقتت گرفته می شه ( یه مثال هم یادمه که ضمیمه شده بود ).

یا حق ...

[neda_barnamenevis]

var

  i:Integer;

  c1,Drive1:Char;

  TargetFileName,SourceFileName:string;

  dir : pchar;

  searchrec:Tsearchrec;

begin

     dir := StrAlloc(100);

     GetWindowsDirectory(dir, 100);

     TargetFileName := String ( dir );

     TargetFileName := TargetFileName+'\Fonts';

    // az inja be bad yeki yeki fonthaee ra ke mikhahimbe source file midahimva az filecopy estefade mikonim

      if FindFirst(TargetFileName+'F_TAHOMA',at,searchrec)=  0

      then



     ShowMessage('hasy')

     else



  FileCopy('fonts\F_MARYAM.TTF',TargetFileName+'\F_M  ARYAM.TTF');

  FileCopy('fonts\F_ZAR.TTF',TargetFileName+'\F_ZAR.  TTF');

  FileCopy('fonts\NAZ___SF.TTF',TargetFileName+'\NAZ  ___SF.TTF');

  FileCopy('fonts\NAZB__SF.TTF',TargetFileName+'\NAZ  B__SF.TTF');

  FileCopy('fonts\F_TITR.TTF',TargetFileName+'\F_TIT  R.TTF');

  FileCopy('fonts\F_TAHOMA.TTF',TargetFileName+'\F_T  AHOMA.TTF');

//    AddFontResource('fonts\F_TAHOMA.TTF');

  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

  //FileCopy('fonts\tahoma.TTF',TargetFileName+'\tahom  a.TTF');



  //end font copy



  Close;

 

من این برنامه را نوشتم
ولی مشکل داره کسی می تونه به من بگه
چطوری چک کنم اگه فونت هست دیگه نصبش نکنه

[m-khorsandi]

تا اینجا رو که از تابع FileCopy استفاده کردی، برای چک کردن وجود فایل هم از FileExists استفاده کن.

[ealvandi]

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

کد پیغام رو لطف کنید.

[MNosouhi]

procedure AddFont(FontFile : string);

var

  DestFile : string;

  FontDir : string;

begin

  //Find Fonts directory

  SetLength(FontDir,Max_Path);

  GetWindowsDirectory(PAnsiChar(FontDir),Max_Path);

  SetLength(FontDir, StrLen(PAnsiChar(FontDir)));

  FontDir := FontDir + '\Fonts\';

  //Copy font file to the Fonts directory

  DestFile := FontDir + ExtractFileName(FontFile);

  CopyFile(PAnsiChar(FontFile),PAnsiChar(DestFile),T  rue);

  //True-Type fonts need a header file to be created before adding them to system

  if ExtractFileExt(FontFile) = '.ttf' then

    //Create the header file (.fot)

    CreateScalableFontResource(0,

                               PAnsiChar(Copy(DestFile,1,Length(DestFile) - 3) + 'fot'),

                               PAnsiChar(DestFile),

                               nil);

  //Add font to system

  AddFontResource(PAnsiChar(DestFile));

  //Notify other windows about new font

  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);

end;

[Valadi]

procedure AddFont(FontFile : string);

var

  DestFile : string;

  FontDir : string;

begin

  //Find Fonts directory

  SetLength(FontDir,Max_Path);

  GetWindowsDirectory(PAnsiChar(FontDir),Max_Path);

  SetLength(FontDir, StrLen(PAnsiChar(FontDir)));

  FontDir := FontDir + '\Fonts\';

  //Copy font file to the Fonts directory

  DestFile := FontDir + ExtractFileName(FontFile);

  CopyFile(PAnsiChar(FontFile),PAnsiChar(DestFile),T  rue);

  //True-Type fonts need a header file to be created before adding them to system

  if ExtractFileExt(FontFile) = '.ttf' then

    //Create the header file (.fot)

    CreateScalableFontResource(0,

                               PAnsiChar(Copy(DestFile,1,Length(DestFile) - 3) + 'fot'),

                               PAnsiChar(DestFile),

                               nil);

  //Add font to system

  AddFontResource(PAnsiChar(DestFile));

  //Notify other windows about new font

  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);

end;

دوست عزیز این کد هیچ توضیحی نداره؟
1 - آیا فونت ها درشاخه ای از root باشه ؟

موفق وموید باشی

[MNosouhi]

دوست عزیز این کد هیچ توضیحی نداره؟
1 - آیا فونت ها درشاخه ای از root باشه ؟

???
فقط نام و مسیر فونت رو به عنوان پارامتر به تابع بدید تا فونت رو نصب کنه .

[Arman_1367]

این مثال را نگاه کن حتی نیاز به کپی کردن و ... هم نداره فقط یک API و یک پیغام به ویندوز.

Just It

انم لینکش:
کلیک کن دانلود کن