
23.12.2011, 11:34
|
Специалист
|
|
Регистрация: 07.05.2007
Адрес: Москва
Сообщения: 884
Репутация: 21699
|
|
Вот целиком пример:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, ExtCtrls;
type
TForm1 = class(TForm)
Bevel1: TBevel;
StringGrid1: TStringGrid;
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
var
CurItem: LongInt;
var
pName: array[0..255] of Char;
fName: string[13];
N: Word;
IcoH: hIcon;
begin
CurItem:= 0;
with OpenDialog1 do
begin
if not Execute then Exit;
fName:= ExtractFilename(Filename);
StrPCopy(pName, Filename);
end;
N:= 0;
with StringGrid1 do
repeat
IcoH:= ExtractIcon(hInstance, pName, N);
if IcoH <= 1 then Break;
Col:= CurItem mod ColCount;
if (CurItem div ColCount) >= RowCount then
RowCount:= RowCount + 1;
Row:= CurItem div ColCount;
Cells[Col, Row]:= fName + ' #' + IntToStr(N);
Objects[Col, Row]:= TIcon.Create;
with Objects[Col, Row] as TIcon do Handle:= IcoH;
CurItem:= CurItem + 1;
N:= N + 1;
until false;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if StringGrid1.Objects[ACol, ARow] is TIcon then
StringGrid1.Canvas.Draw(
Rect.Left + 56, Rect.Top + 24, TIcon(StringGrid1.Objects[ACol, ARow]));
end;
end.
Unit1.dfm:
Код:
object Form1: TForm1
Left = 256
Top = 106
BorderStyle = bsSingle
Caption = 'Icon Collector'
ClientHeight = 251
ClientWidth = 603
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 0
Top = 0
Width = 603
Height = 50
Align = alTop
Shape = bsFrame
end
object StringGrid1: TStringGrid
Left = 0
Top = 50
Width = 603
Height = 201
Align = alClient
ColCount = 4
DefaultColWidth = 144
DefaultRowHeight = 64
FixedCols = 0
RowCount = 4
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine]
TabOrder = 0
OnDrawCell = StringGrid1DrawCell
end
object Button1: TButton
Left = 16
Top = 12
Width = 89
Height = 25
Caption = '&Gather Icons...'
Default = True
TabOrder = 1
OnClick = Button1Click
end
object OpenDialog1: TOpenDialog
DefaultExt = 'ico'
Filter = 'All icon files|*.ico;*.exe;*.dll|All files|*.*'
Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
Title = 'Open Icon File'
Left = 208
Top = 16
end
end
Можно открыть файл moricons.dll из System32, там куча пиктограмм.
|