Текущий архив: 2007.12.02;
Скачать: CL | DM;

Вниз

to Delphi 7   Найти похожие ветки 

← →
de.   (2007-10-11 10:29) [0]

Необходимо переделать код в Delphi
http://www.codeproject.com/useritems/XML_Driven_Menu_Strip.asp
Как можно реализовать.?

---

← →
stone ©   (2007-10-11 10:34) [1]

Взять и переделать. Не можешь сам, найми кого-нибудь.

---

← →
clickmaker ©   (2007-10-11 10:37) [2]

а чего там сложного? Берешь TXMLDocument, TMainMenu и вперед и с рекурсией

---

← →
de.   (2007-10-11 12:01) [3]

xml.GetDocBinding("Menu", ??????????)
что означает и что должно содержать.? И что должно содержатся там где вопросы...

---

← →
clickmaker ©   (2007-10-11 12:59) [4]

> GetDocBinding

а это зачем?

---

← →
de.   (2007-10-11 13:08) [5]


procedure TfrmMain.FormCreate(Sender: TObject);

 procedure prAddItemMenu(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
       mm.Items.Add(Node);

     for I := 0 to Item.ChildNodes.Count - 1 do
       begin
         Child := item.ChildNodes[i];
         if (Child.NodeName = "ENTRY") then
         prAddItemMenu(Node, Child);
       end;
   end;
 
var
 Root: IXMLNode;
 Parent: TMenuItem;
 I: Integer;
 Child: IXMLNode;
begin
  if not xml.Active then
    xml.Active := True;

  Screen.Cursor := crHourglass;
  try
    Root := xml.GetDocBinding("MENU", ????);
    Parent := nil;

    for I := 0 to Root.ChildNodes.Count - 1 do
      begin
        Child := xml.ChildNodes[i];
        if (Child.NodeName = "ENTRY") then
          prAddItemMenu(Parent, Child);
      end;
  finally
    Screen.Cursor := crDefault;
  end;
end;


---

← →
de.   (2007-10-11 13:09) [6]

Это из примера



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;



---

← →
de.   (2007-10-11 13:10) [7]

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.


---

← →
de.   (2007-10-11 13:11) [8]

<?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>


---

← →
clickmaker ©   (2007-10-11 13:11) [9]

Root := xml.DocumentElement()?

---

← →
de.   (2007-10-11 13:12) [10]

Не могу построить чтоб можно было обойтись без модуля
de.   (11.10.07 13:10) [7]

unit XMLMenuTranslation;

---

← →
clickmaker ©   (2007-10-11 13:17) [11]

так зачем бездумно копировать чужие примеры?
логику построения меню осознал?
там работы на 20 минут от силы, без всяких XMLMenuTranslation

---

← →
de.   (2007-10-11 13:24) [12]

> clickmaker ©   (11.10.07 13:17) [11]

Да логику осознал, рекурсивно строим элементы меню, по дереву xml....
Проблема немного другая, просто я с работой xml в Delphi  плохо знаком...
Еслиб кто пожевал мне, или привет свои примеры, я бы был примного благодарен.!

---

← →
Игорь Шевченко ©   (2007-10-11 13:26) [13]

> Еслиб кто пожевал мне, или привет свои примеры, я бы был
> примного благодарен.!


Если б кто заплатил я бы тоже был благодарен

---

← →
de.   (2007-10-11 13:30) [14]

> Игорь Шевченко ©   (11.10.07 13:26) [13]

Исикока будет стоить модуль построения динамического меню из xml.?
Я имею введу только построение... т.е. правильную организацию рекурсии...

---

← →
clickmaker ©   (2007-10-11 14:23) [15]

> [14] de.   (11.10.07 13:30)

принцип такой.
если меню имеет вид
<menu>
 <item ... />
    <item />
    <item />
 <item>
     <item />
     <item />
 </item>
</menu>

где первый уровень - полоса главного меню, второй и далее - выпадающие
То тогда
1. DocumentElement - корень
2. DocumentElement.ChildNodes - первый уровень
3. Далее рекурсивно, если CurrentNode.ChildNodes[i].HasChildNodes

---

← →
de.   (2007-10-11 15:09) [16]

> clickmaker ©   (11.10.07 14:23) [15]

Понял спасибо уже налобал, работает....! :-)
Теперя мне необходимо к каждому элементу меню передовать свои параметры....
Например на разных элементах меню щелкаем вызывается одна форма но параметры передаются разные... есть ли у Item какоето хранилище по мимо Tag.?
Или в этом случае можно поступить както иначе.?

---

← →
de.   (2007-10-11 15:14) [17]

> есть ли у Item

Верней у Node

---

← →
evvcom ©   (2007-10-11 15:15) [18]

> есть ли у Item какоето хранилище по мимо Tag.?

а зачем чего-то хранить? Делаешь полное соответствие CurrentNode.ChildNodes[i] и MenuItem

---

← →
de.   (2007-10-11 15:21) [19]

> evvcom ©   (11.10.07 15:15) [18]

Понял на счет текущий элемент..
Но чуть не понятен мне принцип как всеже надо делать, чтоб :
Например построил я меню, 10 элементов, все они вызывают одну и туже форму НО должны передовать разные параметры взависимости от того на что я кликнул...

---

← →
clickmaker ©   (2007-10-11 15:34) [20]

> передовать разные параметры взависимости от того на что
> я кликнул...

<item caption="aaa" param="param1" />
<item caption="bbb" param="param2" />
...

---

← →
de.   (2007-10-11 15:47) [21]

> clickmaker ©   (11.10.07 15:34) [20]

Ну а хранить где.?
Как мне делать, чтоб при клике на "ааа" вызвался непосредственно параметр param1,
а при клике на "bbb" вызывался непосредственно "param2" и например выводил showmessage...
????

---

← →
atruhin ©   (2007-10-11 22:49) [22]

> Ну а хранить где.?

Создай наследника от TMenuItem (не помню точно), в нем нужные параметры, его создавай и вставляй в меню.

---

← →
de.   (2007-10-12 07:54) [23]

> atruhin ©   (11.10.07 22:49) [22]

Красавчик! Ведь и в правду, чтото этот момент я упустил... 8-)
Спас.!

---

← →
de.   (2007-10-12 11:22) [24]

На счет CurrentNode.ChildNodes[i].HasChildNodes.
У меня есть какойто MenuItem я пониму кликаю, и тут мне необходимо вернуть содержимое одного из полей именно этого MenuItem....

где

TMyMenuItem = class(TMenuItem)
private
 FField: String;
end;

MenuItem: TMyMenuItem

Не могу реализовать... Как правельно поступить...?

---

← →
de.   (2007-10-12 13:49) [25]

> de.   (12.10.07 11:22) [24]


?

---

← →
имя   (2007-10-28 08:55) [26]

Удалено модератором

---

← →
имя   (2007-10-30 02:38) [27]

Удалено модератором

---

Страницы: 1 вся ветка

Текущий архив: 2007.12.02;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.032 c