::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2008-11-27 14:16:33, Hit : 7459, Vote : 1382
 http://www.howto.pe.kr
 실행 파일의 아이콘 바꾸기

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TIconResInfo =packed record
    Width   : Byte;
    Height  : Byte;
    Colors  : Word;
    Plane   : Word;
    BitCount: Word;
    DIBSize : DWord;
    ID      : Word;
  end;
  PIconResInfo =^TIconResInfo;

  TResourceName =packed record
    FString: Boolean;
    RTID  : PChar;
    RTName: string;
  end;
  PResourceName =^TResourceName;

  TCursorOrIcon = packed record
    Reserved: Word;
    wType: Word;
    Count: Word;
  end;
  PCursorOrIcon = ^TCursorOrIcon;

  TIconRec = packed record
    Width: Byte;
    Height: Byte;
    Colors: Word;
    Reserved1: Word;
    Reserved2: Word;
    DIBSize: Longint;
    DIBOffset: Longint;
  end;
  PIconRec = ^TIconRec;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  
implementation

{$R *.dfm}

function MAKELANGID(p, s: Word):DWORD;
begin
  Result := (s shl 10) or p;
end;

function SwitchResourceIcon(ExeName, IconName: string; Resname: PChar):Boolean;
const
  sizeCI  = Sizeof(TCursororIcon);
  sizeIR  = Sizeof(TIconRec);
var
  hUpdate: THandle;
  ms: TMemoryStream;
  fs: TFileStream;
  Buf: PByteArray;
  i: integer;
  pInfo: PIconRec;
  CI: TCursororIcon;
  IR: array of TIconResInfo;
begin
  Result := False;
  if not FileExists(Exename) then
  begin
    MessageDlg('변경할 실행 파일이 존재하지 않습니다', mtWarning, [MBOK], 0);
    Exit;
  end;
  if not FileExists(Iconname) then
  begin
    MessageDlg('아이콘 파일이 존재하지 않습니다', mtWarning, [MBOK], 0);
    Exit;
  end;

  // Open the file to which you want to add the ICON resource.
  hUpdate := BeginUpdateResource(PChar(ExeName), True);
  if hUpdate = 0 then Exit;

  fs := TFileStream.Create(IconName, fmOpenRead);
  try
    Buf := AllocMem(fs.Size);
    try
     fs.ReadBuffer(Buf^, fs.Size);
     CI.Reserved := 0;
     CI.wType    := 1;
     CI.Count    := PCursororIcon(Buf).Count;

     SetLength(IR, CI.Count);

     for i := 0 to CI.Count -1 do
     begin
       pInfo := @Buf[sizeCI + sizeIR * i];
       IR[i].Width    := pInfo.Width;
       IR[i].Height   := pInfo.Height;
       IR[i].Colors   := pInfo.Colors;
       IR[i].Plane    := pInfo.Reserved1;
       IR[i].BitCount := pInfo.Reserved2;
       IR[i].DIBSize  := pInfo.DIBSize;
       IR[i].ID       := i;

       UpdateResource(hUpdate, // update resource handle
                      RT_ICON, // change dialog box resource
                      PChar(i),
                      LANG_SYSTEM_DEFAULT{MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL)}, // neutral language
                      @Buf[pInfo.DIBOffset], // ptr to resource info
                      pInfo.DIBSize); // size of resource info
     end;

     ms := TMemoryStream.Create;
     try
       ms.WriteBuffer(CI, sizeCI);
       ms.WriteBuffer(IR[0], sizeIR * CI.Count);
       if not UpdateResource(hUpdate,
                             RT_GROUP_ICON, Resname,
                             LANG_SYSTEM_DEFAULT{MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL)},
                             ms.Memory,
                             ms.Size) then
         Exit;

       if EndUpdateResource(hUpdate, False) then
         Result :=True;
     finally
       ms.Free;
     end;
    finally
      FreeMem(Buf);
    end;
  finally
    fs.Free;
  end;
end;

function EnumResNameProc(hFile: THandle; ResType: PChar;
                         ResStr: PChar; pResname: PResourceName):LongBool; stdcall;
begin
  if HiWord(Cardinal(ResStr)) =0 then
  begin
    pResName^.RTID    := ResStr;
    pResName^.FString := False;
  end
  else begin
    pResName^.RTName  := ResStr;
    pResName^.FString := True;
  end;

  Result :=False;
end;

function ChangeExeIcon(Exename, IconName :string; Backup: Boolean):boolean;
var
  hFile  : THandle;
  ResName :TResourceName;
  BakeupName: string;
begin
  if Backup then
  begin
    BakeupName := ExeName + '.bak';
    if FileExists(Bakeupname) then
    begin
      MessageDlg('백업할 파일('+BakeupName+')이 이미 존재합니다', mtWarning, [MBOK], 0);
      Exit;
    end;
    CopyFile(PChar(ExeName), PChar(BakeupName), True);
  end;

  // Load the source exe from where we need the icon
  hFile := LoadLibraryEx(PChar(ExeName), 0,
                         LOAD_LIBRARY_AS_DATAFILE or
                         LOAD_WITH_ALTERED_SEARCH_PATH);
  try
    if hFile <> 0 then
      EnumResourceNames(hFile, RT_GROUP_ICON, @EnumResNameProc, LPARAM(@Resname));
  finally
    FreeLibrary(hFile);
  end;

  if ResName.FString then
    ResName.RTID := PChar(ResName.RTName);
  
  Result := SwitchResourceIcon(Exename, IconName, ResName.RTID);
end;


