easyDelphi Q&A
+3 تصويتات
69 مشاهدات

اريد عمل برنامج بالدلفي لتغير ايقونة اي برنامج
أريد من خلال OpenDialog1 تحديد برنامج وتغير أيقونته بالايقونة الموجودة على Image

سُئل بواسطة (5,760 نقاط)
عُدل بواسطة | 69 مشاهدات
 

4 إجابة

+1 تصويت
أفضل إجابة

هذه Unit يمكن استخدلمها لتغيير لكنها ليسة جيدة ... لانه يغير بعض البرامج فقط .

 

unit iconchanger;


interface

uses windows;

  type
    PICONDIRENTRYCOMMON = ^ICONDIRENTRYCOMMON;
    ICONDIRENTRYCOMMON = packed record
    bWidth             : Byte;  // Width, in pixels, of the image
    bHeight            : Byte;  // Height, in pixels, of the image
    bColorCount        : Byte;  // Number of colors in image (0 if >=8bpp)
    bReserved          : Byte;  // Reserved ( must be 0)
    wPlanes            : Word;  // Color Planes
    wBitCount          : Word;  // Bits per pixel
    dwBytesInRes       : DWord; // How many bytes in this resource?
    end;

    PICONDIRENTRY      = ^ICONDIRENTRY;
    ICONDIRENTRY       = packed record
    common             : ICONDIRENTRYCOMMON;
    dwImageOffset      : DWord; // Where in the file is this image?
    end;

    PICONDIR           = ^ICONDIR;
    ICONDIR            = packed record
    idReserved         : Word; // Reserved (must be 0)
    idType             : Word; // Resource Type (1 for icons)
    idCount            : Word; // How many images?
    idEntries          : ICONDIRENTRY; // An entry for each image (idCount of 'em)
    end;

    PGRPICONDIRENTRY   = ^GRPICONDIRENTRY;
    GRPICONDIRENTRY    = packed record
    common             : ICONDIRENTRYCOMMON;
    nID                : Word;  // the ID
    end;

    PGRPICONDIR        = ^GRPICONDIR;
    GRPICONDIR         = packed record
    idReserved         : Word; // Reserved (must be 0)
    idType             : Word; // Resource type (1 for icons)
    idCount            : Word; // How many images?
    idEntries          : GRPICONDIRENTRY;  // The entries for each image
    end;

function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;

implementation

function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
var hFile  : Integer;
    id     : ICONDIR;
    pid    : PICONDIR;
    pgid   : PGRPICONDIR;
    uRead  : DWord;
    nSize  : DWord;
    pvFile : PByte;
    hInst  : LongInt;
