Динамическое создание меню по XML-файлу

Советы » XML » Динамическое создание меню по XML-файлу

{ 
  The following procedure allows you to build a menu from an XML file. 
  Special feature: You only need to specify the Name of the procedure which then 
  will be attached to a OnClick handler. 
  Note that the procedure must be declared as public. 
}

 { 
  Mit folgender Prozedur kann man aus einem XML-File ein Menu 
  erstellen lassen (einfach im OnCreate aufrufen). 
  Besonderes Feature: Im XML-File gebt ihr nur den Namen der Prozedur an, 
  die dem OnClick-Ereignis zugewiesen werden soll. 
  Die einzige Einschrankung besteht darin, dass diese Prozedur 
  published sein muss. 
  Bindet einfach diese Prozedur in euer Hauptformular ein: 
}


 procedure

TMainForm.CreateMenuFromXMLFile; function

Get_Int(S: string

): Integer; begin

Result := 0; try

Result := StrToInt(S); except

end

; end

; procedure

AddRecursive(Parent: TMenuItem; Item: IXMLNode); var

I: Integer; Node: TMenuItem; Child: IXMLNode; Address: TMethod; begin

Node := TMenuItem.Create(Parent); if

(Uppercase(Item.Attributes['CAPTION']) <> 'SEPERATOR') then

begin

Node.Caption := Item.Attributes['CAPTION']; if

(Uppercase(Item.Attributes['ID']) <> 'NONE') then

begin

Address.Code := MethodAddress(Item.Attributes['ID']); Address.Data := Self; if

(Item.ChildNodes.Count - 1 < 0) then

Node.OnClick := TNotifyEvent(Address); end

; if

(Uppercase(Item.Attributes['SHORTCUT']) <> 'NONE') then

Node.ShortCut := TextToShortCut(Item.Attributes['SHORTCUT']); Node.Checked := (Item.Attributes['CHECKED'] = '1'); end

else

Node.Caption := '-'; Node.Visible := (Item.Attributes['VISIBLE'] = '1'); if

Parent <> nil

then

Parent.Add(Node) else

MainMenu.Items.Add(Node); for

I := 0 to

Item.ChildNodes.Count - 1 do

begin

Child := item.ChildNodes[i]; if

(Child.NodeName = 'ENTRY') then

AddRecursive(Node, Child); end

; end

; var

Root: IXMLMENUType; Parent: TMenuItem; I: Integer; Child: IXMLNode; begin

XMLDocument.FileName := ExtractFilePath(Application.ExeName) + XMLFile; if

not

FileExists(XMLDocument.FileName) then

begin

MessageDlg('Menu-XML-Document nicht gefunden!', mtError, [mbOK], 0); Halt; end

; XMLDocument.Active := True; Screen.Cursor := crHourglass; try

Root := GetXMLMenu(XMLDocument); Parent := nil

; for

I := 0 to

Root.ChildNodes.Count - 1 do

begin

Child := Root.ChildNodes[i]; if

(Child.NodeName = 'ENTRY') then

AddRecursive(Parent, Child); end

; finally

Screen.Cursor := crDefault; end

; end

; {---------------------------------------------------------- You also need the encapsulation of the XML-File. ( Save it as unit and add it to your program. Created with Delphi6 -> New -> XML Data Binding Wizard ) -----------------------------------------------------------} {---------------------------------------------------------- Naturlich braucht man auch die Kapselung des XML-Files (Als Unit speichern und ins Programm einbinden. Die Datei wurde mit Delphi 6 -> Neu -> XML-Datenbindung erstellt): -----------------------------------------------------------} {***************************************************} { } { Delphi XML-Datenbindung } { } { Erzeugt am: 27.06.2002 13:25:01 } { } {***************************************************} unit

XMLMenuTranslation; interface

uses

xmldom, XMLDoc, XMLIntf; type

{ Forward-Deklarationen } IXMLMENUType = interface

; IXMLENTRYType = interface

; { IXMLMENUType } IXMLMENUType = interface

(IXMLNode) ['{8F36F5E2-834F-41D9-918F-9B1A441C9074}'] { Zugriff auf Eigenschaften } function

Get_ENTRY: IXMLENTRYType; { Methoden & Eigenschaften } property

ENTRY: IXMLENTRYType read

Get_ENTRY; end

; { IXMLENTRYType } IXMLENTRYType = interface

(IXMLNode) ['{AD85CD05-725E-40F8-A8D7-D6EC05FD4360}'] { Zugriff auf Eigenschaften } function

Get_CAPTION: WideString; function

Get_VISIBLE: Integer; function

Get_ID: Integer; function

Get_ENTRY: IXMLENTRYType; procedure

Set_CAPTION(Value: WideString); procedure

Set_VISIBLE(Value: Integer); procedure

Set_ID(Value: Integer); { Methoden & Eigenschaften } property

Caption: WideString read

Get_CAPTION write

Set_CAPTION; property

Visible: Integer read

Get_VISIBLE write

Set_VISIBLE; property

ID: Integer read

Get_ID write

Set_ID; property

ENTRY: IXMLENTRYType read

Get_ENTRY; end

; { Forward-Deklarationen } TXMLMENUType = class

; TXMLENTRYType = class

; { TXMLMENUType } TXMLMENUType = class

(TXMLNode, IXMLMENUType) protected

{ IXMLMENUType } function

Get_ENTRY: IXMLENTRYType; public

procedure

AfterConstruction; override

; end

; { TXMLENTRYType } TXMLENTRYType = class

(TXMLNode, IXMLENTRYType) protected

{ IXMLENTRYType } function

Get_CAPTION: WideString; function

