PickIconDialog

[FAlter]

Hi,

Bei meinem TIcon-speicern-Problem bin ich auf einen Code mit PickIconDialog gestoßen, der nicht funktionierte - ganz offensichtlich ein Unicode-Problem. Die Suche in der DP hat mir gezeigt, dass auch andere ein PickIconDialog-Unicode-Problem hatten. Dort wurde es mit bedingter Compilierung gelöst. Ich habe das ganze so angepasst, dass zur Laufzeit die richtige Version verwendet wird.

Die Units SysUtils (RaiseLastOSError) Windows (Load und FreeLibrary, GetProcAddress) werden benötigt.

Delphi-Quellcode:

function PickIconDlg(hwndOwner: HWND; var lpstrFile: String;
  var lpdwIconIndex: LongInt): Boolean;
var
  Lib: THandle;
  PickIconDlgA: function(hwndOwner:HWND; lpstrFile: PAnsiChar; nMaxFile: DWORD;
    var lpdwIconIndex: LongInt): Longint; stdcall;
  PickIconDlgW: function(hwndOwner:HWND; lpstrFile: PWideChar; nMaxFile: DWORD;
    var lpdwIconIndex: LongInt): Longint; stdcall;
  WinVersion: DWord;
  WindowsMajorVersion: Byte;
  Unicode: Boolean;
  idx, Size: Integer;
  AnsiBuffer: AnsiString;
  WideBuffer: WideString;
begin
  Lib := LoadLibrary('SHELL32');
  if Lib <> 0 then
  try
    WinVersion := GetVersion;
    WindowsMajorVersion :=  Lo(WinVersion);

    Unicode := (WinVersion < $80000000) { NT-System } and
    (WindowsMajorVersion >= 5); { ab 2000 }

    idx  := Length(lpstrFile);

    //size := Max(idx, MAX_PATH);
    if MAX_PATH > idx then
      size := MAX_PATH
    else
      size := idx;

    if Unicode then
    begin
      @PickIconDlgW := GetProcAddress(Lib, 'PickIconDlg');
      if not Assigned(@PickIconDlgW) then
        @PickIconDlgW := GetProcAddress(Lib, Pointer(62));
      if not Assigned(@PickIconDlgW) then
        RaiseLastOSError;

      WideBuffer := lpstrFile;
      SetLength(WideBuffer, size + 1);
      WideBuffer[idx+1] := #0;

      Result := PickIconDlgW(hwndOwner, PWideChar(WideBuffer), size,
        lpdwIconIndex) <> 0;
      if Result then
        lpstrFile := PWideChar(WideBuffer);
    end
    else
    begin
      @PickIconDlgA := GetProcAddress(Lib, Pointer(62));
      if not Assigned(@PickIconDlgA) then
        RaiseLastOSError;

      AnsiBuffer := lpstrFile;
      SetLength(AnsiBuffer, size + 1);
      AnsiBuffer[idx+1] := #0;

      Result := PickIconDlgA(hwndOwner, PAnsiChar(AnsiBuffer), size,
        lpdwIconIndex) <> 0;
      if Result then
        lpstrFile := PAnsiChar(AnsiBuffer);
    end;
  finally
    if not FreeLibrary(Lib) then
      RaiseLastOSError;
  end
  else
    RaiseLastOSError;
end;

Hintergrund: Ab Windows 2000 (NT 5.0) ist der PickIconDialog Unicode, vorher war er ANSI. Daher wird bei NT-Systemen mit einer Major-Version von 5 oder höher der Code für Unicode ausgeführt, sonst der für ANSI. Des weiteren ist er bei älteren Systemen als nur per Index erreichbar, weshalb auf diesen zugegriffen wird, wenn GetProcAddress mit Namen fehlschlägt.

Mfg
FAlter