Форум: "Начинающим";
Текущий архив: 2009.10.11;
Скачать: [xml.tar.bz2];
ВнизФормат ico. Найти похожие ветки
← →
Kur'yan29 (2009-08-08 19:24) [0]Почему когда я сохраняю иконку, некоторые теряют цвет, и становятся не похожими на оригиналы. Как мне это исправить? И какая причина ? Хочется написать программу, которая просматривает значки *.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.
← →
DVM © (2009-08-08 19:29) [1]
> Как мне это исправить? И какая причина ?
вот причина:
>Form1.Image1.Picture.SaveToFile(FileName);
← →
Игорь © (2009-08-08 21:03) [2]Посмотри здесь http://rouse.drkb.ru/components.php#fwiconex
← →
Dennis I. Komarov © (2009-08-10 10:02) [3]
InternalGetDIBSizes(IconInfo.hbmCol or, ColorInfoSize, ColorBitsSize, 16);
InternalGetDIB(IconInfo.hbmColor, 0, ColorInfo^, ColorBits^, 16);
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2009.10.11;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.005 c