opendlgfavadapter.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is OpenDlgFavAdapter.pas.                                                      }
{                                                                                                  }
{ The Initial Developer of the Original Code is Petr Vones.                                        }
{ Portions created by Petr Vones are Copyright (C) Petr Vones. All rights reserved.                }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{   Salvatore Besso                                                                                }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Unit owner: Petr Vones                                                                           }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/02/26 17:36:01 $
// For history see end of file

unit OpenDlgFavAdapter;

interface

{$I jcl.inc}

uses
  Windows, Messages, Classes, SysUtils, Controls, StdCtrls, ExtCtrls,
  JclPeImage;

type
  TFavOpenDialog = class (TObject)
  private
    FAddButton: TButton;
    FDeleteMode: Boolean;
    FDisableHelpButton: Boolean;
    FDisablePlacesBar: Boolean;
    FFavoriteComboBox: TComboBox;
    FFavoriteFolders: TStrings;
    FFavoritePanel: TPanel;
    FHandle: HWND;
    FHooks: TJclPeMapImgHooks;
    FIsOpenPictDialog: Boolean;
    FParentWnd: HWND;
    FParentWndInstance: Pointer;
    FOldParentWndInstance: Pointer;
    FPictureDialogLastFolder: string;
    FWndInstance: Pointer;
    FOldWndInstance: Pointer;
    FOnClose: TNotifyEvent;
    FOnShow: TNotifyEvent;
    procedure AddButtonClick(Sender: TObject);
    procedure FavoriteComboBoxClick(Sender: TObject);
    function GetCurrentFolder: string;
    function GetFileNameEditWnd: HWND;
    procedure SetCurrentFolder(const Value: string);
    procedure SetDeleteMode(const Value: Boolean);
  protected
    procedure AdjustControlPos;
    procedure DialogFolderChange;
    procedure DialogShow;
    procedure DoClose;
    procedure DoShow;
    procedure ParentWndProc(var Message: TMessage); virtual;
    procedure WndProc(var Message: TMessage); virtual;
    property CurrentFolder: string read GetCurrentFolder write SetCurrentFolder;
    property DeleteMode: Boolean read FDeleteMode write SetDeleteMode;
    property FileNameEditWnd: HWND read GetFileNameEditWnd;
  public
    constructor Create;
    destructor Destroy; override;
    procedure HookDialogs;
    procedure LoadFavorites(const FileName: string);
    procedure UnhookDialogs;
    property DisableHelpButton: Boolean read FDisableHelpButton write FDisableHelpButton;
    property DisablePlacesBar: Boolean read FDisablePlacesBar write FDisablePlacesBar;
    property FavoriteFolders: TStrings read FFavoriteFolders;
    property IsOpenPictDialog: Boolean read FIsOpenPictDialog;
    property PictureDialogLastFolder: string read FPictureDialogLastFolder write FPictureDialogLastFolder;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
  end;

function InitializeFavOpenDialog: TFavOpenDialog;

implementation

uses
  {$IFNDEF RTL140_UP}
  Forms,
  {$ENDIF ~RTL140_UP}
  CommDlg, Dlgs, JclFileUtils, JclStrings, JclSysInfo, JclSysUtils;

{$R FavDlg.res}

resourcestring
  RsAdd          = '<- Add';
  RsDelete       = '&Delete';
  RsFavorites    = '&Favorites';
  RsConfirmation = 'Confirmation';
  RsDelConfirm   = 'Are you sure to delete "%s" from favorite folders ?';

const
  FavDialogTemplateName      = 'FAVDLGTEMPLATE';
  OpenPictDialogTemplateName = 'DLGTEMPLATE';

type
  TGetOpenFileName = function (var OpenFile: TOpenFilename): Bool; stdcall;

var
  OldGetOpenFileName: TGetOpenFileName;
  OldGetSaveFileName: TGetOpenFileName;
  OldExplorerHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
  FavOpenDialog: TFavOpenDialog;

//--------------------------------------------------------------------------------------------------

function NewExplorerHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
begin
  Result := OldExplorerHook(Wnd, Msg, WParam, LParam);
  if (Msg = WM_INITDIALOG) and Assigned(FavOpenDialog) then
  begin
    FavOpenDialog.FHandle := Wnd;
    FavOpenDialog.FOldWndInstance := Pointer(SetWindowLong(Wnd, GWL_WNDPROC, Longint(FavOpenDialog.FWndInstance)));
    CallWindowProc(FavOpenDialog.FWndInstance, Wnd, Msg, WParam, LParam);
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure InitOpenFileStruct(var OpenFile: TOpenFilename);
var
  InitDir: string;
