ToolButtom

← →
андр (2007-12-19 15:54) [0]

В Delphi World усть такая статья:

Динамическое создание меню по XML-файлу -------------------------------------------------------------------------------- Оформил: DeeCo Автор: http://www.swissdelphicenter.ch { 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 ) -----------------------------------------------------------}

← →
андр (2007-12-19 15:54) [1]

{----------------------------------------------------------
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>
}

← →
андр (2007-12-19 15:55) [2]

Как можно переделать модуль чтоб по xml файлу можно мыло создавать Кнопки на понели инструментов..... ?

← →
turbouser © (2007-12-19 15:55) [3]

Ну есть, наверное. И что?

← →
oldman © (2007-12-19 15:55) [4]

ссылку лень было дать?

> андр (19.12.07 15:55) [2]

На какой панели инструментов?

← →
андр (2007-12-19 16:11) [6]

ToolButtom Найти похожие ветки