Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.02.06;
Скачать: CL | DM;

Вниз

Открытия окна выбора иконки...   Найти похожие ветки 

 
Митяй2   (2004-01-26 17:57) [0]

Подскажите, уже где-только не искал... :-((((

Как вызвать диалоговое окно выбора иконки из файла где их много, например как окно, похожее на окно, показываемое при изменении иконки у ярлыка на раб. столе или ещё где-то?

Наверно, очень просто.

Дмитрий.


 
Андрей Сенченко ©   (2004-01-26 18:46) [1]

не очень просто.
В первую очередь нужно узнать в каком виде храняться иконки " в тм самом файле, где их много "


 
MAxiMum   (2004-01-26 18:48) [2]

Стандартного окна такого нет... Надо ли создавать свое, либо переопределять стандартный диалог.


 
Митяй2   (2004-01-26 18:54) [3]

Иконки могут быть хоть где (*.exe, *.dll, *.icl, *.ico...)

Может есть компонент (AIconSelect скачал да не ставится собака, для D6, а у меня D7)

Есть ещё какой-нибудь компонент?
Или откуда плясать, если делать самому, какой диалог переопределять?


 
Ig ©   (2004-01-26 20:15) [4]

Я так понял, что он говорит про Shell32.dll


 
YuRock ©   (2004-01-26 20:19) [5]

Если хотите - можете сами "диалог" такой нарисовать. И через ExtractIcon выдерать из выбранного файла иконки.


 
Митяй2   (2004-01-26 20:19) [6]

Да..., только ни как не знаю с какой стороны подойти...

Подскажите с чего начать, а там разберусь...


 
Юрий Зотов ©   (2004-01-26 20:29) [7]

> Митяй2 (26.01.04 20:19) [6]

Все диалоговые компоненты - это невизуальные компоненты, динамически создающие визуальные формы. С формы и начните. А когда ее отладите, останется только написать довольно простой компонент. Примеры найдете в VCL (TOpenDialog и пр.).


 
Ig ©   (2004-01-26 20:34) [8]

Uses ShellAPI;

function ExtractIcon(Inst: THandle; FileName: PChar; IconIndex: Word): HIcon;


где

Inst
указатель на приложение которое вызывает функцию,
FileName имя файла из которого необходимо получить иконку,
IconIndex
номер необходимой иконки.
Если функция возвращает значение не равное нулю, то в файле есть иконка.


 
Митяй2   (2004-01-26 20:37) [9]

Эх, я думал проще есть решение, думал может кто-нибудь уже изобрёл "велосипед".

Не хотелось бы создавать своё (форма, туда другие компоненты ставить, потом компонент писать), хотелось бы чтобы было похоже на стандартное окно выбора иконки. В проекте эта возможность 0,001% от всех возможностей, а возни много так получается.

Пусть эта тема остается открытой...может кто подбросит сюда код или URL где можно скачать компонент.
Я буду сюда заглядывать...


 
easy ©   (2004-01-26 20:41) [10]

http://xatka.vov.ru/cgi-bin/read.pl?chapter=rsource&query=68&file=source2.txt


 
Митяй2   (2004-01-26 20:43) [11]

Спасибо, Ig.

Н,о ExtractIcon я использую уже и знаю про неё.

Вопрос в том как пользователю дать выбрать иконку (см. предыдущее сообщение)


 
YuRock ©   (2004-01-26 20:44) [12]

Вот Вам пример: на форме лежат: Button1, ListView1, OpenDialog1 и ImageList1. Свойству LargeImages у листвью поставьте ImageList1. Вот исходник модуля формы (все должно работать - я проверил):


unit Unit1;

interface

uses
Windows, Classes, Controls, StdCtrls, Forms, Messages, Grids, Dialogs, SysUtils,
Graphics, ExtCtrls, ImgList, ComCtrls;

type

TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
ImageList1: TImageList;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
procedure AddIcon(hI: THandle);
end;

var
Form1: TForm1;

implementation

uses ShellApi;

{$R *.dfm}

procedure TForm1.AddIcon(hI: THandle);
var
Icon: TIcon;
begin
try
Icon := TIcon.Create;
Icon.Handle := hI;
ImageList1.AddIcon(Icon);
Icon.Free;
except
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hI: HICON;
i: Integer;
li: TListItem;
begin
if OpenDialog1.Execute then begin
ListView1.Items.Clear;

hI := ExtractIcon(hInstance, LPSTR(OpenDialog1.FileName), 0);
i := 0;
while hI > 1 do begin
AddIcon(hI);
i := i + 1;
hI := ExtractIcon(hInstance, LPSTR(OpenDialog1.FileName), i);
end;

for i := 0 to ImageList1.Count - 1 do begin
li := ListView1.Items.Add;
li.ImageIndex := i;
li.Caption := IntToStr(i);
end;
end;
end;

end.


 
Митяй2   (2004-01-26 20:49) [13]

Сейчас посмотрю...


 
Ig ©   (2004-01-26 20:57) [14]

>Митяй2 (26.01.04 20:43) [11]
>Спасибо, Ig.
>Н,о ExtractIcon я использую уже и знаю про неё.

Сам сказал:

>Митяй2 (26.01.04 20:19) [6]
>Да..., только ни как не знаю с какой стороны подойти...
>Подскажите с чего начать, а там разберусь...


 
Митяй2   (2004-01-26 21:01) [15]

:-)))

Как вариант очень даже пойдет, спасибо, только:

> ...хотелось бы чтобы было похоже на стандартное окно выбора иконки...


 
YuRock ©   (2004-01-26 21:13) [16]

А где Вы подобное видели?


 
Митяй2   (2004-01-26 21:21) [17]

Если у ярлыка менять иконку.

Посмотрел:

http://xatka.vov.ru/cgi-bin/read.pl?chapter=rsource&query=68&file=source2.txt

Только не понял вот, что:

Function SHChangeIconDialog (hOwner:LongInt;sFilename:
LPWSTR;nBuf:LongInt;var nIconIndex:LongInt):LongInt;
stdCall; External "Shell32.dll" index
62;

Что это за index62?
Здесь вроде должно стоять имя функции?
name <имя ф-ции в DLL>
Компилятор ругается.

Подскажите, пожалуйста в чём проблема?


 
YuRock ©   (2004-01-26 21:23) [18]

Для того, чтобы "достать" эту функцию, нужно из приведенног текста

"Function SHChangeIconDialog (hOwner:LongInt;sFilename:
LPWSTR;nBuf:LongInt;var nIconIndex:LongInt):LongInt;
stdCall; External "Shell32.dll" index
62;"