begin
  with OpenFile do
    if Flags and OFN_EXPLORER <> 0 then
    begin
      if Assigned(FavOpenDialog) then
        FavOpenDialog.FIsOpenPictDialog := False;
      if Flags and OFN_ENABLETEMPLATE = 0 then
      begin
        OldExplorerHook := lpfnHook;
        lpfnHook := NewExplorerHook;
        lpTemplateName := FavDialogTemplateName;
        hInstance := FindResourceHInstance(FindClassHInstance(TFavOpenDialog));
        Flags := Flags or OFN_ENABLETEMPLATE;
        if Assigned(FavOpenDialog) then
        begin
          if FavOpenDialog.DisableHelpButton then
            Flags := Flags and (not OFN_SHOWHELP);
          {$IFDEF DELPHI6_UP}
          if FavOpenDialog.DisablePlacesBar and (lStructSize = SizeOf(TOpenFilename)) then
            FlagsEx := FlagsEx or OFN_EX_NOPLACESBAR;
          {$ENDIF DELPHI6_UP}
        end;
      end
      else
      if (StrIComp(lpTemplateName, OpenPictDialogTemplateName) = 0) and Assigned(FavOpenDialog) then
      begin
        FavOpenDialog.FIsOpenPictDialog := True;
        OldExplorerHook := lpfnHook;
        lpfnHook := NewExplorerHook;
        InitDir := FavOpenDialog.PictureDialogLastFolder;
        if DirectoryExists(InitDir) then
          lpstrInitialDir := PChar(FavOpenDialog.PictureDialogLastFolder)
        else
          FavOpenDialog.PictureDialogLastFolder := '';
      end;
   end;
end;

//--------------------------------------------------------------------------------------------------

function NewGetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall;
begin
  InitOpenFileStruct(OpenFile);
  Result := OldGetOpenFileName(OpenFile);
end;

//--------------------------------------------------------------------------------------------------

function NewGetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall;
begin
  InitOpenFileStruct(OpenFile);
  Result := OldGetSaveFileName(OpenFile);
end;

//--------------------------------------------------------------------------------------------------

function InitializeFavOpenDialog: TFavOpenDialog;
begin
  if not Assigned(FavOpenDialog) then
    FavOpenDialog := TFavOpenDialog.Create;
  Result := FavOpenDialog;
end;

//==================================================================================================
// TFavOpenDialog
//==================================================================================================

procedure TFavOpenDialog.AddButtonClick(Sender: TObject);
var
  I: Integer;
  Path: string;
begin
  if DeleteMode then
  begin
    I := FFavoriteComboBox.ItemIndex;
    Path := FFavoriteComboBox.Items[I];
    if MessageBox(FHandle, PChar(Format(RsDelConfirm, [Path])), PChar(RsConfirmation),
      MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = ID_YES then
    begin
      FFavoriteComboBox.Items.Delete(I);
      DeleteMode := False;
    end;
  end
  else
  begin
    Path := CurrentFolder;
    I := FFavoriteComboBox.Items.IndexOf(Path);
    if I = -1 then
    begin
      FFavoriteComboBox.Items.Add(Path);
      I := FFavoriteComboBox.Items.IndexOf(Path);
      FFavoriteComboBox.ItemIndex := I;
      DeleteMode := True;
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure TFavOpenDialog.AdjustControlPos;
var
  ParentRect, FileNameEditRect, OkButtonRect: TRect;

  procedure GetDlgItemRect(ItemID: Integer; var R: TRect);
  begin
    GetWindowRect(GetDlgItem(FParentWnd, ItemID), R);
    MapWindowPoints(0, FParentWnd, R, 2);
  end;

begin
  GetWindowRect(FParentWnd, ParentRect);
  if GetDlgItem(FParentWnd, edt1) <> 0 then
    GetDlgItemRect(edt1, FileNameEditRect)
  else
    GetDlgItemRect(cmb1, FileNameEditRect);
  GetDlgItemRect(1, OkButtonRect);

// Salvatore Besso: Changes to avoid truncation of Add button. I don't know why, but debugging I
//   have discovered that ParentRect.Right was equal to 1024, ie Screen.Width. I also can't figure
//   out why I can't preserve original help button that disappears using this expert.
//   As visible in the changes, favorite panel width is just left of the original button column.

  if IsWin2k or IsWinXP then
    FAddButton.Width := 65;
  FFavoritePanel.Width := OkButtonRect.Left - 1;
  FFavoriteComboBox.Width := FFavoritePanel.Width - FFavoriteComboBox.Left - FAddButton.Width - 16;
  FAddButton.Left := FFavoriteComboBox.Width + 14;
end;

//--------------------------------------------------------------------------------------------------

constructor TFavOpenDialog.Create;
begin
  inherited Create;
  FFavoriteFolders := TStringList.Create;
  FHooks := TJclPeMapImgHooks.Create;
  FParentWndInstance := MakeObjectInstance(ParentWndProc);
  FWndInstance := MakeObjectInstance(WndProc);
  FFavoritePanel := TPanel.Create(nil);
  with FFavoritePanel do
  begin
    Name := 'FavoritePanel';
    BevelOuter := bvNone;
    Caption := '';
    FullRepaint := False;
    FFavoriteComboBox := TComboBox.Create(FFavoritePanel);
    with FFavoriteComboBox do
    begin
      SetBounds(6, 14, 300, Height);