Answer:
Below is a unit file that you can use to create such a thing.
Just cut the code into a pas file, name it "FileHistoryUnit.pas" and add
"FileHistoryUnit" to the uses clause in your main forms source file.
Some notes:
To add a file to the menu:
History.AddFile('C:\myfile.txt','This is my file');
History.BuildMenu(RecentFiles1,false);
To Init the History list upon application start
History.HistoryRegKey := '\Software\MyBrand\AppName\History';
History.BuildMenu(MainForm.RecentFiles1,false);
You might want to use the three events "OnHistoryItemQuery", "OnHistoryCleared" and "OnHistoryListUpdated" for handling when a user clicks a file or clears the list.
In the "OnHistoryCleared" procedure of your application you should just rebuild the menuitem. In the "OnHistoryItemQuery" you should use the HistoryItem.Filename to open the file and return TRUE so that TFileHistory updates the time for last use and puts the file at the top of the list.
In "OnHistoryListUpdated" you should just rebuild all the menus you use by calling "History.BuildMenu".
Happy coding!
unit FileHistoryUnit;
//——————————————————————————————————————————————————————————————————————————————
// FILEHISTORY v1.0
// (C) Copyright 2002 Magnus Flysjö SWEDEN
// Written by Magnus Flysjö 2002
// Need more info? magnus@flysjo.com
//
// NOTE! The application is resposible for removing MenuItems after Load calls!!
// If this is not done, you will get an AV when clicking on MenuItems created
// with TFileHistory.BuildMenu!!!
//
//——————————————————————————————————————————————————————————————————————————————
interface
uses Graphics, classes, comctrls, SysUtils, messages, Menus, Windows;
const
DefaultHistoryRegKey = '\Software\ELS\APM\FileHistory'; // Regsitry key to store history in
DefaultHistoryItemStore = 10; // Number of files stored
type
TFileHistoryItem = class;
TFileHistory = class;
//Event declarations
THistoryItemQuery = function(HistoryItem : TFileHistoryItem; var MoveItemToTop : boolean) : boolean of object;
TFileHistoryEvent = procedure(History : TFileHistory) of object;
//——————————————————————————————————————————————————————————————————————————————
TFileHistoryItem = class(TCollectionItem)
constructor Create(Collection : TCollection); override;
destructor Destroy; override;
private
FUseDate : TDateTime;
FFilename : string;
FDescription : string;
procedure FillMenuItem(MenuItem : TMenuItem; UseDescription : boolean);
public
// Methods
function StreamSize : integer;
procedure SaveToStream(Stream : TStream);
function LoadFromStream(Stream : TStream) : boolean;
procedure HistoryMenuClick(Sender : TObject);
// Properties
property UseDate : TDateTime read FUseDate write FUseDate;
property Filename : string read FFilename write FFilename;
property Description : string read FDescription write FDescription;
end;
TFileHistory = class(TCollection)
constructor Create;
destructor Destroy; override;
private
FOnHistoryItemQuery : THistoryItemQuery;
FOnHistoryCleared : TFileHistoryEvent;
FOnHistoryUpdated : TFileHistoryEvent;
FMaxItems : integer;
FHistoryRegKey : string;
FUseClearMenuItem : boolean;
function FGetHistoryItem(idx : integer) : TFileHistoryItem;
procedure HistoryItemQuery(Item : TFileHistoryItem);
function Add : TFileHistoryItem;
procedure FSetHistoryRegKey(value : string);
function HistoryExists(Filename : string) : boolean;
public
// Methods
procedure ClearMenuClick(Sender : TObject);
function GetHistoryItemFromFilename(Filename : string) : TFileHistoryItem;
procedure LoadFromReg;
procedure SaveToReg;
function StreamSize : integer;
procedure SaveToStream(Stream : TStream);
function LoadFromStream(Stream : TStream; ClearList : boolean) : boolean;
procedure SaveToFile(Filename : String);
function LoadFromFile(filename : string) : boolean;
procedure BuildMenu(MenuItem : TMenuItem; UseDescription : boolean);
function AddHistory(Filename : string; Description : string) : TFileHistoryItem;
// Properties
property HistoryItem[idx : integer] : TFileHistoryItem read FGetHistoryItem; default;
published
// Properties
property MaxItems : integer read FMaxItems write FMaxItems;
property HistoryRegKey : string read FHistoryRegKey write FSetHistoryRegKey;
property UseClearMenuItem : boolean read FUseClearMenuItem write FUseClearMenuItem;
// Events
property OnHistoryItemQuery : THistoryItemQuery read FOnHistoryItemQuery write FOnHistoryItemQuery;
property OnHistoryCleared : TFileHistoryEvent read FOnHistoryCleared write FOnHistoryCleared;
property OnHistoryListUpdated : TFileHistoryEvent read FOnHistoryUpdated write FOnHistoryUpdated;
end;
var FileHistory : TFileHistory;
//——————————————————————————————————————————————————————————————————————————————
implementation
uses Registry;
type
TStreamHead = packed record
ID : word;
ver : word;
size : integer;
count : integer;
end;
//——————————————————————————————————————————————————————————————————————————————
procedure WriteStringToStream(st : TStream; s : string);
var ln : word;
begin
ln := length(s);
st.Write(ln,2);
st.WriteBuffer(Pointer(s)^,ln);
end;
function ReadStringFromStream(st : TStream) : string;
var sln : word;
str : string;
begin
st.Read(sln,2);
SetLength(str,sln);
Fillchar(str[1],sln,0);
st.ReadBuffer(Pointer(str)^,sln);
result := str;
end;
//—[TFileHistoryItem]———————————————————————————————————————————————————————————
constructor TFileHistoryItem.Create(Collection : TCollection);
begin
if (Collection is TFileHistory) then begin
inherited Create(Collection);
FUseDate := now;
FFilename := '';
FDescription := '';
end else begin
raise Exception.Create('TFileHistoryItem must be created from a TFileHistory class');
end;
end;
destructor TFileHistoryItem.Destroy;
begin
inherited Destroy;
end;
procedure TFileHistoryItem.FillMenuItem(MenuItem : TMenuItem; UseDescription : boolean);
begin
if Assigned(MenuItem) then begin
if UseDescription then begin
MenuItem.Caption := '&'+inttostr(index)+#32+Description+' ('+DateTimeToStr(UseDate)+')';
end else begin
MenuItem.Caption := '&'+inttostr(index)+#32+Filename+' ('+DateTimeToStr(UseDate)+')';
end;
MenuItem.OnClick := HistoryMenuClick;
MenuItem.Tag := index;
end;
end;
function TFileHistoryItem.StreamSize : integer;
begin
result := 16;
inc(result,length(FFilename));
inc(result,length(FDescription));
end;
procedure TFileHistoryItem.SaveToStream(Stream : TStream);
begin
if Assigned(Stream) then begin
Stream.Write(FUseDate,8);
WriteStringToStream(Stream,FFilename);
WriteStringToStream(Stream,FDescription);
end;
end;
function TFileHistoryItem.LoadFromStream(Stream : TStream) : boolean;
begin
if Assigned(Stream) then begin
try
Stream.Read(FUseDate,8);
FFilename := ReadStringFromStream(Stream);
FDescription := ReadStringFromStream(Stream);
result := true;
except
FDescription := 'Error loading history item';
result := false;
end;
end else result := false;
end;
procedure TFileHistoryItem.HistoryMenuClick(Sender : TObject);
begin
if Assigned(Collection) then begin
TFileHistory(Collection).HistoryItemQuery(self);
end;
end;
//—[TFileHistory]———————————————————————————————————————————————————————————————
constructor TFileHistory.Create;
begin
inherited Create(TFileHistoryItem);
FHistoryRegKey := DefaultHistoryRegKey;
FMaxItems := DefaultHistoryItemStore;
FUseClearMenuItem := true;
FOnHistoryItemQuery := nil;
FOnHistoryCleared := nil;
FOnHistoryUpdated := nil;
end;
destructor TFileHistory.Destroy;
begin
SaveToReg;
inherited Destroy;
end;
function TFileHistory.FGetHistoryItem(idx : integer) : TFileHistoryItem;
begin
if (idx >= 0) and (idx < count) then begin
result := TFileHistoryItem(items[idx]);
end else result := nil;
end;
procedure TFileHistory.HistoryItemQuery(Item : TFileHistoryItem);
var MoveToTop,Ok : boolean;
begin
if Assigned(Item) then begin
MoveToTop := true;
if Assigned(FOnHistoryItemQuery) then begin
Ok := FOnHistoryItemQuery(Item,MoveToTop);
end else Ok := false;
if Ok then begin
if MoveToTop then Item.Index := 0;
Item.UseDate := now;
if Assigned(FOnHistoryUpdated) then FOnHistoryUpdated(self);
end;
end;
end;
function TFileHistory.Add : TFileHistoryItem;
begin
result := TFileHistoryItem(inherited Add);
end;
procedure TFileHistory.FSetHistoryRegKey(value : string);
begin
if (Value <> FHistoryRegKey) then begin
FHistoryRegKey := value;
LoadFromReg;
end;
end;
procedure TFileHistory.LoadFromReg;
var Reg : TRegistry;
lp0,HisCnt : integer;
HistItem : TFileHistoryItem;
HistRegStr,Filename : string;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.KeyExists(FHistoryRegKey) then begin
Reg.OpenKeyReadOnly(FHistoryRegKey);
try
if Reg.ValueExists('HistoryCount') then begin
HisCnt := Reg.ReadInteger('HistoryCount');
Clear;
for lp0 := 0 to HisCnt-1 do begin
HistRegStr := 'History'+inttostr(lp0);
if Reg.ValueExists('File'+HistRegStr) then begin
Filename := Reg.ReadString('File'+HistRegStr);
if FileExists(Filename) then begin
HistItem := Add;
HistItem.Filename := Filename;
if Reg.ValueExists('Desc'+HistRegStr) then HistItem.Description := Reg.ReadString('Desc'+HistRegStr);
if Reg.ValueExists('Date'+HistRegStr) then HistItem.UseDate := Reg.ReadDateTime('Date'+HistRegStr);
end;
end;
end;
if Assigned(FOnHistoryUpdated) then FOnHistoryUpdated(self);
end;
finally
Reg.CloseKey;
end;
end;
Reg.free;
end;
procedure TFileHistory.SaveToReg;
var Reg : TRegistry;
OkWrite : boolean;
lp0 : integer;
HistItem : TFileHistoryItem;
HistRegStr : string;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.KeyExists(FHistoryRegKey) = false then begin
OkWrite := Reg.CreateKey(FHistoryRegKey);
end else OkWrite := true;
if OkWrite then begin
Reg.OpenKey(FHistoryRegKey,true);
try
Reg.WriteInteger('HistoryCount',count);
for lp0 := 0 to count-1 do begin
HistItem := HistoryItem[lp0];
HistRegStr := 'History'+inttostr(lp0);
Reg.WriteString('File'+HistRegStr,HistItem.Filename);
Reg.WriteString('Desc'+HistRegStr,HistItem.Description);
Reg.WriteDateTime('Date'+HistRegStr,HistItem.UseDate);
end;
finally
Reg.CloseKey;
end;
end;
Reg.free;
end;
function TFileHistory.StreamSize : integer;
var lp0 : integer;
begin
result := SizeOf(TStreamHead);
for lp0 := 0 to count-1 do begin
inc(result,HistoryItem[lp0].StreamSize);
end;
end;
procedure TFileHistory.SaveToStream(Stream : TStream);
var Head : TStreamHead;
lp0 : integer;
begin
Head.ID := $2080;
Head.ver := $0100;
Head.size := StreamSize;
Head.count := count;
Stream.WriteBuffer(Head,Sizeof(TStreamHead));
for lp0 := 0 to count-1 do begin
HistoryItem[lp0].SaveToStream(Stream);
end;
end;
function TFileHistory.LoadFromStream(Stream : TStream; ClearList : boolean) : boolean;
var Head : TStreamHead;
lp0 : integer;
begin
stream.ReadBuffer(head,Sizeof(TStreamHead));
if (Head.ID = $2080) then begin
try
if ClearList then Clear;
result := true;
for lp0 := 0 to Head.count-1 do begin
result := result and Add.LoadFromStream(stream);
end;
if Assigned(FOnHistoryUpdated) then FOnHistoryUpdated(self);
except
result := false;
end;
end else begin
result := false;
end;
end;
procedure TFileHistory.SaveToFile(Filename : String);
var Stream : TFileStream;
begin
Stream := TFileStream.Create(Filename,fmCreate);
try
SaveToStream(Stream);
finally
Stream.free;
end;
end;
function TFileHistory.LoadFromFile(filename : string) : boolean;
var Stream : TFileStream;
begin
Stream := TFileStream.Create(Filename,fmOpenRead);
try
result := LoadFromStream(Stream,true);
finally
Stream.free;
end;
end;
procedure TFileHistory.ClearMenuClick(Sender : TObject);
begin
Clear;
SaveToReg;
if Assigned(FOnHistoryCleared) then FOnHistoryCleared(self);
end;
procedure TFileHistory.BuildMenu(MenuItem : TMenuItem; UseDescription : boolean);
var lp0 : integer;
NewMenuItem : TMenuItem;
begin
if Assigned(MenuItem) then begin
MenuItem.Clear;
for lp0 := 0 to count-1 do begin
NewMenuItem := TMenuItem.Create(MenuItem);
HistoryItem[lp0].FillMenuItem(NewMenuItem,UseDescription);
MenuItem.Add(NewMenuItem);
end;
if FUseClearMenuItem then begin
NewMenuItem := TMenuItem.Create(MenuItem);
NewMenuItem.Caption := '-';
NewMenuItem := TMenuItem.Create(MenuItem);
NewMenuItem.Caption := '&Clear History';
NewMenuItem.OnClick := ClearMenuClick;
end;
end;
end;
function TFileHistory.HistoryExists(Filename : string) : boolean;
var lp0 : integer;
begin
result := false;
for lp0 := 0 to count-1 do begin
if AnsiCompareFileName(filename,HistoryItem[lp0].Filename) = 0 then begin
result := true;
break;
end;
end;
end;
function TFileHistory.GetHistoryItemFromFilename(Filename : string) : TFileHistoryItem;
var lp0 : integer;
begin
result := nil;
for lp0 := 0 to count-1 do begin
if AnsiCompareFileName(filename,HistoryItem[lp0].Filename) = 0 then begin
result := HistoryItem[lp0];
break;
end;
end;
end;
function TFileHistory.AddHistory(Filename : string; Description : string) : TFileHistoryItem;
begin
result := GetHistoryItemFromFilename(Filename);
if (result = nil) then begin
if FileExists(Filename) then begin
result := Add;
result.Filename := Filename;
result.Description := Description;
result.UseDate := now;
result.Index := 0;
if Count > FMaxItems then begin
HistoryItem[count-1].free;
end;
SaveToReg;
if Assigned(FOnHistoryUpdated) then FOnHistoryUpdated(self);
end;
end else begin
result.Description := Description;
result.UseDate := now;
result.Index := 0;
SaveToReg;
if Assigned(FOnHistoryUpdated) then FOnHistoryUpdated(self);
end;
end;
//——————————————————————————————————————————————————————————————————————————————
initialization
FileHistory := TFileHistory.Create;
finalization
FileHistory.free;
end.
|
Sign Up
