dotFusion.net

I’ve been trying to get Vista Compatible Open and Save Dialogs in Lazarus (FreePascal) recently. After researching I found some example code around the net which didn’t quite work in FreePascal. I modified and extended the code and the result is here:

(Default Lazarus Open Dialog)

(Vista Compatible Open Dialog)

(Default Lazarus Save Dialog)

(Vista Compatible Save Dialog)

 
And now the source code…

{
  VistaOpenSaveDialog:
  A new Open/Save dialog that uses Windows API to display Vista
  compatiable Open or Save Dialog.
 
  Tested in Windows 2000/XP/Vista/Vista x64.
  Compiled with Lazarus 0.9.29 beta (21448) / FreePascal 2.2.4
  It should compile successfully with all newer and maybe some the versions.
 
  Created by Iskren Slavov (http://www.dotfusion.net/).
  No right reserved. Feel free to use for any of your applications
  regardless of the license.
 
  ##########################################
 
  Example usage:
  VistaOpenSaveDialg(Handle, '', '', '', 'Open file...', fileName,
    OFN_FILEMUSTEXIST, VDT_OPENDIALOG);
 
  Some usable flags under Windows Vista:
  OFN_READONLY, OFN_HIDEREADONLY, 
  OFN_OVERWRITEPROMPT, OFN_FILEMUSTEXIST,
  OFN_PATHMUSTEXIST, OFN_FORCESHOWHIDDEN, 
  OFN_DONTADDTORECENT
}
 
unit VistaOpenSaveDlg;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Windows, Messages, CommDlg, SysUtils;
 
type
  TVistaDlgType = (VDT_OPENDIALOG, VDT_SAVEDIALOG);
 
  function ReplaceStr(const S, Srch, Replace: string): string;
  function VistaOpenSaveDialog(Parent: HWND; const Filters, 
    DefaultExtension, InitialDir, Title: string; var FileName: string; 
    DlgFlags: DWORD; DlgType: TVistaDlgType): Boolean;
 
implementation
 
function ReplaceStr(const S, Srch, Replace: string): string;
var
  i: Integer;
  Source: string;
begin
  Source := S;
  Result := '';
  repeat
    i := Pos(UpperCase(Srch), UpperCase(Source));
    if i > 0 then
    begin
      Result := Result + Copy(Source, 1, i - 1) + Replace;
      Source := Copy(Source, i + Length(Srch), MaxInt);
    end
    else
      Result := Result + Source;
  until i <= 0;
end;
 
function VistaOpenSaveDialog(Parent: HWND; const Filters, DefaultExtension, InitialDir, Title: String;
  var FileName: String; DlgFlags: DWORD; DlgType: TVistaDlgType): Boolean;
var
  fnStruct: TOpenFileName;
  szFile: array[0..MAX_PATH] of Char;
begin
  Result := False;
  FillChar(fnStruct, SizeOf(TOpenFileName), 0);
  with fnStruct do
  begin
    hwndOwner := Parent;
    lStructSize := SizeOf(TOpenFileName);
    lpstrFile := szFile;
    StrPCopy(lpstrFile, FileName);
    nMaxFile := SizeOf(szFile);
    lpstrFilter := PChar(ReplaceStr(Filters, '|', #0) + #0#0);
    if (Title <> '') then
      lpstrTitle := PChar(Title);
    if (InitialDir <> '') then
      lpstrInitialDir := PChar(InitialDir);
    if DefaultExtension <> '' then
      lpstrDefExt := PChar(DefaultExtension);
 
    Flags := Flags or DlgFlags;
  end;
 
  case DlgType of
    VDT_OPENDIALOG:
      if GetOpenFileName(@fnStruct) then
      begin
        Result := True;
        FileName := StrPas(szFile);
      end;
    VDT_SAVEDIALOG:
      if GetSaveFileName(@fnStruct) then
      begin
        Result := True;
        FileName := StrPas(szFile);
      end;
  end;
end;
end.

 
Download Lazarus Compiled Demo Project with Source Code.