| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Формат ico. [D7, XP]

Kur'yan29 ©   (2009-08-08 19:24:00) 

Почему когда я сохраняю иконку, некоторые теряют цвет, и становятся не похожими на оригиналы. Как мне это исправить? И какая причина ? Хочется написать программу, которая просматривает значки *.exe, *.dll файлов и сохраняет их в формате *.ico


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Image1: TImage;
   SavePictureDialog1: TSavePictureDialog;
   Edit1: TEdit;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation
function GetLongPathName(lpszLongPath: PChar; lpszShortPath: PChar;
cchBuffer: DWORD): DWORD; stdcall; external kernel32 name 'GetLongPathNameA';
{$R *.dfm}
function GetFileIcon(filename: String; small: Boolean = False ): HICON;
var
 info: SHFILEINFO;
 flags: Cardinal;
begin
 flags := SHGFI_ICON;
 ZeroMemory(Addr(info), SizeOf(info));
 //Получение иконки
 SHGetFileInfo(PAnsiChar(filename), 0, info, SizeOf(info), flags);
 GetFileIcon := info.hIcon;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus ;
image1.Picture.Icon.Handle := GetFileIcon(PChar(Edit1.Text));
if Edit1.GetTextLen = 0
then
begin
MessageBeep(40000);
ShowMessage('Введите полный путь к  *.exe.(dll) файлу, например - (С:\Windows\explorer.exe).');
exit ;
end;
image1.Picture.Icon.Handle := GetFileIcon(PChar(Edit1.Text));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
FileName: String;
begin
if SavePictureDialog1.Execute = True then
begin
 try
FileName := SavePictureDialog1.FileName;
Form1.Image1.Picture.SaveToFile(FileName);
 finally
end;
end;
 end;
end.

---

Dennis I. Komarov   (2009-08-10 10:02:00) [1]

InternalGetDIBSizes(IconInfo.hbmCol or, ColorInfoSize, ColorBitsSize, 16);
InternalGetDIB(IconInfo.hbmColor, 0, ColorInfo^, ColorBits^, 16);

---

Игорь   (2009-08-08 21:03:00) [2]

Посмотри здесь http://rouse.drkb.ru/components.php#fwiconex

---

DVM   (2009-08-08 19:29:00) [3]

> Как мне это исправить? И какая причина ?

вот причина:

> Form1. Image1.Picture.SaveToFile(FileName);

---

Наверх