“アイコンの変更”ダイアログ

解決

もふもふ 2004-07-16 10:15:53 No: 9951

マイコンピュータやごみ箱などのアイコンを変更する時に、
“アイコン変更”ダイアログが出てきますよね。
Delphiであのダイアログは出せないのでしょうか？

DLLに格納されているアイコン群から、任意のアイコンを指定できるような
ダイアログが欲しいのですが。

知ってる方がいらしたらよろしくお願いします。

にゃ〜 2004-07-17 07:04:46 No: 9952

Shell32.dllの62番目の関数を呼べばいいにゃ〜
例えば、それに ShellIconDialogという名前を付けて、
result := ShellIconDialog(0, szFName, MAX_PATH, pIndex);
のようにすればいいにゃ〜
szFNameを空文字にすると、Shell32.dllに入ってるアイコンの中から選択出来るにゃ〜
ShellIconDialog : function(hWnd:HWND; szFName:PWChar; iSize:Longint; pIndex:PInteger): Longint; stdcall;

jok 2004-07-17 07:39:11 No: 9953

にゃ〜さんのようにやってみました。ちょっと宣言が違いますが。
WinNT,2000,XP ではうまくいくはずです。2000 で確認しました。

uses ShellAPI;

function PickIconDialogW(Handle:THandle; FileName:PWideChar;var FileNameSize:DWORD;
var IconIndex:DWORD):Boolean; stdcall; external 'shell32.dll' index 62;

procedure TForm1.Button1Click(Sender: TObject);
var
  Size,Index:DWORD;
  Filename:WideString;
  targetFile:string;
  wBuf:PWideChar;
  Icon:TIcon;
begin
  Filename := 'shell32.dll';
  GetMem(wBuf,MAX_PATH*2);
  ZeroMemory(wBuf,MAX_PATH*2);
  Size := Length(Filename);
  Move(PWideChar(Filename)^,wBuf^,Size*2);

  if PickIconDialogW(Handle,wBuf,Size,Index) then
  begin
    Icon := TIcon.Create;
    try
      TargetFile := WideString(wBuf);
      Icon.Handle := ExtractIcon(hInstance,PChar(TargetFile),Index);
      self.Refresh;
      self.Canvas.Draw(10,10,Icon);
    finally
      Icon.Free;
    end;
  end;

FreeMem(wBuf);
end;

Win9X,Me ではファイル名が PWideChar ではなく PChar になるようです。
表示されるダイアログの[参照(B)...]からアイコンを持つ任意のファイルを選べます。

jok 2004-07-17 12:53:08 No: 9954

WinNT 系でも Win9X 系でも動作するようにしました。

uses ShellAPI;

function PickIconDialogW(Handle:THandle; FileName:PWideChar;var FileNameSize:DWORD;
var IconIndex:DWORD):Boolean; stdcall; external 'shell32.dll' index 62;

function PickIconDialogA(Handle:THandle; FileName:PChar;var FileNameSize:DWORD;
var IconIndex:DWORD):Boolean; stdcall; external 'shell32.dll' index 62;

function PickIconDlgW(Filename:string):HICON;
var
  Size,Index:DWORD;
  InitFile:WideString;
  targetFile:string;
  wBuf:PWideChar;
begin
  result := THandle(-1);

  GetMem(wBuf,MAX_PATH*2+2);
  ZeroMemory(wBuf,MAX_PATH*2+2);
  Size := MAX_PATH;
  InitFile := Filename;
  CopyMemory(wBuf,PWideChar(InitFile),Length(InitFile)*2);

  if PickIconDialogW(0,wBuf,Size,Index) then
  begin
    TargetFile := WideString(wBuf);
    result := ExtractIcon(hInstance,PChar(TargetFile),Index);
  end;

FreeMem(wBuf);
end;

function PickIconDlgA(Filename:string):HICON;
var
  Size,Index:DWORD;
  targetFile:string;
  Buf:PChar;
begin
  result := THandle(-1);

  GetMem(Buf,MAX_PATH+1);
  ZeroMemory(Buf,MAX_PATH+1);
  Size := MAX_PATH;
  CopyMemory(Buf,PChar(Filename),Length(Filename));

  if PickIconDialogA(0,Buf,Size,Index) then
  begin
    TargetFile := string(Buf);
    result := ExtractIcon(hInstance,PChar(TargetFile),Index);
  end;

FreeMem(Buf);
end;

// 初期ファイルを指定して実行

procedure TForm1.Button1Click(Sender: TObject);
var
  hIcn:HICON;
  Icon:TIcon;
begin
  if OpenDialog1.Execute then
  begin
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      hIcn := PickIconDlgW(OpenDialog1.Filename)
    else
      hIcn := PickIconDlgA(OpenDialog1.Filename);

    if hIcn > 0 then begin
      Icon := TIcon.Create;
      try
        Icon.Handle := hIcn;
        self.Refresh;
        self.Canvas.Draw(10,10,Icon);
      finally
        Icon.Free;
      end;
    end;
  end;
end;

// 初期ファイルを指定しないで実行（Shell32.dllから）

procedure TForm1.Button2Click(Sender: TObject);
var
  hIcn:HICON;
  Icon:TIcon;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    hIcn := PickIconDlgW('')
  else
    hIcn := PickIconDlgA('');

  if hIcn > 0 then begin
    Icon := TIcon.Create;
    try
      Icon.Handle := hIcn;
      self.Refresh;
      self.Canvas.Draw(10,10,Icon);
    finally
      Icon.Free;
    end;
  end;
end;

もふもふ 2004-07-21 01:34:00 No: 9955

ご丁寧にありがとうございました。
希望通りの動作ができました。