procedure TForm1.Button1Click(Sender: TObject);
const
  eName ='c:\zzz\Project1.exe'; // 변경할 실행 파일 (실행중일 파일은 안됨)
  iName ='c:\zzz\program.ico';  // 아이콘 파일
begin
  if ChangeExeIcon(eName, iName, True) then
    ShowMessage('ok')
  else
    ShowMessage('fail');
end;

end.





971   [윈도우즈 API] 작업 표시줄에 보이는 프로그램의 아이콘 정보  김영대 2008/12/09 5960 1438
  [윈도우즈 API] 실행 파일의 아이콘 바꾸기  김영대 2008/11/27 7459 1382
969   [네트웍/인터넷] TClientSocket 에 Local IP 바인딩하기  김영대 2008/11/25 6253 1502
968   [알고리즘] Boyer-Moore-Horspool Text Searching  김영대 2008/11/24 5012 1349
967   [일반/컴포넌트] Tab, Shift+Tab 키 이벤트 사용하기  김영대 2008/11/21 4887 1386
966   [일반/컴포넌트] TStringList vs. THashedStringList  김영대 2008/11/04 5198 1371
965   [시스템] 프로세스가 원도우즈 원격 터미널에서 실행중인지 검사  김영대 2008/11/04 5174 1477
964   [시스템] 원도우즈 도메인 이름 구하기  김영대 2008/11/04 5699 1347
963   [시스템] 사용중인 USB 포트의 장치정보 구하기  김영대 2008/11/04 11663 1459
962   [일반/컴포넌트] Treeview의 수평 스크롤바 감추고 스크롤 막기  김영대 2006/03/22 5428 1235
961   [윈도우즈 API] 바탕화면의 모든 창 최소화하기  김영대 2006/02/28 5370 1286
960   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageBox  김영대 2006/02/28 6410 1599
959   [시스템] System의 Idle 상태를 알아내는 API  김영대 2006/02/28 6042 1441
958   [일반/컴포넌트] ListBox에 Edit 올려 항목 편집하기  김영대 2006/02/28 4759 1206
957   [일반/컴포넌트] 폼 흔들기  김영대 2006/02/28 5227 1194
956   [일반/컴포넌트] 마우스로 ProgressBar의 Position 바꾸기  김영대 2006/02/28 4805 1249
955   [일반/컴포넌트] ListBox 드래그하여 아이템 이동하기  김영대 2006/02/28 4852 1181
954   [시스템] 폼의 Move/Resize 시작,종료 이벤트 감지하기  김영대 2006/02/28 5139 1354
953   [COM/OLE] IE의 속성을 변경하여 뛰우기  김영대 2006/02/28 5224 1226
952   [윈도우즈 API] 세로 글꼴 제거한 FontDialog  김영대 2006/02/28 5126 1344
951   [시스템] CPU 이름 구하기2  김영대 2005/09/13 5596 1343
950   [네트웍/인터넷] IP Helper API 를 이용한 네트워크 카드 Enable/Disable 시키기  김영대 2005/09/10 6019 1314
949   [일반/컴포넌트] 폼에 자석효과 주기 (Delphi 6 이하)  김영대 2005/08/04 5962 1292
948   [일반/컴포넌트] 객체의 valid검사 Assigned() 대체  김영대 2005/07/29 4717 1246
947   [시스템] 시스템 대기모드/화면 보호기/모니터 끄기 이벤트 감지하기  김영대 2005/07/21 6752 1482
946   [시스템] 윈도우즈 GUI 기본 폰트정보 구하기  김영대 2005/07/14 5428 1346
945   [시스템] 윈도우즈 입력도구모음의 한/영 토글하기  김영대 2005/06/24 5218 1372
944   [COM/OLE] ActiveForm의 OnDestroy 대용  김영대 2005/04/21 5237 1226
943   [일반/컴포넌트] ListView의 타이틀 폰트 바꾸기  김영대 2005/03/31 5152 1233
942   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageDlg/ShowMessage  김영대 2005/03/26 5820 1268
941   [일반/컴포넌트] 프로그램의 bitmap을 MS 그림판으로 편집하여 다시 불러오기  김영대 2005/03/22 5152 1323
940   [일반/컴포넌트] RichEdit 2.0 줄간격 조정  김영대 2005/02/11 7191 1270
939   [COM/OLE] 탐색기에서 파일을 선택하여 ActiveX(ActiveFortm)에 Drag&Drop 하기  김영대 2005/01/06 7529 1267
938   [윈도우즈 API] TDownloadURL를 사용한 파일 다운받기  김영대 2004/12/26 6365 1262
937   [COM/OLE] TWebBrowser에 직접 HTML 소스코드 넣기  김영대 2004/12/26 6017 1266
936   [윈도우즈 API] 윈도우즈 시스템 전체에서 사용자의 마우스와 키보드 입력이 있는지 검사하기  김영대 2004/12/26 6038 1350
935   [일반/컴포넌트] 다이얼로그 박스가 이미 떠있는지 검사하여 강제로 닫기  김영대 2004/12/22 5030 1212
934   [윈도우즈 API] URLDownloadToFile()를 사용한 파일 다운받기  김영대 2004/12/15 7615 1383
933   [COM/OLE] 내 프로그램에서 선택한 text를 다른 프로그램에 Drag&Drop으로 주기  김영대 2004/12/10 5359 1099
932   [COM/OLE] 다른 프로그램에서 선택한 text를 내 프로그램에서 Drag&Drop으로 받기  김영대 2004/12/09 5503 1206

1 [2][3][4][5][6][7][8][9][10]..[25] [다음 10개]
 

Copyright 1999-2017 Zeroboard / skin by zero