Get_VISIBLE: Integer; function

Get_ID: Integer; function

Get_ENTRY: IXMLENTRYType; procedure

Set_CAPTION(Value: WideString); procedure

Set_VISIBLE(Value: Integer); procedure

Set_ID(Value: Integer); public

procedure

AfterConstruction; override

; end

; { Globale Funktionen } function

GetXMLMENU(Doc: IXMLDocument): IXMLMENUType; function

LoadMENU(const

FileName: WideString): IXMLMENUType; function

NewMENU: IXMLMENUType; implementation

{ Globale Funktionen } function

GetXMLMENU(Doc: IXMLDocument): IXMLMENUType; begin

Result := Doc.GetDocBinding('MENU', TXMLMENUType) as

IXMLMENUType; end

; function

LoadMENU(const

FileName: WideString): IXMLMENUType; begin

Result := LoadXMLDocument(FileName).GetDocBinding('MENU', TXMLMENUType) as

IXMLMENUType; end

; function

NewMENU: IXMLMENUType; begin

Result := NewXMLDocument.GetDocBinding('MENU', TXMLMENUType) as

IXMLMENUType; end

; { TXMLMENUType } procedure

TXMLMENUType.AfterConstruction; begin

RegisterChildNode('ENTRY', TXMLENTRYType); inherited

; end

; function

TXMLMENUType.Get_ENTRY: IXMLENTRYType; begin

Result := ChildNodes['ENTRY'] as

IXMLENTRYType; end

; { TXMLENTRYType } procedure

TXMLENTRYType.AfterConstruction; begin

RegisterChildNode('ENTRY', TXMLENTRYType); inherited

; end

; function

TXMLENTRYType.Get_CAPTION: WideString; begin

Result := ChildNodes['CAPTION'].Text; end

; procedure

TXMLENTRYType.Set_CAPTION(Value: WideString); begin

ChildNodes['CAPTION'].NodeValue := Value; end

; function

TXMLENTRYType.Get_VISIBLE: Integer; begin

Result := ChildNodes['VISIBLE'].NodeValue; end

; procedure

TXMLENTRYType.Set_VISIBLE(Value: Integer); begin

ChildNodes['VISIBLE'].NodeValue := Value; end

; function

TXMLENTRYType.Get_ID: Integer; begin

Result := ChildNodes['ID'].NodeValue; end

; procedure

TXMLENTRYType.Set_ID(Value: Integer); begin

ChildNodes['ID'].NodeValue := Value; end

; function

TXMLENTRYType.Get_ENTRY: IXMLENTRYType; begin

Result := ChildNodes['ENTRY'] as

IXMLENTRYType; end

; end

. {--------------------------------------------------------------------- Finally, I'll show you an example for the XML-File. The Procedure Name is assigned to the ID which then will be called. ---------------------------------------------------------------------} {--------------------------------------------------------------------- Als Beispiel fur das XML-File hier noch eines aus einem meiner Programme. In

ID steht der Name der Prozedur, die man als OnClick aufrufen will - denkt auch daran, dass diese Prozedur unbedingt als published

deklariert sein muss, sonst liefert MethodAddress() Nil

zuruck. ----------------------------------------------------------------------} { <?xml version="1.0" encoding="ISO-8859-1"?> <MENU> <ENTRY CAPTION="Datei" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0"> <ENTRY CAPTION="Beenden" VISIBLE="1" ID="CloseProgram" SHORTCUT="Strg+X" CHECKED="0"></ENTRY> </ENTRY> <ENTRY CAPTION="Anzeige" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0"> <ENTRY CAPTION="Toolbar" VISIBLE="1" ID="ShowToolbar" SHORTCUT="None" CHECKED="1"></ENTRY> <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY> <ENTRY CAPTION="Optionen" VISIBLE="1" ID="ShowOptionen" SHORTCUT="Strg+O" CHECKED="0"></ENTRY> </ENTRY> <ENTRY CAPTION="News" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0"> <ENTRY CAPTION="Refresh" VISIBLE="1" ID="RefreshAll" SHORTCUT="F5" CHECKED="0"></ENTRY> <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY> <ENTRY CAPTION="Administration" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0"> <ENTRY CAPTION="neue Nachricht hinzufugen" VISIBLE="1" ID="NewMarkedNews" SHORTCUT="Strg+N" CHECKED="0"></ENTRY> <ENTRY CAPTION="markierte Nachricht bearbeiten" VISIBLE="1" ID="EditMarkedNews" SHORTCUT="Strg+E" CHECKED="0"></ENTRY> <ENTRY CAPTION="markierte Nachricht loschen" VISIBLE="1" ID="DeleteMarkedNews" SHORTCUT="None" CHECKED="0"></ENTRY> <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY> <ENTRY CAPTION="Film hinzufugen" VISIBLE="1" ID="AddMPG" SHORTCUT="None" CHECKED="0"></ENTRY> <ENTRY CAPTION="markierten Film loschen" VISIBLE="1" ID="DeleteMPG" SHORTCUT="None" CHECKED="0"></ENTRY> </ENTRY> </ENTRY> <ENTRY CAPTION="Hilfe" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0"> <ENTRY CAPTION="LogView" VISIBLE="1" ID="ShowLog" SHORTCUT="Strg+L" CHECKED="0"></ENTRY> <ENTRY CAPTION="eMail schreiben" VISIBLE="1" ID="WriteEMail" SHORTCUT="None" CHECKED="0"></ENTRY> <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY> <ENTRY CAPTION="Uber" VISIBLE="1" ID="About" SHORTCUT="None" CHECKED="0"></ENTRY> </ENTRY> </MENU> }

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com