исключить строку

" index
62"

:))


 
Митяй2   (2004-01-26 21:26) [19]

:-)))))))))))


 
YuRock ©   (2004-01-26 21:26) [20]

Вот-вот, не смешно...


 
Митяй2   (2004-01-26 21:30) [21]

Да, но без этого вообще при запуске выдает:

Точка входа в процедуру SHChangeIconDialog не найдена в библиотеке DLL shell32.dll

Может другая библиотека, не shell32.dll...?


 
Митяй2   (2004-01-26 21:42) [22]

Короче всё заработало!
Где-то мои руки подводили...

Всем огромное спасибо!


 
Митяй2   (2004-01-26 22:35) [23]

P.S. Все коды которые я видел не полностью работали или глючили.
Вот полностью работающий вариант и без ActiveX в разделе uses:


unit Icon2;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

pString=^String;
pLongInt=^LongInt;

var Form1: TForm1;

implementation

Function SHChangeIconDialog(hOwner:LongInt;sFilename:LPWSTR;nBuf:LongInt;var nIconIndex:LongInt):LongInt; stdCall; external "shell32.dll" index 62;

{$R *.dfm}

Function ChangeIconDialog(hOwner:LongInt;Filename:pString;IconIndex:pLongInt):boolean;
Var nFileName:array[1..255] of WideChar;
i:LongInt;
begin
for i:=1 to Length(FileName^) do nFileName[i]:=WideChar(Filename^[i]);
for i:=Length(FileName^)+1 to 255 do nFileName[i]:=#0;

if SHChangeIconDialog(hOwner,@nFileName,255,IconIndex^)=1 then Result:=true else Result:=false;

