📄 unt_frmmenudesign.pas
字号:
{*******************************************************}
{ }
{ 应用系统主界面，主菜单动态生成控件. }
{ XML文本编辑界面 }
{ }
{ }
{ }
{ 版本v1.0 Copyright (c) 2003 ICSS }
{*******************************************************}
//修改纪录： 每次修改 版本号加1
// 修改人 修改日期 修改内容
//
//------------------------------------------------------
unit unt_FrmMenuDesign;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, xmldom, XMLIntf, Grids, ComCtrls, msxmldom, XMLDoc,
StdCtrls, ImgList, ExtCtrls, Buttons, unt_XMLMenu;
type
TFrmMenuDesign = class(TForm)
TrvMenu: TTreeView;
PopupMenu1: TPopupMenu;
StrGrdInspector: TStringGrid;
CmbAutoCheck: TComboBox;
CmbBreak: TComboBox;
CmbShortCut: TComboBox;
CmbAutoHotkeys: TComboBox;
N1: TMenuItem;
I1: TMenuItem;
Sub1: TMenuItem;
Delete1: TMenuItem;
N4: TMenuItem;
Preview1: TMenuItem;
Save1: TMenuItem;
Open1: TMenuItem;
N5: TMenuItem;
N2: TMenuItem;
Exit1: TMenuItem;
ImageList1: TImageList;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
N3: TMenuItem;
TempXMLDoc: TXMLDocument;
CmbImageIndex: TComboBoxEx;
CmbEvntParam: TComboBox;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SbtnInsert: TSpeedButton;
SbtnSub: TSpeedButton;
SbtnDelete: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SbtnSaveMod: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
SpeedButton10: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure StrGrdInspectorSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
procedure CmbAutoCheckExit(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TrvMenuChange(Sender: TObject; Node: TTreeNode);
procedure TrvMenuMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N1Click(Sender: TObject);
procedure I1Click(Sender: TObject);
procedure Sub1Click(Sender: TObject);
procedure Delete1Click(Sender: TObject);
procedure Preview1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure SbtnSaveModClick(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure TrvMenuDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure TrvMenuDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure TrvMenuKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure CmbImageIndexExit(Sender: TObject);
procedure CmbImageIndexChange(Sender: TObject);
procedure CmbAutoCheckChange(Sender: TObject);
procedure CmbAutoCheckDblClick(Sender: TObject);
procedure CmbImageIndexDblClick(Sender: TObject);
procedure StrGrdInspectorSetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
procedure TrvMenuChanging(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
procedure CmbEvntParamChange(Sender: TObject);
procedure CmbEvntParamDblClick(Sender: TObject);
procedure CmbEvntParamExit(Sender: TObject);
private
{ Private declarations }
isModifed: Boolean;
isEdited: Boolean;
procedure InitNewItem; //初始化新的节点
procedure InitView; //初始化显示
procedure FreePMNData; //释放指针
procedure PMNData2View(pData: PMNData);//记录体属性显示
procedure View2PMNData(pData: PMNData);//属性记入记录体
function ExamShortCut: Boolean; //查找有无重复注册的快捷键
function DeleteNode(pNode: TTreeNode): Boolean; //删除节点
procedure RefreshXMLDoc(pXMLDoc: TXMLDocument); //更新XML文件
function InitXMLMenu(RootName: string = ''): TTreeNode; //新建初始化XMLMenu
procedure XML2Tree(CurItem: TTreeNode; FXMLDoc: TXMLDocument);
procedure DynamicTreeNode(CurItem: TTreeNode; CurNode: IXMLNode);
procedure InitImageList;
procedure OpenXMLMenuFile(pXMLFile: string);
public
{ Public declarations }
CurXMLFile: string;
end;
var
FrmMenuDesign: TFrmMenuDesign;
implementation
uses unt_FrmPreview, RegMenuDesign;
{$R *.dfm}
procedure TFrmMenuDesign.InitNewItem;
begin
with StrGrdInspector do
begin
Cells[1, 0] := 'False';
Cells[1, 1] := 'maParent';
Cells[1, 2] := 'maParent';
Cells[1, 3] := 'mbNone';
Cells[1, 4] := '新菜单项';
Cells[1, 5] := 'False';
Cells[1, 6] := 'False';
Cells[1, 7] := 'True';
Cells[1, 8] := '0';
Cells[1, 9] := '0';
Cells[1, 10]:= '';
Cells[1, 11]:= '-1';
Cells[1, 12]:= 'False';
Cells[1, 13]:= '(None)';
Cells[1, 14]:= '-1';
Cells[1, 15]:= 'True';
end;
end;
procedure TFrmMenuDesign.InitView;
begin
CmbAutoCheck.Visible := False;
CmbAutoHotkeys.Visible := False;
CmbBreak.Visible := False;
CmbShortCut.Visible := False;
CmbImageIndex.Visible := False;
end;
procedure TFrmMenuDesign.FreePMNData;
var
I: Integer;
begin
for I := 0 to TrvMenu.Items.Count - 1 do
begin
try
Dispose(PMNData(TrvMenu.Items[I].Data));
except
end;
end;
end;
procedure TFrmMenuDesign.PMNData2View(pData: PMNData);
begin
with pData^, StrGrdInspector do
begin
Cells[1, 0] := mAutoCheck;
Cells[1, 1] := mAutoHotkeys;
Cells[1, 2] := mAutoLineReduction;
Cells[1, 3] := mBreak;
Cells[1, 4] := mCaption;
Cells[1, 5] := mChecked;
Cells[1, 6] := mDefault;
Cells[1, 7] := mEnabled;
Cells[1, 8] := mGroupIndex;
Cells[1, 9] := mHelpContext;
Cells[1, 10]:= mHint;
Cells[1, 11]:= mImageIndex;
Cells[1, 12]:= mRadioItem;
Cells[1, 13]:= mShortCut;
Cells[1, 14]:= mTag;
Cells[1, 15]:= mVisible;
//wangji 20030901
Cells[1, 16]:= mMenuID;
end;
end;
procedure TFrmMenuDesign.View2PMNData(pData: PMNData);
begin
with pData^, StrGrdInspector do
begin
mAutoCheck := Cells[1, 0];
mAutoHotkeys := Cells[1, 1];
mAutoLineReduction:= Cells[1, 2];
mBreak := Cells[1, 3];
mCaption := Cells[1, 4];
mChecked := Cells[1, 5];
mDefault := Cells[1, 6];
mEnabled := Cells[1, 7];
mGroupIndex := Cells[1, 8];
mHelpContext := Cells[1, 9];
mHint := Cells[1, 10];
mImageIndex := Cells[1, 11];
mRadioItem := Cells[1, 12];
mShortCut := Cells[1, 13];
mTag := Cells[1, 14];
mVisible := Cells[1, 15];
//wangji 20030901
mMenuID := Cells[1, 16];
end;
end;
function TFrmMenuDesign.ExamShortCut: Boolean; //查找有无重复注册的快捷键
var
I: Integer;
TempShortCut: string;
begin
Result := False;
TempShortCut := StrGrdInspector.Cells[1, 13];
for I := 0 to TrvMenu.Items.Count - 1 do
if (TempShortCut <> '(None)') and (TempShortCut = PMNData(TrvMenu.Items[I].Data).mShortCut) then
begin
MessageDlg('注册快捷键冲突，请更换快捷键', mtInformation, [mbOK], 0);
Result := True;
Break;
end;
end;
function TFrmMenuDesign.DeleteNode(pNode: TTreeNode): Boolean;
var
i: Integer;
begin
Result := True;
if pNode = nil then Exit;
if pNode.HasChildren then
begin
for i := 0 to pNode.Count - 1 do
begin
Result := DeleteNode(pNode.Item[i]);
if not Result then
Break;
end;
end else
Dispose(PMNData(pNode.Data)); //释放选中节点的指针
end;
procedure TFrmMenuDesign.RefreshXMLDoc(pXMLDoc: TXMLDocument);
var
ConfigNode, RootNode: IXMLNode; //临时使用的XML节点
i: Integer;
CurNode: TTreeNode;
procedure ChildNode2XML(pTrvNode: TTreeNode; pXMLNode: IXMLNode);
var
ItemNode: IXMLNode;
TempNode: TTreeNode;
j: Integer;
begin
for j := 0 to pTrvNode.Count - 1 do
begin
ItemNode := pXMLNode.AddChild(MyMenuItem);
TempNode := pTrvNode.Item[j];
with ItemNode, PMNData(TempNode.Data)^ do
begin
Attributes[menuAutoCheck ] := mAutoCheck ;
Attributes[menuAutoHotkeys ] := mAutoHotkeys ;
Attributes[menuAutoLineReduction] := mAutoLineReduction;
Attributes[menuBreak ] := mBreak ;
Attributes[menuCaption ] := mCaption ;
Attributes[menuChecked ] := mChecked ;
Attributes[menuDefault ] := mDefault ;
Attributes[menuEnabled ] := mEnabled ;
Attributes[menuGroupIndex ] := mGroupIndex ;
Attributes[menuHelpContext ] := mHelpContext ;
Attributes[menuHint ] := mHint ;
Attributes[menuImageIndex ] := mImageIndex ;
Attributes[menuRadioItem ] := mRadioItem ;
Attributes[menuShortCut ] := mShortCut ;
Attributes[menuTag ] := mTag ;
Attributes[menuVisible ] := mVisible ;
//wangji 20030901
Attributes[menuMenuID ] := mMenuID ;
end;
if TempNode.HasChildren then
ChildNode2XML(TempNode, ItemNode);
end;
end;
begin
with pXMLDoc do
begin
Active := False;
XML.Clear;
XML.Append('<?xml version="1.0" encoding="GB2312"?>');
XML.Append('<MenuConfig>');
XML.Append('</MenuConfig>');
Active := True;
ConfigNode := DocumentElement;
if TrvMenu.Items[0] = nil then Exit;
for i := 0 to TrvMenu.Items[0].Count - 1 do
begin
RootNode := ConfigNode.AddChild(MyMenu);
CurNode := TrvMenu.Items[0].Item[i];
with RootNode, PMNData(CurNode.Data)^ do
begin
Attributes[menuAutoCheck ] := mAutoCheck ;
Attributes[menuAutoHotkeys ] := mAutoHotkeys ;
Attributes[menuAutoLineReduction] := mAutoLineReduction;
Attributes[menuBreak ] := mBreak ;
Attributes[menuCaption ] := mCaption ;
Attributes[menuChecked ] := mChecked ;
Attributes[menuDefault ] := mDefault ;
Attributes[menuEnabled ] := mEnabled ;
Attributes[menuGroupIndex ] := mGroupIndex ;
Attributes[menuHelpContext ] := mHelpContext ;
Attributes[menuHint ] := mHint ;
Attributes[menuImageIndex ] := mImageIndex ;
Attributes[menuRadioItem ] := mRadioItem ;
Attributes[menuShortCut ] := mShortCut ;
Attributes[menuTag ] := mTag ;
Attributes[menuVisible ] := mVisible ;
//wangji 20030901
Attributes[menuMenuID ] := mMenuID ;
end;
if CurNode.HasChildren then
ChildNode2XML(CurNode, RootNode);
end;
end;
end;
function TFrmMenuDesign.InitXMLMenu(RootName: string = ''): TTreeNode;
var
P_Node: PMNData;
begin
with TrvMenu.Items do
begin
BeginUpdate;
Clear;
New(P_Node);
CurXMLFile := RootName;
if RootName = '' then
RootName := '新菜单文件'
else
RootName := ExtractFileName(RootName);
StrGrdInspector.Cells[1, 4] := RootName;
View2PMNData(P_Node);
Result := AddChildObject(nil, P_Node.mCaption, P_Node);
Result.Selected := True;
EndUpdate;
end;
end;
procedure TFrmMenuDesign.XML2Tree(CurItem: TTreeNode; FXMLDoc: TXMLDocument);
var
i: Integer;
TempNode: TTreeNode;
MyNode, MenuNode: IXMLNode;//临时使用的XML节点
CurP: PMNData;
begin
if not FXMLDoc.Active then FXMLDoc.Active := True; //开启菜单XML文件
MyNode := FXMLDoc.DocumentElement; //获得菜单XML文件的节点元素
if (not MyNode.HasChildNodes) or (MyNode.NodeType <> ntElement) then Exit;
for i := 0 to MyNode.ChildNodes.Count - 1 do
begin
if (MyNode.ChildNodes[i].NodeType = ntElement) and
(UpperCase(MyNode.ChildNodes[i].NodeName) = UpperCase(MyMenu)) then
begin
MenuNode := MyNode.ChildNodes[i]; //获取当前节点信息
New(CurP);
with CurP^, MenuNode do
begin
try
mAutoCheck := Attributes[menuAutoCheck];
except
mAutoCheck := 'False';
end;
try
mAutoHotkeys := Attributes[menuAutoHotkeys];
except
mAutoHotkeys := 'maParent';
end;
try
mAutoLineReduction:= Attributes[menuAutoLineReduction];
except
mAutoLineReduction := 'maParent';
end;
try
mBreak := Attributes[menuBreak];
except
mBreak := 'mbNone';
end;
try
mCaption := Attributes[menuCaption];
except
mCaption := '新菜单项';
end;
try
mChecked := Attributes[menuChecked];
except
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -