unit FileMenuHdl;

{
----------------------------------------------------------------
TFileMenuHandler v1.0 by Harry Kakoulidis 11/1999
haka@mailbox.gr
hakakou@hotmail.com

Component for handling Recent files list and Open, Save,
Save As, Exit Commands. Uses a ini file for the recent
list. Read FileMenuHdl.txt form more information.

This is Freeware. Please copy FilMen10.zip unchanged.
If you find bugs, have options etc. Please send at my e-mail.

The use of this component is at your own risk.
I do not take any responsibility for any damages.
----------------------------------------------------------------
}

interface
uses IniFiles, Forms, Classes, Dialogs, Menus, SysUtils, Windows,
  Controls;

type
  TIOFunction = function(var AFilename: string): boolean of object;
  TSetCaption = procedure(const AFileName: string) of object;
  {v0.12}
  TOnBeforeSave = function(AIsNew: boolean; var FileName: string): boolean of object;
  {/v0.12}

type
  TFileMenuHandler = class(TComponent)
  private
    FIniFile: TIniFile;
    FiniFileName, FFileName: string;
    Fopendialog: TOpenDialog;
    Fsavedialog: TSaveDialog;
    FDefaultFileName: string;
    FMaxList: Integer;
    FFileMenu: TMenuItem;
    FNotFoundStr,
      FFileChangedCaption, FFileChangedStr: string;
    FSeparator: TMenuItem;
    FOnNew, FOnOpen, FOnSave: TIOFunction;
    {v0.12}FOnBeforeSave: TOnBeforeSave;{/v0.12}
    FOnSetCaption: TSetCaption;
    FAddShortCut: Boolean;
    FEnableMenuList: boolean;
    FEnabled: boolean;
    FLoadStart, FMoveToTop, FIsNew: Boolean;
    FParamCount, FNewItemImageIndex: Integer;
    FDirectSave,FSaveAsCancel:boolean;

    POnShow: TNotifyEvent;
    POnCloseQuery: TCloseQueryEvent;
    procedure FMHCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FMHShow(Sender: TObject);

    function SaveAsProc: boolean;
    procedure SetMaxItems(m: integer);
    procedure FileItemClick(Sender: Tobject);
    procedure UpdateList;
    function SaveQuery: boolean;
    procedure LoadRecentList;
    procedure InsertFilename;
    procedure SetEnableMenuList(e: boolean);
    procedure NotFoundDialog(const f: string);
  public
    RecentList: TStringList;
    IsDirty: boolean;
    IniPath: string;
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure New;
    function Save: boolean;
    function SaveAs: boolean;
    function Open: boolean;
    procedure Exit(var CanClose: boolean);
    {v0.67}
    procedure FileAdd(const AFileName: string);
    {/v0.67}
    property Filename: string read FFilename;
    property IsNew: Boolean read FIsNew;
  published
    property IniFileName: string read FIniFileName write
      FIniFileName;
    property SaveDialog: TSaveDialog read FSaveDialog write
      FSaveDialog;
    property OpenDialog: TOpenDialog read FOpenDialog write
      FOpenDialog;
    property MaxList: Integer read FMaxList write SetMaxItems;
    property DefaultFileName: string read FDefaultFilename write
      FDefaultFilename;
    property FileMenu: TMenuitem read FFileMenu write FFilemenu;
    property NotFoundString: string read FNotFoundStr write
      FNotFoundStr;
    property FileChangedString: string read FFileChangedStr write
      FFileChangedStr;
    property FileChangedCaption: string read FFileChangedCaption write
      FFileChangedCaption;
    property OnOpen: TIOFunction read FOnOpen write FOnOpen;
    property OnSave: TIOFunction read FOnSave write FOnSave;
    {v0.12}
    property OnBeforeSave: TOnBeforeSave read FOnBeforeSave write FOnBeforeSave;
    {/v0.12}
    property OnNew: TIOFunction read FOnNew write FOnNew;
    property OnNewFormCaption: TSetCaption read FOnSetCaption write
      FOnSetCaption;

    property AddShortcut: Boolean read FAddShortcut write
      FAddShortcut;
    property NewItemImageIndex: integer read FNewItemImageIndex write
      FNewItemImageIndex;
    property EnableMenuList: boolean read FEnableMenuList write
      SetEnableMenuList;
    property MoveToTop: boolean read FMoveToTop write
      FMoveToTop;
    property ParamCountLook: Integer read FParamCount write
      FParamCount;
    property LoadNewOnStart: Boolean read FLoadStart write
      FLoadStart;
  end;

procedure Register;
{v0.30}
var FMH: TFileMenuHandler = nil;
{/v0.30}
implementation

procedure Register;
begin
  RegisterComponents('File Utils', [TFileMenuHandler]);
end;

constructor TFileMenuHandler.create(AOwner: TComponent);
begin
  {v0.30}
  if FMH <> nil then
    raise Exception.Create('Only one TFileMenuHandler instance allowed');
  {/v0.30}
  FEnabled := not (csDesigning in ComponentState);
  FLoadStart := true;
  FAddShortCut := True;
  FEnableMenuList := true;
  MoveToTop := true;
  NewItemImageIndex := -1;
  FParamcount := 1;
  FIniFilename := 'Options.ini';
  FDirectSave := false;
  FSaveAsCancel:=false;
  FMaxList := 4;
  FNotFoundStr := 'File %s not found.';
  FileChangedString := 'File %s has changed. Save Changes?';
  FileChangedCaption := 'Save changes';
  RecentList:=TStringList.Create;
  inherited create(AOwner);
  if componentstate = []
   then with AOwner as TForm do begin
      POnCloseQuery := OnCloseQuery;
      POnShow := OnShow;
      OnCloseQuery := FMHCloseQuery;
      OnShow := FMHShow;
    end;
  {v0.30}
  FMH := Self;
  {/v0.30}
end;

destructor TFileMenuHandler.destroy;
var
  c: integer;
begin
  {v0.30}
  FMH := nil;
  {/v0.30}
  if assigned(Finifile) then
  try
    Finifile.EraseSection('RecentFiles');
    for c := 0 to RecentList.count - 1 do
      FIniFile.WriteString('RecentFiles', 'File' + inttostr(c),
        RecentList[c]);
    Finifile.free;
  Except
   on exception do Finifile.free;
  end;
  if assigned(RecentList) then RecentList.Free;
  inherited Destroy;
end;

procedure TFileMenuHandler.UpdateList;
var
  c: integer; sc: char;
  mi: tmenuitem;
begin
  if not assigned(FFileMenu) then system.exit;
  for c := RecentList.count - 1 downto FMaxList do
    RecentList.Delete(c);
  if FEnableMenuList then
  begin
    if not assigned(FSeparator) then begin
      FSeparator := TMenuitem.create(FFileMenu);
      FSeparator.caption := '-';
      FSeparator.Visible := false;
      FFilemenu.Add(FSeparator);
    end;
    FSeparator.Visible := RecentList.count > 0;
    for c := FFIleMenu.Count - 1 downto FFileMenu.IndexOf(FSeparator)
      + 1 do
      TMenuItem(FFileMenu.Items[c]).free;
    for c := 0 to RecentList.count - 1 do
    begin
      mi := tmenuitem.Create(FFileMenu);
      if c <= 8 then sc := '1' else sc := chr(ord('A') - 9);
      if FAddShortCut then mi.Caption := '&' + chr(c + ord(sc)) +
        ' ' + RecentList.Strings[c]
      else mi.caption := RecentList.Strings[c];
      mi.OnClick := FileItemClick;
      if FAddShortcut then
        mi.shortcut := shortcut(ord(chr(c + ord(sc))), [ssalt]);
      mi.ImageIndex := FNewItemImageIndex;
      FFilemenu.Add(mi);
    end;
  end;
end;

procedure TFileMenuHandler.Exit(var CanClose: boolean);
begin
  Canclose := (SaveQuery = true) and (not FSaveAsCancel);
  FSaveAsCancel := false;
