I hope this helps?
At 12:49 PM 14/09/2007 +0200, you wrote:
>Hi,
>
>Does Lazarus have a MRU component? If not, anybody know where I could
>get one to port.
>
>
>--
>fpGUI - a cross-platform Free Pascal GUI toolkit
>http://opensoft.homeip.net/fpgui/
>
>_
> To unsubscribe: mail [EMAIL PROTECTED] with
>"unsubscribe" as the Subject
> archives at http://www.lazarus.freepascal.org/mailarchives
>
-unit adpMRU;
{$mode objfpc}{$H+}
interface
uses
Windows, Messages, SysUtils, Classes, Menus, Registry;
type
TMRUClickEvent = procedure(Sender: TObject; const FileName: String) of object;
TadpMRU = class(TComponent)
private
FItems : TStringList;
FMaxItems: cardinal;
FShowFullPath: boolean;
FRegistryPath: string;
FParentMenuItem: TMenuItem;
FOnClick: TMRUClickEvent;
procedure SetMaxItems(const Value: cardinal);
procedure SetShowFullPath(const Value: boolean);
procedure SetRegistryPath(const Value: string);
procedure SetParentMenuItem(const Value: TMenuItem);
procedure LoadMRU;
procedure SaveMRU;
procedure ItemsChange(Sender: TObject);
procedure ClearParentMenu;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
procedure DoClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddItem(const FileName: string);
function RemoveItem(const FileName : string) : boolean;
published
property MaxItems: cardinal read FMaxItems write SetMaxItems default 4;
property ShowFullPath: boolean read FShowFullPath write SetShowFullPath
default True;
property RegistryPath: string read FRegistryPath write SetRegistryPath;
property ParentMenuItem: TMenuItem read FParentMenuItem write
SetParentMenuItem;
property OnClick: TMRUClickEvent read FOnClick write FOnClick;
end;
procedure Register;
implementation
type
TMRUMenuItem = class(TMenuItem); //to be able to recognize MRU menu item when
deleting
procedure Register;
begin
RegisterComponents('delphi.about.com', [TadpMRU]);
end;
{ TadpMRU }
constructor TadpMRU.Create(AOwner: TComponent);
begin
inherited;
FParentMenuItem := nil;
FItems := TStringList.Create;
FItems.OnChange := ItemsChange;
FMaxItems := 4;
FShowFullPath := True;
end; (*Create*)
procedure TadpMRU.Loaded;
begin
inherited;
if not (csDesigning in ComponentState) then
if FRegistryPath <> '' then LoadMRU;
end; (*Loaded*)
destructor TadpMRU.Destroy;
begin
if not (csDesigning in ComponentState) then SaveMRU;
FItems.OnChange := nil;
FItems.Free;
inherited;
end; (*Destroy*)
procedure TadpMRU.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FParentMenuItem) then
FParentMenuItem := nil;
end; (*Notification*)
procedure TadpMRU.AddItem(const FileName: string);
begin
if FileName <> '' then
begin
FItems.BeginUpdate;
try
if FItems.IndexOf(FileName) > -1 then
FItems.Delete(FItems.IndexOf(FileName));
FItems.Insert(0, FileName);
while FItems.Count > MaxItems do
FItems.Delete(MaxItems);
finally
FItems.EndUpdate;
end;
end;
end; (*AddItem*)
function TadpMRU.RemoveItem(const FileName: string): boolean;
begin
if FItems.IndexOf(FileName) > -1 then
begin
FItems.Delete(FItems.IndexOf(FileName));
Result := True;
end
else
Result := False;
end; (*RemoveItem*)
procedure TadpMRU.SetMaxItems(const Value: Cardinal);
begin
if Value <> FMaxItems then
begin
if Value < 1 then FMaxItems := 1
else
if Value > MaxInt then
FMaxItems := MaxInt - 1
else
begin
FMaxItems := Value;
FItems.BeginUpdate;
try
while FItems.Count > MaxItems do
FItems.Delete(FItems.Count - 1);
finally
FItems.EndUpdate;
end;
end;
end;
end; (*SetMaxItems*)
procedure TadpMRU.SetRegistryPath(const Value: string);
begin
if FRegistryPath <> Value then
begin
FRegistryPath := Value;
LoadMRU;
end;
end; (*SetRegistryPath*)
procedure TadpMRU.SetShowFullPath(const Value: boolean);
begin
if FShowFullPath <> Value then
begin
FShowFullPath := Value;
ItemsChange(Self);
end;
end; (*SetShowFullPath*)
procedure TadpMRU.LoadMRU;
var
i: cardinal;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(FRegistryPath, False) then
begin
FItems.BeginUpdate;
FItems.Clear;
try
for i := 1 to FMaxItems do
if ValueExists('MRU'+IntToStr(i)) then
FItems.Add(ReadString('MRU'+IntToStr(i)));
finally
FItems.EndUpdate;
end;
CloseKey;
end;
finally
Free;
end;
end; (*LoadMRU*)
procedure TadpMRU.SaveMRU;
var
i: integ
