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