end;

procedure TFileMenuHandler.LoadRecentList;
var
  c: integer;
begin
  if length(FIniFileName) = 0 then system.exit;
  if not assigned(FIniFile) then
    FIniFile := TIniFile.Create(inipath + Finifilename);
  try
    RecentList.Clear;
    FIniFile.ReadSection('RecentFiles', RecentList);
    for c := 0 to RecentList.count - 1 do begin
      RecentList[c] := FIniFile.ReadString('RecentFiles', 'File' +
        inttostr(c), '');
    end;
    for c := RecentList.count - 1 downto 0 do
      if not FileExists(RecentList[c]) then RecentList.Delete(c);
    UpdateList;
  except
    on exception do
      if assigned(FIniFile) then
        begin FIniFile.Free; FiniFile := nil; end;
  end;
end;

procedure TFileMenuHandler.FileItemClick(Sender: Tobject);
var
  mi: TMenuItem; c: integer;
  fn:string;
begin
  mi := Sender as TMenuItem;
  c := FFileMenu.IndexOf(mi) - FFileMenu.IndexOf(FSeparator) - 1;
  if SaveQuery then
    if FileExists(recentlist[c]) then
    begin
      if Assigned(FOnOpen) then begin
        fn := RecentList[c];
        if FOnOpen(fn) then
        begin
          FFilename := fn;
          IsDirty := false;
          if FMoveTotop then
            RecentList.Move(c, 0);
          UpdateList;
          FIsNew := false;
          if Assigned(FOnSetCaption) then
            FOnSetCaption(FFilename);
        end;
      end;
    end else
    begin
      notfounddialog(Recentlist[c]);
      Recentlist.Delete(c);
      updatelist;
    end;
end;

procedure TFileMenuHandler.New;
begin
  if SaveQuery then
    if Assigned(OnNew) then
      if OnNew(FFileName) then
      begin
        FFilename := FDefaultFilename;
        FIsNew := true;
        IsDirty := false;
        if Assigned(FOnSetCaption) then
          FOnSetCaption(FFilename);
      end;
end;

function TFileMenuHandler.Open: boolean;
var
  fn: string;
  i: integer;
begin
  Result := false;
  if savequery then
     if not FSaveAsCancel then
     begin
       if FOpenDialog.Execute then begin
         {v0.11}
         if ofAllowMultiSelect in FOpenDialog.Options then begin
           for i := 0 to FOpenDialog.Files.Count - 1 do begin
             if FileExists(FOpenDialog.Files[i]) then
             begin
               if Assigned(FOnOpen) then begin
                 fn := FOpenDialog.Files[i];
                 if FOnOpen(fn) then
                 begin
                   Result := true;
                   FFilename := fn;
                   IsDirty := false;
                   InsertFilename;
                   UpdateList;
                   FIsNew := false;
                   if Assigned(FOnSetCaption) then FOnSetCaption(FFilename);
                 end;
               end;
             end;
           end;
         end else
         {/v0.11}
         begin
           if FileExists(FOpenDialog.Filename) then
           begin
             if Assigned(FOnOpen) then begin
               fn := FOpenDialog.FileName;
               if FOnOpen(fn) then
               begin
                 Result := true;
                 FOpenDialog.Filename := fn;
                 FFilename := FOpenDialog.FileName;
                 IsDirty := false;
                 InsertFilename;
                 UpdateList;
                 FIsNew := false;
                 if Assigned(FOnSetCaption) then FOnSetCaption(FFilename);
               end;
             end;
           end else
             NotFoundDialog(FOpenDialog.FileName);
         end;
       end;
     end else
       FSaveAsCancel:=false;
end;

function TFileMenuHandler.Save: boolean;
begin
  Result := false;
  if FIsNew then begin
    Result := SaveAsProc;
    system.exit;
  end;
  {v0.12}
  if Assigned(OnBeforeSave) then begin
    if not OnBeforeSave(false, FFileName) then
      System.Exit;
  end;
  {/v0.12}
  if Assigned(onSave) then
    if OnSave(FFilename) then
    begin
      Result := true;
      IsDirty := false;
      FIsNew := false;
    end;
