Вот тебе код на дельфи - переводи 
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TIconDialog = class(TObject)
constructor Create(FileName:string);
destructor Destroy; override;
function Execute: Boolean;
private
{ Private declarations }
FIcon: TIcon;
FFileName: String;
FIndex: Integer;
function GetAnyFile: String;
protected
{ Protected declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
IconDialog: TIconDialog;
implementation
{$R *.dfm}
function PickIconDlg(OwnerWnd: HWND; lpstrFile: PWideChar; var nMaxFile: LongInt;
var lpdwIconIndex: LongInt): LongBool; stdcall; external 'SHELL32.DLL' index 62;
constructor TIconDialog.Create(FileName:string);
begin
inherited Create;
FFileName:=FileName;
FIcon := TIcon.Create;
end;
destructor TIconDialog.Destroy;
begin
FIcon.Free;
inherited Destroy;
end;
function TIconDialog.Execute: Boolean;
var
zFileName: array [0..MAX_PATH - 1] of AnsiChar;
zwFileName: array [0..MAX_PATH - 1] of WideChar;
zSize, zIndex: LongInt;
begin
if not ((FFileName <> '') and FileExists(FFileName)) then FFileName:=GetDefaultFile;
StrPCopy(zFileName,FFileName);
Result := PickIconDlg(0,StringToOleStr(FFileName),zSize,zIndex);
FIndex := zIndex;
if (FFileName <> '') and (FIndex <> -1) then
begin
FIcon.Handle := ExtractIcon(hInstance,zFileName,zIndex);
end;
end;
function TIconDialog.GetDefaultFile: String;
var
zSysDir: array [0..MAX_PATH - 1] of Char;
SysDir: String;
begin
GetSystemDirectory(zSysDir,255);
SysDir := StrPas(zSysDir);
if SysDir[Length(SysDir)] <> '\' then
begin
SysDir := SysDir + '\';
end;
Result := SysDir + 'SHELL32.DLL';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IconDialog:=TIconDialog.Create('');
IconDialog.Execute;
end;
end.
|
|
