Mega Code Archive
Mrulist-recentfiles [component]
<![CDATA[
//www.dronymc.cjb.net
//drony@mynet.com
//icq:266148308
{Programınız ile daha önceden açtığınız dosyayı tekrar açmnınızı sağlar kayıtları ini dosyaseında tutat}
unit MruUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Forms, Menus, IniFiles, Registry;
type
TMRUMenuEvent = procedure (Sender: TObject; const Filename: string) of Object;
TMostRecentFiles = class(TComponent)
private
fMaxFiles: cardinal;
fMenuPosition: cardinal;
fOwnerMenuItem: TMenuItem;
fIniFilename: string;
fRegPath: string;
fShowFullPath: boolean;
fFileList: TStrings;
fMRUClickEvent: TMRUMenuEvent;
fNoFileEvent: TMRUMenuEvent;
procedure SetMaxFiles(count: cardinal);
procedure SetShowFullPath(value: boolean);
procedure LoadFilesFromReg;
procedure LoadFilesFromIni;
procedure SaveFilesToReg;
procedure SaveFilesToIni;
procedure SetIniFile(const aIniFile: string);
procedure SetRegPath(const aRegPath: string);
procedure SetOwnerMenu(aMenuItem: TMenuItem);
protected
procedure DoClick(Sender: TObject);
procedure RefreshList;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
//include a call to this method where ever a file is opened ...
function AddFile(const Filename: string): boolean;
published
property MaxFiles: cardinal read fMaxFiles write SetMaxFiles; {1..8}
property ShowFullPath: boolean read fShowFullPath write SetShowFullPath;
//the MRU list has to be attached somewhere ...
property OwnerMenuItem: TMenuItem read fOwnerMenuItem write SetOwnerMenu;
property MenuPosition: cardinal read fMenuPosition write fMenuPosition;
//store the list either in an ini file or in the registry ...
property IniFile: string read fIniFilename write SetIniFile;
property RegPath: string read fRegPath write SetRegPath;
//feedback an MRU menuItem click by assigning this event ...
property OnMenuClick: TMRUMenuEvent read fMRUClickEvent write fMRUClickEvent;
//optional event triggered whenever a clicked MRU file no longer exists...
property OnFileNotExist: TMRUMenuEvent read fNoFileEvent write fNoFileEvent;
end;
procedure Register;
const MRU_FLAG = $BAD1DEA;
implementation
resourceString
s_no_file_exists = 'The file ...'#10'"%s"'#10'no longer exists.';
procedure Register;
begin
RegisterComponents('Plus', [TMostRecentFiles]);
end;
//------------------------------------------------------------------------------
constructor TMostRecentFiles.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
fFileList := TStringList.create;
fMaxFiles := 4;
end;
//------------------------------------------------------------------------------
destructor TMostRecentFiles.Destroy;
begin
if not (csDesigning in ComponentState) then
try
if fRegPath = '' then
SaveFilesToIni else
SaveFilesToReg;
except
end;
fFileList.free;
inherited Destroy;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.Loaded;
begin
inherited Loaded;
if not (csDesigning in ComponentState) then
if fRegPath = '' then
LoadFilesFromIni else
LoadFilesFromReg;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent,Operation);
if (Operation = opRemove) and (AComponent = fOwnerMenuItem) then
fOwnerMenuItem := nil;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.LoadFilesFromReg;
var
i: cardinal;
s: string;
begin
fFileList.Clear;
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(fRegPath, false) then
begin
for i := 1 to fMaxFiles do
begin
if ValueExists('MRU'+inttostr(i)) then
s := readString('MRU'+inttostr(i)) else
break;
fFileList.Add(s);
end;
CloseKey;
end;
finally
free;
end;
RefreshList;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.LoadFilesFromIni;
var
i: cardinal;
LoadFrom, s: string;
begin
fFileList.Clear;
LoadFrom := extractfilepath(fIniFilename);
if LoadFrom <> '' then
LoadFrom := fIniFilename
else if fIniFilename = '' then
LoadFrom := changefileext(paramstr(0),'.ini') //use default ini filename
else
LoadFrom := ExtractfilePath(Paramstr(0))+ fIniFilename; //add a path
if fileExists(LoadFrom) then
with TIniFile.Create(LoadFrom) do
try
for i := 1 to fMaxFiles do
begin
s := readString('MRU List',inttostr(i),'');
if s = '' then break;
fFileList.Add(s);
end;
finally
free;
end;
RefreshList;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SaveFilesToReg;
var
i: integer;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(fRegPath, true) then
begin
for i := 1 to fMaxFiles do
if i > fFileList.Count then
writeString('MRU'+inttostr(i),'') else
writeString('MRU'+inttostr(i),fFileList[i-1]);
CloseKey;
end;
finally
free;
end;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SaveFilesToIni;
var
i: integer;
SaveTo: string;
begin
SaveTo := extractfilepath(fIniFilename);
if SaveTo <> '' then
SaveTo := fIniFilename
else if fIniFilename = '' then
SaveTo := changefileext(paramstr(0),'.ini') //use default ini filename
else
SaveTo := ExtractfilePath(Paramstr(0))+ fIniFilename;
with TIniFile.Create(SaveTo) do
try
for i := 1 to fMaxFiles do
if i > fFileList.Count then
writeString('MRU List',inttostr(i),'') else
writeString('MRU List',inttostr(i),fFileList[i-1]);
finally
free;
end;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SetRegPath(const aRegPath: string);
begin
fRegPath := aRegPath;
//if neither designing nor loading ...
if [csDesigning, csLoading] * ComponentState = [] then
if fRegPath = '' then
LoadFilesFromIni else
LoadFilesFromReg;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SetIniFile(const aIniFile: string);
begin
fIniFilename := aIniFile;
//if neither designing nor loading ...
if [csDesigning, csLoading] * ComponentState = [] then
if fRegPath = '' then
LoadFilesFromIni;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SetOwnerMenu(aMenuItem: TMenuItem);
begin
fOwnerMenuItem := aMenuItem;
//if neither designing nor loading ...
if [csDesigning, csLoading] * ComponentState = [] then
RefreshList;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SetMaxFiles(count: cardinal);
begin
if count = fMaxFiles then exit;
if count < 1 then fMaxFiles := 1
else if count > 8 then fMaxFiles := 8
else fMaxFiles := count;
RefreshList;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.SetShowFullPath(value: boolean);
begin
if value = fShowFullPath then exit;
fShowFullPath := value;
RefreshList;
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.RefreshList;
var
i, menuPos: integer;
procedure AddMRUMenuItem(index: integer; const Caption: string);
var
NewItem: TMenuItem;
begin
NewItem := TMenuItem.Create(fOwnerMenuItem);
try
NewItem.Caption := Caption;
NewItem.Tag := MRU_FLAG;
fOwnerMenuItem.Insert(index,NewItem);
if Caption <> '-' then
NewItem.OnClick := DoClick;
except
NewItem.Free;
raise;
end;
end;
begin
if (csDesigning in ComponentState) or not assigned(fOwnerMenuItem) then exit;
//remove all existing MRU items ...
for i := fOwnerMenuItem.Count-1 downto 0 do
if fOwnerMenuItem.Items[i].Tag = MRU_FLAG then fOwnerMenuItem.Delete(i);
if (fFileList.Count = 0) then exit; //that's it
if (integer(fMenuPosition) >= fOwnerMenuItem.Count) then
menuPos := fOwnerMenuItem.Count else
menuPos := fMenuPosition;
//? add a preceeding separator item...
if (menuPos > 0) and (fOwnerMenuItem.Items[menuPos-1].Caption <> '-') then
begin
AddMRUMenuItem(MenuPos,'-');
inc(MenuPos);
end;
for i := 0 to fFileList.Count-1 do
begin
if fShowFullPath then
AddMRUMenuItem(MenuPos, format('&%d %s',[i+1,fFileList[i]])) else
AddMRUMenuItem(MenuPos, format('&%d %s',[i+1,extractFilename(fFileList[i])]));
inc(MenuPos);
end;
//? add a trailing separator item...
if (menuPos < fOwnerMenuItem.Count ) and
(fOwnerMenuItem.Items[menuPos].Caption <> '-') then
AddMRUMenuItem(MenuPos,'-');
end;
//------------------------------------------------------------------------------
procedure TMostRecentFiles.DoClick(Sender: TObject);
var
i,idx: integer;
ParentMenuItem: TMenuItem;
s, filename: string;
begin
if not (Sender is TMenuItem) or not assigned(fMRUClickEvent) then exit;
ParentMenuItem := TMenuItem(Sender).Parent;
if not assigned(ParentMenuItem) then exit;
//get index of Sender menuItem within Parent's menuItem list
idx := ParentMenuItem.IndexOf(TMenuItem(Sender));
//find index of first item ...
i := 0;
while (i < ParentMenuItem.Count) and
(ParentMenuItem.items[i].Tag <> MRU_FLAG) do inc(i);
if (i = ParentMenuItem.Count) then exit; //should never happen
if ParentMenuItem.items[i].Caption = '-' then inc(i); //skips the separator
idx := idx -i; //this is the real index into fFileList
if (idx < 0) or (idx >= fFileList.Count) then exit; //should never happen
filename := fFileList[idx];
if not fileExists(filename) then
begin
//no file so warn then delete it from the list ...
if assigned(fNoFileEvent) then
fNoFileEvent(sender, filename) //eg: may prefer just a simple beep
else
begin
s := format(s_no_file_exists,[filename]);
if assigned(Owner) and (Owner is TCustomForm) then
MessageBox(TCustomForm(Owner).handle,
pchar(s),pchar(application.title), mb_iconInformation)
else
MessageBox(0, pchar(s),pchar(application.title), mb_iconInformation);
end;
fFileList.Delete(idx);
RefreshList;
end else
begin
//update order before doing something ...
if idx > 0 then
begin
fFileList.Delete(idx);
fFileList.Insert(0,Filename);
RefreshList;
end;
if assigned(fMRUClickEvent) then
fMRUClickEvent(Sender, filename);
end;
end;
//------------------------------------------------------------------------------
function TMostRecentFiles.AddFile(const Filename: string): boolean;
var
i: integer;
begin
result := false;
if not assigned(fOwnerMenuItem) then exit;
i := fFileList.IndexOf(Filename);
if i = 0 then exit //already the first file in list
else if i > 0 then fFileList.Delete(i);
fFileList.Insert(0,Filename);
while fFileList.count > integer(fMaxFiles) do fFileList.delete(fMaxFiles);
RefreshList;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
end.
]]>