end;

function TFileMenuHandler.SaveAsProc: boolean;
var fn:string;
begin
  Result := false;
  {v0.12}
  if Assigned(OnBeforeSave) then begin
    if not OnBeforeSave(FIsNew, FFileName) then
      System.Exit;
  end;
  {/v0.12}
  if Assigned(onSave) then
  begin
    FSaveDialog.Filename := FFileName;
    if FSaveDialog.Execute then
    begin
      fn := FSaveDialog.FileName;
      if OnSave(fn) then
      begin
        FSaveDialog.FileName := fn;
        Result := true;
        IsDirty := false;
        FFilename := FSaveDialog.Filename;
        FIsNew := false;
        if assigned(FOnSetCaption) then FOnSetCaption(FFilename);
        InsertFilename;
        UpdateList;
      end;
    end else begin
      if not FDirectSave then
        FSaveAsCancel := true;
    end;
  end;
end;

function TFileMenuHandler.SaveAs: boolean;
begin
  FDirectSave := true;
  Result := SaveAsProc;
  FDirectSave := false;
end;

function TFileMenuHandler.SaveQuery: Boolean;
begin
  Result := true;
  if (IsDirty) then
    case Application.MessageBox(
      pchar(Format(FFileChangedStr, [FFilename])),
      pchar(FFileChangedCaption),
      MB_YESNOCANCEL + MB_ICONWARNING) of
      mrCancel: begin
        Result := false;
        System.Exit;
      end;

      mrYes: Save;
    end;
end;

procedure TFileMenuHandler.InsertFilename;
var
  i: integer;
begin
  i := RecentList.IndexOf(FFilename);
  if i = -1 then RecentList.Insert(0, FFilename) else
    RecentList.Move(i, 0);
end;

procedure TFileMenuHandler.SetMaxItems(m: integer);
begin
  if (m > 9 + 26) then m := 9 + 26;
  FMaxList := m;
  if FEnabled then updatelist;
end;

procedure TFileMenuHandler.SetEnableMenuList(e: boolean);
var
  c: integer;
begin
  FEnableMenulist := e;
  if FEnabled then
  begin
    updatelist;
    if (not FEnableMenulist) and (assigned(FSeparator)) then
    begin
      for c := FFIleMenu.Count - 1 downto
        FFileMenu.IndexOf(FSeparator) do
        TMenuItem(FFileMenu.Items[c]).free;
      FSeparator := nil;
    end;
  end;
end;

procedure TFileMenuHandler.FMHCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  Exit(CanClose);
  if assigned(POnCloseQuery) then POnCloseQuery(Sender, CanClose);
end;

procedure TFileMenuHandler.FMHShow(Sender: TObject);
var fn: string;
begin
  if length(inipath) = 0 then
    IniPath := ExtractFilePath(paramstr(0));
  if assigned(POnShow) then POnShow(Sender);
  if length(IniFileName) > 0 then Loadrecentlist;
  if FParamcount <> 0 then begin
    fn := Paramstr(FParamcount);
    if FileExists(fn) then begin
      if FOnOpen(fn) then
      begin
        FFilename := fn;
        IsDirty := false;
        InsertFilename;
        UpdateList;
        FIsNew := false;
        if assigned(FOnSetCaption) then FOnSetCaption(FFilename);
        system.exit;
      end;
    end;
  end;
  if FLoadStart then
    New;
end;

procedure TFileMenuHandler.NotFoundDialog(const f: string);
begin
  application.MessageBox(pchar(Format(FNotFoundStr, [F])), nil, MB_OK
    + MB_ICONERROR);
end;

{v0.67}
procedure TFileMenuHandler.FileAdd(const AFileName: string);
var f: string;
begin
  if not FileExists(AFileName) then
    system.exit;
  f := FFileName;
  try
    FFileName := AFileName;
    InsertFileName;
    UpdateList;
  finally
    FFileName := f;
  end;
end;
{/v0.67}

end.