begin
result := False;
hFile := CreateFile(srcicon, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile > 0 then
   begin
   ReadFile(hFile, id, sizeof(id), uRead, nil);
   SetFilePointer(hFile, 0, nil, FILE_BEGIN);
   GetMem(pid, sizeof(ICONDIR) + sizeof(ICONDIRENTRY));
   GetMem(pgid, sizeof(GRPICONDIR) + sizeof(GRPICONDIRENTRY));

   ReadFile(hFile, pid^, sizeof(ICONDIR) + sizeof(ICONDIRENTRY), uRead, nil);
   move(pid^, pgid^, sizeof(GRPICONDIR));

   pgid^.idEntries.common := pid^.idEntries.common;
   pgid^.idEntries.nID := 1;
   nSize := pid^.idEntries.common.dwBytesInRes;

   GetMem(pvFile, nSize);
   SetFilePointer(hFile, pid^.idEntries.dwImageOffset, nil, FILE_BEGIN);
   ReadFile(hFile, pvFile^, nSize, uRead, nil);
   CloseHandle(hFile);

   hInst:=BeginUpdateResource(destexe, False);
   if hInst > 0 then
      begin
      UpdateResource(hInst, RT_ICON, MAKEINTRESOURCE(1), LANG_NEUTRAL, pvFile, nSize);
      EndUpdateResource(hInst, False);
      result := True;
      end;

   FreeMem(pvFile);
   FreeMem(pgid);
   FreeMem(pid);
   end;
end;

end.

 

تم الرد عليه بواسطة (5,760 نقاط)
مختارة بواسطة
تم تحويل تعليقك لإجابة
+1 تصويت
begin
  //Get Exe icon
  Image1.Picture.Icon.Assign(Application.Icon)
  //Set icon from Image object 
  Application.Icon.Assign(Image1.Picture.Icon)
End;

 

تم الرد عليه بواسطة (6,370 نقاط)
لا ليس بعد ... المشكل هو كيف اغير الايقونة للبرنامج
اعطيني مثال . إلى الان لم افهم . تريد تغير ايقونة اي برنامج ام برنامج معين ام ايقونة مسنتد لبرنامج معين ؟
كلهما وضع كود لجلب الايقونة  ولكن  أريد كود لتغير الايقونة .
أريد من خلال OpenDialog1 تحديد برنامج وتغير أيقونته بالايقونة الموجودة على Image
ساضيف هذا التعليق في شرح السؤال .
وساجيبك على مرحلتين .
+1 تصويت
uses shellapi;
procedure TForm2.Button1Click(Sender: TObject);
var
  IconIndex: word;
  Buffer: array[0..2048] of char;
  IconHandle: HIcon;
begin
  StrCopy(@Buffer, PChar('c:\windows\system32\calc.exe'));
  IconIndex := 0;
  IconHandle := ExtractAssociatedIcon(HInstance, Buffer, IconIndex);
  if IconHandle <> 0 then
    Icon.Handle := IconHandle;

Image1.Picture.Icon.Handle := IconHandle;
end;
تم الرد عليه بواسطة (1,630 نقاط)
عُدل بواسطة
المشكل في تغير الايقونة وليس في جلبها فقط ... أجابتك ناقصة
+1 تصويت
ملفات الـ exe  ايقونتها موجودة بداخلها. في الـ resource بداخله. فتعديلها يعني تعديل الملف الـ exe نفسه . وهذه الايقونة التي ياخذها الويندوز ويعرضها .
بالنسبة لملفات البيانات ( مثل ملف docx ) .. هذه ملفات ليست exe . لكنها تابعة لبرنامج ما . هذه ايقونتها تكون من اكثر من مصدر . قد تكون في ملف الـ exe نفسه للبرنامج . وقد تكون في ملفات dll مع البرنامج وقد تكون ملف icon منفرد .

الويندوز يعرف اي ايقونة يستخدم من الـ registry . بداخل مسجل ومحدد اي ايقونة يستخدمها لكل برنامج .

سأجيبك بجواب مفصل اكثر في اجابة اخرى . لكن مبدأيا . يمكنك البدأ بهذه المعلومات .
تم الرد عليه بواسطة (15,060 نقاط)
هذه العلومات  أعرفها .. وشكرا على التاكيد ... وانا طرحت في سؤالي وقلت برنامج  بمعنى Exe ... اتمنى ان تجيب بتفصل حول هذا الموضوع .
سأجيبك . لكن اعطني وقت . اريد التاكد من بعض الامور اولا . لا اريد جاوب غير دقيق
خذ كل الوقت المهم تكون اجابة دقيقة

اسئلة متعلقة

+3 تصويتات
2 إجابة
سُئل يوليو 30 في تصنيف Delphi بواسطة Amar Gozim (5,760 نقاط) | 65 مشاهدات
+3 تصويتات
1 إجابة
سُئل يوليو 23 في تصنيف Delphi بواسطة Amar Gozim (5,760 نقاط) | 24 مشاهدات
+2 تصويتات
1 إجابة
سُئل يوليو 31 في تصنيف vcl بواسطة mohsen alahmad (140 نقاط) | 46 مشاهدات
+2 تصويتات
2 إجابة
+1 تصويت
1 إجابة
سُئل يوليو 21 في تصنيف Delphi بواسطة Amar Gozim (5,760 نقاط) | 30 مشاهدات
ادعُ اصدقائك في الفايسبوك لمشاركتك

مرحبًا بك إلى EasyDelphi Q&A، حيث يمكنك طرح الأسئلة والحصول على الإجابة عليها من المستخدمين الآخرين.

لا يسمح بطلب او السؤال عن كراك او تفعيل او كسر او فك او اي شيء يخالف اتفاقيات الترخيص  مهما كان السبب ومهما كان البرنامج ونوعه. ولا حتى نشر روابط تحتوي على مثل هذه الاشياء لا في الاسئلة ولا في الاجابات ولا التعليقات . نهائيا

207 سؤال
391 إجابة
682 تعليق
118 مستخدم