main.pas.~10~

来自「用delphi编写的一个提取ICO的小工具」· ~10~ 代码 · 共 102 行

~10~
102
字号
unit main;

interface

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

type
  TForm9 = class(TForm)
    lbl1: TLabel;
    txt1: TEdit;
    btn1: TButton;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    procedure btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    imgArr:array of TImage;
    { Private declarations }
    procedure saveIcon(s:TObject);
    procedure dragFileit(var amsg:TMessage);message WM_DROPFILES;
    procedure dealIt(const filename:string);
  public
    { Public declarations }
  end;

var
  Form9: TForm9;

implementation
uses
  ShellAPI;

{$R *.dfm}

procedure TForm9.btn1Click(Sender: TObject);
var
  num:Integer;
  I: Integer;
begin
  if Length(imgArr)>0 then
    for I := Low(imgArr) to High(imgArr) do
      imgArr[i].Free;

  if dlgOpen1.Execute then
  begin
    dealIt(dlgOpen1.FileName);
  end;
end;

procedure TForm9.dealIt(const filename: string);
var
  num:Integer;
  I: Integer;
begin
  txt1.Text:=dlgOpen1.FileName;
    num:=extracticon(HInstance,PChar(FileName),$FFFFFFFF);
    if num>0 then
    begin
      SetLength(imgArr,num);
      for I := 0 to num - 1 do
      begin
        imgArr[i]:=TImage.Create(Self);
        imgArr[i].Parent:=Self;
        imgArr[i].Width:=64;
        imgArr[i].Height:=64;
        imgArr[i].Stretch:=True;
        imgArr[i].Left:=5 + (i mod 5)*65;
        imgArr[i].Top:=25 + (i div 5)*65;
        imgArr[i].Picture.Icon.Handle:=ExtractIcon(HInstance,PChar(dlgOpen1.FileName),i);
        imgArr[i].OnClick:= saveIcon;
      end;
    end;
end;

procedure TForm9.dragFileit(var amsg: TMessage);
var
  p:array[0..254] of Char;
  s:string;
begin
  DragQueryFile(amsg.WParam,0,p,255);
  s:=StrPas(p);
  dealIt(p);
end;

procedure TForm9.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Self.Handle,True);
end;

procedure TForm9.saveIcon(s: TObject);
begin
  if s is TImage then
  begin
    if dlgSave1.Execute() then
      (s as TImage).Picture.SaveToFile(dlgSave1.FileName + '.ico');
  end;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?