IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> StringGrid.Сохранение иконки .*ico, Заполнение сетки строк пиктограммами из выбранного файла
сообщение
Сообщение #1


Фанат Delphi
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской
Реальное имя: Сергей

Репутация: -  0  +


Помогите, пожалуйста, написать процедуру для сохранения выбранной пиктограммы в отдельном файле на диске (.*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;

Вот что мне удалось сделать. Открытие любого пиктораммы и затем ее сохранение. Но мне нужно бы, чтобы при выборе ячейки и нажатия на кнопку сохранить, происходило сохранение иконки.
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;

Заранее благодарен!
Вся программа прикреплена!

Сообщение отредактировано: volvo -


--------------------
ICQ (384-043-857)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Фанат Delphi
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской
Реальное имя: Сергей

Репутация: -  0  +


Вот давно уже сделал. Отписываюсь.При нажатии на кнопку сохранить, сохраняем на рабочий стол:
procedure TForm1.Button1Click(Sender: TObject);
var
s : string;
begin
with stringgrid1 do
begin
s:='D:\Documents and Settings\Administrator\Desktop\'+cells[col,row]+'.ico';
TIcon(StringGrid1.Objects[Col,Row]).SaveToFile(s);
ShowMessage(cells[col,row]+ ' Saved to ' + s);
end;
end;


--------------------
ICQ (384-043-857)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 1.10.2020 20:55
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name