Filename^:=nFileName;
for i:=1 to 255 do
Begin
if nFileName[i]<#32 then break;
End;
SetLength(Filename^,i-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var icon_index:LongInt;
icon_file:string;
begin
icon_file:="D:\Windows\system32\user32.dll";
if ChangeIconDialog(Application.Handle,@icon_file,@icon_index) then
Begin
ShowMessage(inttostr(icon_index));
ShowMessage("""+icon_file+""");
End;
end;
end.


 
Ig ©   (2004-01-26 23:01) [24]

**** UBPFD **** by delphibase.endimus.com ****
unit Unit1;

interface

uses
Windows, SysUtils, Controls, Forms, Classes, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
function ChangeIconDialog(hOwner :tHandle; var FileName: string; var IconIndex: Integer): Boolean;
implementation
resourcestring
SNotSupported = "This function is not supported by your version of Windows";

{$R *.dfm}

function ChangeIconDialog(hOwner :tHandle; var FileName: string; var IconIndex: Integer): Boolean;
type
SHChangeIconProc = function(Wnd: HWND; szFileName: PChar; Reserved: Integer;
var lpIconIndex: Integer): DWORD; stdcall;
SHChangeIconProcW = function(Wnd: HWND; szFileName: PWideChar;
Reserved: Integer; var lpIconIndex: Integer): DWORD; stdcall;
const
Shell32 = "shell32.dll";
var
ShellHandle: THandle;
SHChangeIcon: SHChangeIconProc;
SHChangeIconW: SHChangeIconProcW;
Buf: array [0..MAX_PATH] of Char;
BufW: array [0..MAX_PATH] of WideChar;
begin
Result:= False;
SHChangeIcon:= nil;
SHChangeIconW:= nil;
ShellHandle:= Windows.LoadLibrary(PChar(Shell32));
try
if ShellHandle <> 0 then begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
SHChangeIconW:= GetProcAddress(ShellHandle, PChar(62))
else
SHChangeIcon:= GetProcAddress(ShellHandle, PChar(62));
end;

if Assigned(SHChangeIconW) then begin
StringToWideChar(FileName, BufW, SizeOf(BufW));
Result:= SHChangeIconW(hOwner, BufW, SizeOf(BufW), IconIndex) = 1;
if Result then
FileName:= BufW;
end
else if Assigned(SHChangeIcon) then begin
StrPCopy(Buf, FileName);
Result:= SHChangeIcon(hOwner, Buf, SizeOf(Buf), IconIndex) = 1;
if Result then FileName:= Buf;
end
else
raise Exception.Create(SNotSupported);
finally
if ShellHandle <> 0 then FreeLibrary(ShellHandle);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
files: String;
index: Integer;
begin
ChangeIconDialog(Handle, files, index);
Edit1.Text:= files;
Edit2.Text:= IntToStr(index);
end;

end.

Тоже прекрасно работает :)
З.Ы. Мне даже кажется, что в этом примере и код попроще :)


 
Митяй2   (2004-01-27 09:41) [25]

К моему коду замечание:

Для 9x, ME нужно использовать


Function ChangeIconDialog9x(hOwner:LongInt;Filename:pString;IconIndex:pLongInt):boolean;
Var nFileName:array[1..250] of Char;
i:LongInt;
begin
for i:=1 to Length(FileName^) do nFileName[i]:=Char(Filename^[i]);

for i:=Length(FileName^)+1 to 250 do nFileName[i]:=#0;

if SHChangeIconDialog9x(hOwner,@nFileName,250,IconIndex^)=1 then Result:=true else Result:=false;

Filename^:=nFileName;
for i:=1 to 255 do
Begin
if nFileName[i]<#32 then break;
End;
SetLength(Filename^,i-1);
end;


Т.е. String вместо WideString;

Это также чётко просматривается в коде Ij



Страницы: 1 вся ветка

Текущий архив: 2004.02.06;
Скачать: CL | DM;

Наверх




Память: 0.53 MB
Время: 0.019 c
3-16050
Mic_2000
2004-01-12 18:28
2004.02.06
Request size limit exceeded - что это за ошибка такая?


1-16405
OldJek
2004-01-22 17:46
2004.02.06
Как показать Hint над кнопкой приложения в панели задач?


14-16613
Eagle Owl
2004-01-13 22:43
2004.02.06
Дизассемблеры...


1-16505
denis24
2004-01-27 13:03
2004.02.06
Кнопка mininize в заголовке формы


14-16703
Piter
2004-01-18 01:33
2004.02.06
CreateToolhelp32Snapshot возвращает неверный дескриптор