Показать сообщение отдельно

  #8  
Старый 23.06.2009, 11:44
Fliplab
Участник форума
Регистрация: 29.07.2008
Сообщений: 128
Провел на форуме:
225836

Репутация: 34
По умолчанию

Код:
unit UExtractIcon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellApi, ExtCtrls, ComCtrls, Buttons;

type
  TFormExtractIcon = class(TForm)
    BitBtnOpen: TBitBtn;
    BitBtnSave: TBitBtn;
    ButtonReLoad: TButton;
    UpDownIconIndex: TUpDown;
    OpenDialogIcon: TOpenDialog;
    SaveDialogIcon: TSaveDialog;
    ImageIcon: TImage;
    EditIconIndex: TEdit;
    LabelIconIndex: TLabel;
    LabelIcon: TLabel;
    LabelFileName: TLabel;
    BevelIcon: TBevel;
    procedure OpenIconClick(Sender: TObject);
    procedure SaveIconClick(Sender: TObject);
    procedure LoadIconFromFile;
    procedure ButtonReLoadClick(Sender: TObject);
    procedure EditIconIndexKeyPress(Sender: TObject; var Key: Char);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormExtractIcon: TFormExtractIcon;

implementation

{$R *.DFM}

{ExtractIconResInfo}

var
  Bitmap   : TBitmap;
  IconSave : TIcon;
  FullDir  : String;
  IconIndex: Word;

procedure TFormExtractIcon.LoadIconFromFile;
var
  Pch: array[0..256] of Char;
  IconExtr: HIcon;
begin
  IconIndex := StrToInt(EditIconIndex.Text);
  FullDir := OpenDialogIcon.FileName;
  StrPCopy(Pch,FullDir);
  IconExtr := ExtractAssociatedIcon(hInstance,Pch,IconINdex);
  IconSave.Handle := IconExtr;
  Bitmap.Width := IconSave.Width;
  Bitmap.Height := IconSave.Height;
  Bitmap.Canvas.Draw(0, 0, IconSave);
  ImageIcon.Picture.Icon := IconSave;
  BitBtnSave.Enabled := True;
  ButtonReLoad.Enabled := True;
  LabelFileName.Caption := 'Файл: '+ExtractFileName(FullDir);
  SaveDialogIcon.InitialDir := ExtractFilePath(FullDir);
  SaveDialogIcon.FileName := '';
end;

procedure TFormExtractIcon.OpenIconClick(Sender: TObject);
begin
  if OpenDialogIcon.Execute then
    LoadIconFromFile;
end;

procedure TFormExtractIcon.SaveIconClick(Sender: TObject);
const
  SaveBoolean:Boolean = False;
begin
{SaveDialogIcon.FileName := ChangeFileExt(ExtractFileName(FullDir),'');}
  if SaveDialogIcon.Execute then begin
    case SaveDialogIcon.FilterIndex of
      1: IconSave.SaveToFile(ChangeFileExt(SaveDialogIcon.FileName,'.ico'));
      2: Bitmap.SaveToFile(ChangeFileExt(SaveDialogIcon.FileName,'.bmp'));
    end;
    SaveDialogIcon.InitialDir := ExtractFilePath(SaveDialogIcon.FileName);
  end;
end;

procedure TFormExtractIcon.ButtonReLoadClick(Sender: TObject);
begin
  LoadIconFromFile;
end;

procedure TFormExtractIcon.EditIconIndexKeyPress(Sender: TObject;
  var Key: Char);
begin
  if not (Key in ['0'..'9',#8]) then
    key := #0;
end;

procedure TFormExtractIcon.FormActivate(Sender: TObject);
begin
//  IconSave.Free;
  IconSave := TIcon.Create;
//  Bitmap.Free;
  Bitmap := TBitmap.Create;
end;

end.
Так тащи иконки, дальше пихай в exe
 
Ответить с цитированием