Delphi XE7试用记录2

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），有兴趣的可以下载。