Delphi XE7试用记录2

万一博客中介绍了不少Delphi7以后的新功能测试,想跟着测试一下。每次测试建立一个工程,在窗体上放几个按钮,测试几个相关的功能,这样虽然简单明了,但日后查阅起来不方便。最好能操作简单,尽可能集中到一个项目中,功能分类清晰,同时可以看到运行效果及源代码。

窗体上放置ActionList、MainMen、TreeView、PageControl、Memo。测试代码放到Action中,运行时根据Action自动建立MainMenu和TreeView中的项目,点击MenuItem或TreeNode都可以运行测试代码。Memo中放工程源代码,点击TreeNode不仅可以运行测试代码还可以自动导航到对应的源代码。PageControl中放置测试代码用到的组件,展开TreeNode可以自动显示对应的组件页面。

 

根据Action建立MainMenu的代码:

procedure Action2Menu(ActionList: TActionList; MainMenu: TMainMenu);

const

  MenuEx = 'n8m9uu'; // uu,加在menu item名字中,防止重名

var

  Action1: TContainedAction;

  MenuItem1: TMenuItem; // uu,一级菜单项

  MenuItem2: TMenuItem; // uu,二级菜单项

  i, j: integer;

  StrCaption: string;

begin

  for i := 0 to ActionList.ActionCount - 1 do

  begin

    Action1 := ActionList.Actions[i];

    StrCaption := Action1.Category;

    for j := 0 to MainMenu.Items.Count - 1 do

    begin // uu,找到名字与动作标题相同的一级菜单项

      MenuItem1 := MainMenu.Items.Items[j];

      if MenuItem1.Name = MenuEx + StrCaption then

        Break;

    end;

    if (MainMenu.Items.Count = 0) then

    begin

      // uu,先创建一个一级菜单项,设置名称和标题。

      // uu,标题可以会自动添加快捷键或重复,所以要设置名称以便以后查找

      MenuItem1 := TMenuItem.Create(MainMenu);

      MenuItem1.Name := MenuEx + StrCaption;

      MenuItem1.Caption := StrCaption;

      MainMenu.Items.Add(MenuItem1);

      // uu,再增加子菜单项,设置Action

      MenuItem2 := TMenuItem.Create(MainMenu);

      MenuItem2.Action := Action1;

      MenuItem1.Add(MenuItem2);

    end

    else

    begin

      if (MenuItem1.Name = MenuEx + StrCaption) then

      begin

        // uu,找到同类的菜单项,就在其下添加子菜单项

        MenuItem2 := TMenuItem.Create(MainMenu);

        MenuItem2.Action := Action1;

        MenuItem1.Add(MenuItem2);

      end

      else

      begin

        // uu,没有找到同类的菜单项,就新建一个

        MenuItem1 := TMenuItem.Create(MainMenu);

        MenuItem1.Name := MenuEx + StrCaption;

        MenuItem1.Caption := StrCaption;

        MainMenu.Items.Add(MenuItem1);

        MenuItem2 := TMenuItem.Create(MainMenu);

        MenuItem2.Action := Action1;

        MenuItem1.Add(MenuItem2);

      end;

    end;

  end;

end;

 

根据Action建立TreeView的代码:

procedure Action2Tree(ActionList: TActionList; Tree: TTreeView);

var

  Action1: TContainedAction;

  Node1: TTreeNode;

  Node2: TTreeNode;

  i: integer;

  StrCaption: string;

begin

  Tree.Items.Clear;

  Tree.ReadOnly := True;

  Tree.RowSelect := True;

  Tree.HideSelection := True;

  for i := 0 to ActionList.ActionCount - 1 do

  begin

    Action1 := ActionList.Actions[i];

    StrCaption := Action1.Category;

    Node1 := Tree.TopItem;

    // uu,遍历一级节点,查找与分类相同名称的节点

    while Assigned(Node1) do

    begin

      if Node1.Text = StrCaption then

        Break;

      Node1 := Node1.getNextSibling;

    end;

    if not Assigned(Node1) then

    begin

      // uu,Tree中一个节点都没有,先新建一个一级节点

      Node1 := Tree.Items.AddChild(nil, StrCaption);

      // uu,再新建一个子节点,关联Action

      Node2 := Tree.Items.AddChild(Node1, Action1.Caption);

      Node2.Data := Action1;

    end

    else

    begin

      if Node1.Text = StrCaption then

      begin

        // uu,找到与分类同名的节点,就在其下新建节点,关联Action

        Node2 := Tree.Items.AddChild(Node1, Action1.Caption);

        Node2.Data := Action1;

      end

      else

      begin

        // uu,没有找到,就新建一级节点,然后再建子节点

        Node1 := Tree.Items.AddChild(nil, StrCaption);

        Node2 := Tree.Items.AddChild(Node1, Action1.Caption);

        Node2.Data := Action1;

      end;

    end;

  end;

end;

 

点击TreeNode事件的代码:

procedure TFormMain.TreeView1Click(Sender: TObject);

var

  Action1: TContainedAction;

  strEvent, strCaption: string;

  intP: LongInt;

begin

  with TreeView1 do

    if Assigned(Selected) then

    begin

      if Assigned(Selected.Data) then

      begin

        Action1 := TContainedAction(Selected.Data);

        // uu,执行

        Action1.Execute;

        // uu,导航源代码

        strEvent := Action1.Name;

        strCaption := Action1.Caption;

        strEvent := Format('procedure TFormMain.%sExecute(Sender: TObject);', [strEvent]);

        intP := Pos(strEvent, MemoSource.Text);

        if intP > 0 then

        begin

          MemoSource.SelStart := intP;

          MemoSource.SelLength := Length(strEvent);

          MemoSource.SetFocus;

          // uu,当前行滚动到第一行

 

        end

        else

          ShowInfo(Format('%s,没找到源代码', [strCaption]));

      end;

    end;

end;

 

展开TreeNode事件的代码:

procedure TFormMain.TreeView1Expanding(Sender: TObject; Node: TTreeNode;

var AllowExpansion: Boolean);

var

  i: Integer;

  str1,str2: string;

begin

  // uu,如果下面的Action无效,则无法展开

  // TreeView1.Selected := nil;

  // uu,每次只能展开一个分支,所以先合拢所有分支。

  TreeView1.FullCollapse;

  str1 := Node.Text;

  // uu,如果有对应的Tab则显示。多个分支可以共用一个page

  for i := 0 to PageControl1.PageCount - 1 do

  begin

    str2 := PageControl1.Pages[i].Caption;

    if str1.Contains(str2) or str2.Contains(str1) then

      PageControl1.Pages[i].Show;

  end;

end;

 

窗体的创建事件的代码:

procedure TFormMain.FormCreate(Sender: TObject);

begin

  AppPath := ExtractFilePath(Application.ExeName);

  // uu,下面两个函数在uuActionFun单元中,用于把Action放到菜单和Tree中。

  Action2Menu(ActionList1, MainMenu1);

  Action2Tree(ActionList1, TreeView1);

  // uu,在测试功能同时显示源代码

  if FileExists(CodeFile) then

    MemoSource.Lines.LoadFromFile(CodeFile);

end;

 

以后做简单的测试就可以放到这个工程中了。为了测试D7到XE7的新功能,建立了两个这样的工程,因为一个工程测试代码太多严重影响编辑效率。工程源代码放在网盘上(https://pan.baidu.com/s/1bo7Hskf),有兴趣的可以下载。