Сперва необходимо узнать, константы, которые соответствуют определённым иконкам. Все они определены в API unit (windows.pas) в Delphi:
* IDI_HAND
* IDI_EXCLAMATION
* IDI_QUESTION
Следующий пример рисует иконку вопроса на панели:
var
DC: HDC;
Icon: HICON;
begin
DC := GetWindowDC(Panel1.Handle);
Icon := LoadIcon(0, IDI_QUESTION);
DrawIcon(DC, 5, 5, Icon);
ReleaseDC(Panel1.Handle, DC);
end;
unit AnimIcon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ShellApi, TypInfo;
const
WM_FROMTRAYICON = WM_USER + 59;
type
TIconPlace = (ipAppIcon, ipAppMainFormIcon, ipFormIcon, ipImageCtrl,
ipSysTray);
TOnTimerEventOrder = (First, Second);
TIconPlaceSet = set of TIconPlace;
TTimerEvent = procedure(Sender: TObject) of object;
TAnimIcon = class(TImageList)
private
{ Private declarations }
FIconPlaceSet: TIconPlaceSet;
FEnabled: Boolean;
FInterval: Cardinal;
FNumIco: Integer;
FOnTimer: TTimerEvent;
FImage: TImage;
FAuthor: string;
FTip: string; Read more »
Приходит программист в магазин. Там продавщица - полная такая тетенька. Программист (меланхолично оглядевшись):
- Бутылку пива и пачку презервативов. Продавщица:
- Это ты девушку охмурить бутылкой пива собрался? Вино надо дорогое покупать…. Программист (отрешенно):
- Да нет. Пиво я выпью, когда она уйдет.
uses
ShellAPI;
…
procedure TForm1.Button1Click(Sender: TObject);
var
Icon: hIcon;
IconIndex: word;
begin
IconIndex := 1;
Icon := ExtractAssociatedIcon(HInstance,
Application.ExeName, IconIndex);
DrawIcon(Canvas.Handle, 10, 10, Icon);
end;
Суть вопроса: я столкнулся с проблемой сохранения полноцветных иконок, когда понадобилось немного изменить имеющиеся у меня для своих программ. Ни родной Image Editor от Delphi6, ни другие редакторы не смогли мне помочь. Могли это делать платные редакторы, но они не для нас. Начав разбираться, я обнаружил, что созданная функцией CreateIconIndirect иконка нормально выглядит, если после создания ее кинуть на форму, однако после записи Icon.SaveToFile иконка обезображивается. Это происходит на стадии записи иконки. Поискав информацию, облазив форумы, я понял, что либо этой проблемой никто не занимался, либо с ней все мирятся и заниматься не хотят, хотя интересующиеся имеются.
Read more »
Вот небольшой пример того, как можно загрузить иконку, содержащуюся в файле EXE, в Glyph у SpeedButton, и как очистить этот самый Glyph.
Огорчен, но комментарии в исходном коде на испанском языке.
unit Procs;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, StdCtrls, Buttons, ExtCtrls, ShellAPI;
procedure LlenaBoton(boton: TSpeedButton; Programa: string);
procedure LimpiaBoton(boton: TSpeedButton);
Read more »
{
First Start Notepad.exe and run this code:
Starte zuerst Notepad.exe und fьhre dann diesen Code aus:
}
procedure TForm1.Button1Click(Sender: TObject);
var
hwindow : THandle;
H: HIcon;
begin
hwindow := FindWindow(’notepad’,nil);
H := CopyIcon(GetClassLong(hwindow, GCL_HICON ));
DrawIcon(Canvas.Handle, 30, 30, H);
end;
Процесс получения иконок из .EXE, .DLL или .ICO файлов полностью идентичен. Различие только в том, что в .ICO файле может храниться только одна иконка, а в .EXE и .DLL несколько. Для получения иконок из файлов, в модуле ShellAPI, есть функция:
function ExtractIcon(Inst: THandle; FileName: PChar; IconIndex: Word): HIcon;
где
Inst
указатель на приложение вызвавшее функцию,
FileName
имя файла из которого необходимо получить иконку,
IconIndex
номер необходимой иконки.
Если функция возвращает значение не равное нулю, то в файле есть следующая иконка.
В данном примере в компонент Image1 выводится иконка запущенного файла.
Read more »
{
Comment:
The procedure GetAssociatedIcon, trys via Registry to get the
icon(should work for small and big icons) that is associated with
the files shown in the explorer.
This is not my work. But I want to distribute it to you, because
it was really hard to find a corresonding document.
Thanks SuperTrax.
}
{
Kommentar:
Die Prozedure GetAssociatedIcon versucht uber die Registrierung
das Icon der Datei, wie im Explorer angezeigt, herauszubekommen.
(Sollte fur grosse und kleine funktionieren)
Dies ist nicht mein Werk. Ich mochte es nur fur andere zuganglich
machen, weil ich sehr lange gebraucht habe, um ein entsprechendes
Dokument zu finden.
}
Read more »
procedure TForm1.Button1Click(Sender: TObject);
var
Icon: TIcon;
FileInfo: SHFILEINFO;
begin
Icon := TIcon.Create;
try
// Get the Icon
SHGetFileInfo(PChar(’Filename.exe’), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON);
icon.Handle := FileInfo.hIcon;
DestroyIcon(FileInfo.hIcon);
// Save the Icon to a file:
icon.SaveToFile(’IconFromExe.ico’);
// Set the Icon as Application Icon (temporary)
Application.Icon := icon;
finally
Icon.Free;
end;
end;
Функция ExtractIcon позволяет извлечь иконку из exe, dll и ico-файлов. Если указанная иконка отсутствует, функция возвращает 0. Количество иконок, содержащихся в файле, можно узнать, указав в качестве последнего параметра –1.
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
ic: TIcon;
i, count: integer;
w: integer;
begin
if OpenDialog1.Execute = false then
Exit;
Form1.Canvas.FillRect(Form1.Canvas.ClipRect);
count := ExtractIcon(Application.Handle,
PChar(OpenDialog1.FileName), -1);
ic := TIcon.Create;
w := Form1.Width div 32;
for i := 0 to count - 1 do
begin
ic.Handle := ExtractIcon(Application.Handle,
PChar(OpenDialog1.FileName), i);
Form1.Canvas.Draw(32 * (i mod w), 32 * (i div w), ic);
end;
ic.Destroy;
end;
function IconsAreEqual(const Icon1, Icon2: TIcon): Boolean;
var
ms1: TMemoryStream;
ms2: TMemoryStream;
begin
Result := False;
ms1 := TMemoryStream.Create;
try
Icon1.SaveToStream(ms1);
ms2 := TMemoryStream.Create;
try
Icon2.SaveToStream(ms2);
if ms1.Size = ms2.Size then
// Compare the streams, Streams vergleichen:
Result := CompareMem(ms1.Memory, ms2.Memory, ms1.Size)
finally
ms2.Free
end
finally
ms1.Free
end
end;
Read more »
А мне постоянно хочется передвинуть иконки телеканалов подалье в игол, чтобы не мешались :))) а иногда floating для них выключить.
Изменять иконку приложения или окна достаточно просто - для этого у TApplication и TForm предусмотрено свойство Icon. Смена иконки может вестись обычным присвоением свойству Icon нового значения:
Form1.Icon := Image1.Picture.Icon;
При этом происходит не присвоение указателя (как казалось бы), а копирование данных посредством вызова Assign, который производится в методе TForm.SetIcon
Загрузка иконки из ресурса
Загрузка производится типовым вызовом API:
Form1.Icon.Handle := LoadIcon(hInstance, ‘имя иконки в ресурсе’);
Увидев анимацию на форме, мы не удивимся, но сейчас нам предстоит освоить более сложную технологию: мы попытаемся анимировать иконку приложения, ту самую, которая находится на панели задач на кнопке нашего exe-файла!
Сначала нужно будет создать каждый кадр потенциального анимационного клипа. Для этого запустим утилиту “Image Editor”, которая в ходит в стандартный пакет Delphi. Запустить её можно одноимённой командой из меню Tools[инструменты]. Там создаём несколько bmp-файлов размером 16х16.
После чего возвращаемся в Delphi и выносим на форму компонент класса TImageList, дважды щёлкаем на нём и с помощью кнопки Add последовательно добавляем созданные кадры. В каком порядке изображения будут добавляться, в таком же порядке они затем будут выводится.
Далее выносим таймер[Timer], его свойство Interval устанавливаем в нужное значение[например - 5], и именно через заданное здесь количество миллисекунд будут меняться кадры. По событию OnTimer пишем такой код:
Read more »
StretchDraw не работает с иконками. В данной ситуации я бы поступил так: рисовал бы иконку в Timage и затем назначал изображение другому, большему Timage.
Пример кода:
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
Image1.Canvas.Draw(0, 0,
TIcon(StringGrid1.Objects
[StringGrid1.Col, StringGrid1.Row]));
Form2.Image1.Picture := Image1.Picture;
end;
{Примечание. Form2.Image1 имеет Stretch установленный
в True и размер, бОльший размера иконки в 4 раза}
Для этого достаточно текущее разрешение экрана и в соответствии с ним изменить дескриптор иконки приложения. Естественно, что Вам придется создать в ресурсах новые иконки.
Поместите следующий код в файл проекта (.DPR) Вашего приложения:
Application.Initialize;
Application.CreateForm(TForm1, Form1);
case GetDeviceCaps(GetDC(Form1.Handle), HORZRES) of
640 : Application.Icon.Handle := LoadIcon (hInstance, ‘ICON640′);
800 : Application.Icon.Handle := LoadIcon (hInstance, ‘ICON800′);
1024 : Application.Icon.Handle := LoadIcon (hInstance, ‘ICON1024′);
1280 : Application.Icon.Handle := LoadIcon (hInstance, ‘ICON1280′);
end;
Application.Run;
А по утрам я плохо загружаюсь…
Если ваша иконка хранится в компоненте Image (видимым или иным способом), вы можете написать:
Application.Icon := Image1.Picture.Icon;
Если в файле ресурса:
Application.Icon.Handle := LoadIcon(hInstance, ‘ICONNAME’);
В любом случае для форсирования показа иконки необходимо вызвать следующую функцию:
InvalidateRect(Application.Handle, NIL, True);
.. и новая иконка предстанет свету.
Иконка, расположенная в .RES-файле, должна быть видима в .EXE-файле, к примеру, при просмотре файла посредством Program Manager. Иконка, расположенная в компоненте Image, в этом случае не видна.
{How to get icon from a shortcut file ?
I have found that if you use a ListView component,
to show a list of files in any folder that contains shortcuts,
then the shortcut icons do not appear correctly -
they do not show the true icon of the application to which they relate.
However, there is a a very useful feature of SHGetFileInfo,
which is SHGFI_LINKOVERLAY. This adds the shortcut “arrow”,
which is shown in the bottom left corner of any shortcut icon.
The demo code below shows the basic use of the SHGFI_LINKOVERLAY feature.
I have added code to this demo, to distingiush between shortcut and non-shortcut files -
without this code, it will overlay the shortcut “arrow” irrespective of the file type.
To show the icon of a shortcut, the following code can be used as a demo:
Read more »
Сначала в разделе interface пишем такой код:
type ThIconArray = array[0..0] of hIcon;
type PhIconArray = ^ThIconArray;
function ExtractIconExA(lpszFile: PAnsiChar;
nIconIndex: Integer;
phiconLarge : PhIconArray;
phiconSmall: PhIconArray;
nIcons: UINT): UINT; stdcall;
external ’shell32.dll’ name ‘ExtractIconExA’;
function ExtractIconExW(lpszFile: PWideChar;
nIconIndex: Integer;
phiconLarge: PhIconArray;
phiconSmall: PhIconArray;
nIcons: UINT): UINT; stdcall;
external ’shell32.dll’ name ‘ExtractIconExW’;
Read more »
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение системной иконки, ассоциированной с файлом в данной системе
Функция позволяет получить такую же иконку любой директории или любого файла,
какую вы видите в “проводнике”. Размеры - 16 * 16 (по умолчанию) или 32 * 32
(второй параметр - itLarge)
Зависимости: Юниты VCL + ComObj, ActiveX, ShellApi, ShlObj;
Автор: Дмитрий Баранов, kda@pisem.net, Москва
Copyright: Взято из MSDN
Дата: 20 мая 2002 г.
***************************************************** }
type
TIconType = (itSmall, itLarge);
function GetIcon(const FileName: string; const IconType: TIconType = itSmall):
TIcon;
var
FileInfo: TShFileInfo;
ImageList: TImageList;
IT: DWORD;
begin
// CoInitialize; лучше - поместите вызов этой ф. в раздел initialization
IT := SHGFI_SMALLICON;
Result := TIcon.Create;
ImageList := TImageList.Create(nil);
if (IconType = itLarge) then
begin
IT := SHGFI_LARGEICON;
ImageList.Height := 32;
ImageList.Width := 32;
end;
FillChar(FileInfo, Sizeof(FileInfo), #0);
ImageList.ShareImages := true;
ImageList.Handle := SHGetFileInfo(
PChar(FileName),
SFGAO_SHARE,
FileInfo,
sizeof(FileInfo),
IT or SHGFI_SYSICONINDEX
);
ImageList.GetIcon(FileInfo.iIcon, Result);
ImageList.Free;
{ Не забывайте освободить полученную иконку }
end;
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
Icon: TIcon;
begin
Self.Icon := GetIcon(’C:\’);
end;
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение иконки для зарегистрированного расширения по его имени
Функции в качестве параметра передаётся имя файла и в случае удачного выполнения
она (функция) возвращает handle’р иконки (HICON). В случае, если в реестре небыло
найдено расширения предложеного файла, функция возвращает 0.
Также при успешном выполнении необходимо освободить хендлер. Для этого используется
функция DestroyIcon(Handle:HICON).
Зависимости: модуль Registry, модуль ShellAPI, модуль SysUtils и стандартные
функции Pos, Delete, Copy, ExtractFileExt, ExtractIcon, StrToInt.
Автор: Poirot, poirot@rol.ru, Нижний Новгород
Copyright: Poirot (частично из Delphi 5. Руководство разработчика)
Дата: 16 июня 2002 г.
***************************************************** }
Read more »
DrawIcon(Image1.Canvas.Handle, 0, 0, LoadCursor(0, IDC_ARROW));
{
I want to combine 2 icons like Windows does with
the links (the small arrow).
Can anyone tell me how that works?
}
function CombineIcons(FrontIcon, BackIcon: HIcon): HIcon;
var
WinDC: HDC;
FrontInfo: TIconInfo;
FrontDC: HDC;
FrontSv: HBITMAP;
BackInfo: TIconInfo;
BackDC: HDC;
BackSv: HBITMAP;
BmpObj: tagBitmap;
begin
WinDC := GetDC(0);
GetIconInfo(FrontIcon, FrontInfo);
FrontDC := CreateCompatibleDC(WinDC);
FrontSv := SelectObject(FrontDC, FrontInfo.hbmMask);
Read more »
Присвойте свойству Application.Icon другую иконку и вызовите функцию
InvalidateRect(Application.Handle, NIL, True);
… для немедленной перерисовки.