was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

43 Visitors Online


 
...Liste zuletzt geöffneter Dateien im TMainMenu realisieren?
Autor: Phillip Kroll
Homepage: www.krollsoft.de
[ Tip ausdrucken ]  

Tip Bewertung (2):  
     


{
  Die folgende Unit enthält eine Klasse, die eine
  RecentListe in ein TMainMenu einfügt.
}

{
  This unit contains a class to add a
  RecentList in a TMainMenu.
}

unit UnitRecentList;

interface

uses 
Windows, SysUtils, menus, Registry, Forms, Dialogs, Classes;

type
  
TOnClickPorc = procedure(Path : stringof object;

type
  
TRecentList = class(TObject)
  private
    
Regis: TRegistryIniFile;
    Count: integer;
    Parent: TForm;
    MainMenu: TMainMenu;
    Items: TStringList;
    AddPos: integer;
    ClickProc: TOnClickPorc;
    Ident: integer;
  public
    
// Key      : Porduktname zum Beispiel "SuperSoftware"
    // Count    : Anzahl der angezeigten MenuItems
    // MainMenu : Das MainMenu auf dem Formular in dem angezeigt werden soll
    // Parent   : Das Parent Formular vom MainMenu (z.B. Form1)
    // Proc     : Prozedur, die ausgefürt werden soll, wenn auf ein MenuItem geklickt wird.
    //            z. B. "Procedure TForm1.RecentListClick(FileName : string);"
    
constructor Create(Key : string; Count, MenuIndex : integer;
      MainMenu : TMainMenu; Parent : TForm;
      Proc : TOnClickPorc);
    destructor Destroy; override;
    procedure CustomItemAdd(Value : string);
    procedure ItemsToMenu;
    procedure ItemClick(Sender : TObject);
  end;


implementation

constructor 
TRecentList.Create(Key : string; Count, MenuIndex : integer;
  MainMenu : TMainMenu; Parent : TForm;
  Proc : TOnClickPorc);
var
  
I : integer;
  NewItem : TMenuItem;
begin
  
// Initialisieren
  
Items := TStringList.Create;

  // Klasseneigenschaften setzen
  
Self.Count := Count;
  Self.Parent := Parent;
  Self.MainMenu := MainMenu;
  Self.Ident := MenuIndex;

  AddPos := MainMenu.Items[Ident].Count + 1;

  // Übergebene Prozedur gleich der der lokalen "ClickPorc" setzen
  
ClickProc := Proc;

  // TRegistryIniFile instanzieren
  
Regis := TRegistryIniFile.Create('Software\' + Key);

  // Trennstrisch realisieren
  
NewItem := TMenuItem.Create(Parent);
  NewItem.Caption := '-';
  MainMenu.Items[Ident].Add(NewItem);

  // über Schliefe alles einlesen
  
for i := 0 to Count - 1 do CustomItemAdd(Regis.ReadString('RecentFiles',
      'Item' + IntToStr(i) + IntToStr(Ident), ''));
end;

procedure TRecentList.ItemsToMenu;
var
  
NewItem : TMenuItem;
  I : integer;
begin
  
// Beim ersten mal "count" MenuItems erstellen
  
if MainMenu.Items[Ident].Count = AddPos then
    for 
i := 0 to Count - 1 do
    begin
      
NewItem := TMenuItem.Create(Parent);
      NewItem.Caption := '';
      NewItem.OnClick := ItemClick;
      MainMenu.Items[Ident].Add(NewItem);
    end;

  // Die Liste "Items" duchgehen und die MenuItems danach benennen
  
for I := 0 to Items.Count - 1 do
    
MainMenu.Items[Ident][i + AddPos].Caption := Items[i];

  // Dei leeren Einträge unsichtbar machen die vollen sichtbar
  
for I := 0 to Count - 1 do
    
MainMenu.Items[Ident][i + AddPos].Visible :=
      not (MainMenu.Items[Ident][i + AddPos].Caption = '');


  if Items.Count = 0 then MainMenu.Items[Ident][AddPos - 1].Visible := False
  else
    
MainMenu.Items[Ident][AddPos - 1].Visible := True;
end;


procedure TRecentList.ItemClick(Sender : TObject);
begin
  
ClickProc((Sender as TMenuItem).Caption);
end;

procedure TRecentlIst.CustomItemAdd(Value : string);
var
  
i : integer;
begin
  
// Prüfen
  
if Length(Value) = 0 then
  begin
    
ItemsToMenu;
    Exit;
  end;
  // Testen, ob "Value" schon vorkommt
  
for i := 0 to Items.Count - 1 do
    if 
(Items[i] = Value) then
    begin
      
Items.Delete(i);
      Break;
    end;
  // Items.Delete(i);
  // Eintrag anhängen
  
Items.Insert(0, Value);
  // Wenn Liste voll, dann letztes rausschmeissen
  
if Items.Count > Count then
  begin
    
//For i := 1 to Items.Count - 1 do Items[ i - 1 ] := Items[ i ];
    
Items.Delete(Items.Count - 1);
  end;
  // Anzeige aktuallisieren
  
ItemsToMenu;
end;

// FreeAndNil(TRecentList) bei OnClose nicht vergessen
destructor TRecentList.Destroy;
var
  
i : integer;
begin
  
// DAten in der Registry speichern
  
for i := 0 to Items.Count - 1 do
    
Regis.WriteString('RecentFiles', 'Item' + IntToStr(I) + IntToStr(Ident), Items[i]);

  // Speicherleichen ausradieren
  
Regis.Free;
end;

end.

{ Und so instanziert man die Klasse: }

//  Createn
// 1. Parameter : Registry Schlüssel
// 2. Parameter : Anzal der Einträge in der RecentList
// 3. Parameter : Nummer des MenüItems unter das die RecentList kommen soll (meistens 0)
// 4. Parameter : Das Menu, in die die Recentlist eingefügt werden soll
// 5. Parameter : Das Formular, in dem sich das Menu befindet
// 6. Parameter : Die Procedure, die ausgeführt werden soll, wenn auf einen Eintrag
//                in der Recentlist gecklickt wird.


procedure TForm1.FormCreate(Sender: TObject);
begin
 
RecentList.Create('SuperSoftware', 5, 0, MainMenu1, Self, Click);
end;

// Die Procedure wird ausgeführt, wenn auf einen Eintrag in der
// RecentList gecklickt wird.
// "Value" ist der Dateiname
procedure TForm1.Click(FilePath: string );
begin
 
DateiOeffnen(FilePath);
end;

// Einen Eintrag in die Rechenlist vorhehmen
procedure TForm1.Button1Click(Sender: TObject);
begin
 
RecentList.CustomItemAdd(Edit1.Text);
end;

// nicht vergessen, sonst werden die Änderungen nicht gespeichert
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 
FreeAndNil(RecentList);
end;


// von Sven Laufersweiler & Phillip Kroll


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners