Помогите, пожалуйста, написать процедуру для сохранения выбранной пиктограммы в отдельном файле на диске (.*ico),
| Код |
f_open:boolean;
IcoH:hIcon;
implementation
{$R *.dfm}
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if not f_open then exit;
if StringGrid1.Objects[ACol,ARow] is TIcon then
StringGrid1.Canvas.Draw(rect.Left+56,Rect.Top+24,TIcon(StringGrid1.Objects[ACol,ARow]));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
f_open:=false;
end;
procedure TForm1.Button2Click(Sender: TObject);
var pName : array[0..255] of char;
fName:string[13];
N:word;
CurItem: LongInt;
begin
with OpenDialog1 do
begin
if not Execute then exit;
f_open:=true;
fName:=ExtractFileName(FileName);
StrPCopy(pName,FileName);
end;
CurItem:=0;
N:=0;
StringGrid1.Col:=0;
StringGrid1.Row:=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;
|
Вот что мне удалось сделать. Открытие любого пиктораммы и затем ее сохранение. Но мне нужно бы, чтобы при выборе ячейки и нажатия на кнопку сохранить, происходило сохранение иконки.
| Код |
[c/ode=delphi]
procedure TForm1.Button1Click(Sender: TObject);
var
s : string;
Icon: TIcon;
begin
OpenDialog1.DefaultExt := '.ICO';
OpenDialog1.Filter := 'icons (*.ico)|*.ICO';
OpenDialog1.Options := [ofOverwritePrompt, ofFileMustExist, ofHideReadOnly ];
if OpenDialog1.Execute then
begin
Icon := TIcon.Create;
try
icon.Loadfromfile(OpenDialog1.FileName);
s:= ChangeFileExt(OpenDialog1.FileName,'.BMP');
Image1.Width := Icon.Width;
Image1.Height := Icon.Height;
Image1.Canvas.Draw(0,0,Icon);
Image1.Picture.SaveToFile(s);
ShowMessage(OpenDialog1.FileName + ' Saved to ' + s);
finally
Icon.Free;
end;
end;
end;
|
[/code] |
)