unit u_MenuBuilder;
interface
uses
SysUtils, Classes, Windows, comctrls;
type
TMenuType = (mtMainMenu, mtPopupMenu, mtLeftMenu, mtNone);
EInvalidStepID = class(Exception);
{TMenuItemObj }
TMenuItemObj = class
private
FParentID: string;
FCaption: string;
FShortCut: LongInt;
FRadioItem: boolean;
FChecked: boolean;
FClickAnswer: boolean;
FEnabled: boolean;
FMenuName: string;
FImageIndex: Integer;
FItemList: string;
procedure SetItemList(Value: string);
function ReadItemList(): string;
function ReadItemList_(): string;
function GetParentID(): string;
procedure SetEnabled(Value: boolean);
procedure SetName(Value: string);
function GetName(): string;
public
constructor Create(AParent: string); overload;
property Caption: string read FCaption;
property ShortCut: LongInt read FShortCut;
property RadioItem: boolean read FRadioItem;
property Checked: boolean read FChecked;
property ClickAnswer: boolean read FClickAnswer;
property ImageIndex: Integer read FImageIndex;
property ItemList: string read ReadItemList write SetItemList;
property ItemList_: string read ReadItemList_;
property ParentID: string read GetParentID;
property MenuName: string read GetName write SetName;
property Enabled: boolean read FEnabled write SetEnabled;
end;
{TMenusConfig : 操作}
TMenusConfig = class
private
FStepID: Integer;
FMenuType: TMenuType;
FTreeView: TTreeView;
FIniFileName: string;
FSectionName: string;
procedure RefreshTree(IniFileName, SectionName: string);
procedure SetStepID(Value: Integer);
procedure SetMenuType(Value: TMenuType);
procedure Add_(AParent: TTreeNode);
procedure Save_(AFileName, ASection: string; Modal: boolean = false);
procedure BuildSectionName();
public
constructor Create(AIniFileName: string);
destructor Destroy; override;
procedure ReadFromIni();
procedure WriteToIni();
procedure SaveAs(AFileName: string);
procedure LoadFrom(AFileName: string);
procedure AddItem();
procedure AddChildItem();
procedure DelItem();
procedure ModifyItem(Caption: string; Enabled, RadioItem, Checked,
ClickAnswer: boolean; ShortCut: LongInt = 0);
procedure Clear();
property TreeView: TTreeView write FTreeView;
property StepID: Integer read FStepID write SetStepID;
property MenuType: TMenuType read FMenuType write SetMenuType;
end;
implementation
uses
IniFiles;
{TBaseObj}
procedure TMenuItemObj.SetEnabled(Value: boolean);
begin
FEnabled := Value;
end;
procedure TMenuItemObj.SetName(Value: string);
begin
FMenuName := Value;
end;
function TMenuItemObj.GetName(): string;
begin
result := FMenuName;
end;
{TMenuItemObj}
constructor TMenuItemObj.Create(AParent: string);
begin
Inherited Create();
FParentID := AParent;
FCaption := '';
FChecked := false;
FClickAnswer := false;
FRadioItem := false;
// FVisible := '';
FItemList := '';
FShortCut := 0;
FImageIndex := -1;
end;
function TMenuItemObj.GetParentID(): string;
begin
if Length(FMenuName) <= 2 then
result := ''
else
begin
result := copy(FMenuName, 1, Length(FMenuName) - 2);
end;
FParentID := result;
end;
function TMenuItemObj.ReadItemList(): string;
const
Delimeter = '|';
var
Sts: string;
begin
{result := FCaption + Delimeter +
IntToStr(FShortCut) + Delimeter +
FEnabled + Delimeter +
FRadioItem + Delimeter +
FChecked + Delimeter +
FVisible + Delimeter +
FClickAnswer + Delimeter +
IntToStr(FImageIndex) + Delimeter; }
Sts := StringOfChar('F', 4);
if FEnabled then Sts[1] := 'T';
if FRadioItem then Sts[2] := 'T';
if FChecked then Sts[3] := 'T';
if FClickAnswer then Sts[4] := 'T';
result := FCaption + Delimeter +
Sts + IntToStr(FImageIndex);
end;
function TMenuItemObj.ReadItemList_(): string;
const
Delimeter = '|';
var
Sts: string;
begin
Sts := StringOfChar('F', 4);
if FEnabled then Sts[1] := 'T';
if FRadioItem then Sts[2] := 'T';
if FChecked then Sts[3] := 'T';
if FClickAnswer then Sts[4] := 'T';
result := FCaption + Delimeter + Sts;
end;
procedure TMenuItemObj.SetItemList(Value: String);
const
Delimeter = '|';
var
iPos: Integer;
fStr: String;
begin
FItemList := Value;
iPos := pos(Delimeter, FItemList);
if iPos <= 0 then exit;
FCaption := Copy(FItemList, 1, iPos - 1);
fStr := UpperCase(Copy(FItemList, iPos + 1, 4));
FEnabled := fStr[1] = 'T';
FRadioItem := fStr[2] = 'T';
FChecked := fStr[3] = 'T';
FClickAnswer := fStr[4] = 'T';
fStr := Copy(FItemList, iPos + 5, Length(FItemList));
if fStr = '' then
FImageIndex := -1
else
try
FImageIndex := StrToInt(fStr);
except
FImageIndex := -1;
end;
FItemList := Value;
end;
{TMenusConfig}
constructor TMenusConfig.Create(AIniFileName: string);
begin
Inherited Create();
FIniFileName := AIniFileName;
FStepID := -1;
FMenuType := mtNone;
FSectionName := '';
end;
destructor TMenusConfig.Destroy;
begin
Inherited;
end;
procedure TMenusConfig.ReadFromIni();
begin
Clear();
RefreshTree(FIniFileName, FSectionName);
end;
procedure TMenusConfig.WriteToIni();
begin
Save_(FIniFileName, FSectionName);
end;
procedure TMenusConfig.SaveAs(AFileName: string);
const
Modal = 'Modual';
procedure CreateFile(AFile: string);
var
txt: TFileStream;
begin
txt := TFileStream.Create(AFile, fmCreate);
try
Sleep(50);
finally
txt.Free;
end;
end;
begin
if not FileExists(AFileName) then
begin
CreateFile(AFileName);
end;
Save_(AFileName, Modal, true);
end;
procedure TMenusConfig.LoadFrom(AFileName: string);
const
Modal = 'Modual';
begin
Clear();
RefreshTree(AFileName, Modal);
end;
procedure TMenusConfig.RefreshTree(IniFileName, SectionName: string);
var
ini: TIniFile;
sl: TStrings;
ItemName: string;
i: Integer;
obj: TMenuItemObj;
node, node_: TTreeNode;
StackList: TList;
function GetParentNode(AName: string): TTreeNode;
var
j: Integer;
begin
result := nil;
for j := 0 to FTreeView.Items.Count - 1 do
begin
if TMenuItemObj(FTreeView.Items[j]).MenuName = AName then
begin
result := FTreeView.Items[j];
exit;
end;
end;
end;
function GetParentNode_(AName: string): TTreeNode;
var
j: Integer;
begin
result := nil;
j := StackList.Count - 1;
while j >= 0 do
begin
if TMenuItemObj(TTreeNode(StackList.Items[j]).Data).MenuName = AName then
begin
result := TTreeNode(StackList.Items[j]);
exit;
end
else
begin
StackList.Delete(j);
Dec(j);
end;
end;
end;
begin
ini := TIniFile.Create(IniFileName);
try
sl := TStringList.Create;
try
ini.ReadSectionValues(SectionName, sl);
//初始化树
node := nil;
node_ := nil;
StackList := TList.Create;
try
for i := 0 to sl.Count - 1 do
begin
ItemName := sl;
obj := TMenuItemObj.Create('');
if Pos('=', ItemName) > 0 then
begin
obj.MenuName := Copy(ItemName, 1, Pos('=', ItemName) - 1);
obj.ItemList := ini.ReadString(SectionName, obj.MenuName, '');
node := GetParentNode_(obj.ParentID);
node_ := FTreeView.Items.AddChildObject(node, obj.Caption, obj);
StackList.Add(node_);
end;
end;
finally
StackList.Free;
end;
finally
FreeAndNil(sl);
end;
finally
FreeAndNil(ini);
end;
end;
procedure TMenusConfig.BuildSectionName();
begin
case FMenuType of
mtMainMenu :
begin
FSectionName := 'Menu' + IntToStr(FStepID) + '.mnu';
end;
mtPopupMenu :
begin
FSectionName := 'PopupMenu' + IntToStr(FStepID) + '.mnu';
end;
mtLeftMenu :
begin
FSectionName := 'LeftPopupMenu' + IntToStr(FStepID) + '.mnu';
end;
end;
end;
procedure TMenusConfig.SetStepID(Value: Integer);
begin
FStepID := Value;
BuildSectionName();
end;
procedure TMenusConfig.SetMenuType(Value: TMenuType);
begin
FMenuType := Value;
BuildSectionName;
end;
procedure TMenusConfig.Add_(AParent: TTreeNode);
var
node: TTreeNode;
obj: TMenuItemObj;
ParentID: string;
SortID: Integer;
begin
node := AParent;
if node = nil then ParentID := '' else ParentID := TMenuItemObj(node.Data).MenuName;
if node = nil then
begin
SortID := 1;
node := FTreeView.Items.GetFirstNode;
while node <> nil do
begin
Inc(SortID);
node := node.getNextSibling;
end;
end
else SortID := node.Count + 1;
obj := TMenuItemObj.Create(ParentID);
obj.FCaption := '新建菜单项' + FormatFloat('00', SortID);
obj.FMenuName := ParentID + FormatFloat('00', SortID);
node := FTreeView.Items.AddChildObject(node, obj.Caption, obj);
node.Selected := true;
end;
procedure TMenusConfig.Save_(AFileName, ASection: string; Modal: boolean = false);
var
ini: TIniFile;
node: TTreeNode;
j: Integer;
procedure WriteKey_(ANode: TTreeNode; SortNumber: Integer; ParentID: string);
var
n: TTreeNode;
i: Integer;
Value_: string;
begin
if Modal then
Value_ := TMenuItemObj(ANode.Data).ItemList_
else
Value_ := TMenuItemObj(ANode.Data).ItemList;
ini.WriteString(ASection, ParentID + FormatFloat('00', SortNumber),
Value_);
if ANode.HasChildren then
begin
n := ANode.getFirstChild;
i := 1;
while n <> nil do
begin
WriteKey_(n, i, ParentID + FormatFloat('00', SortNumber));
Inc(i);
n := n.getNextSibling;
end;
end;
end;
begin
node := FTreeView.Items.GetFirstNode;
ini := TIniFile.Create(AFileName);
try
ini.EraseSection(ASection);
j := 1;
while node <> nil do
begin
writeKey_(node, j, '');
Inc(j);
node := node.getNextSibling;
end;
finally
FreeAndNil(Ini);
end;
end;
procedure TMenusConfig.AddItem();
var
node: TTreeNode;
begin
node := FTreeView.Selected;
if (node <> nil) or (FTreeView.Items.Count = 0) then
begin
if node <> nil then
node := node.Parent
else
node := nil;
end
else exit;
Add_(node);
end;
procedure TMenusConfig.AddChildItem();
begin
if FTreeView.Selected <> nil then
begin
Add_(FTreeView.Selected);
end;
end;
procedure TMenusConfig.ModifyItem(Caption: string; Enabled, RadioItem, Checked,
ClickAnswer: boolean; ShortCut: LongInt = 0);
var
obj: TMenuItemObj;
begin
if FTreeView.Selected <> nil then
begin
obj := TMenuItemObj(FTreeView.Selected.Data);
obj.FCaption := Caption;
obj.FShortCut := ShortCut;
obj.FEnabled := Enabled;
obj.FRadioItem := RadioItem;
obj.FChecked := Checked;
obj.FClickAnswer := ClickAnswer;
end;
end;
procedure TMenusConfig.DelItem();
var
node: TTreeNode;
procedure DelNode(ANode: TTreeNode);
var
obj: TMenuItemObj;
node_, node: TTreeNode;
begin
node_ := ANode;
if node_.HasChildren then
begin
node := node_.getFirstChild;
while node <> nil do
begin
DelNode(node);
if node.getNextSibling <> nil then
node := node.getNextSibling
else
break;
end;
end;
obj := TMenuItemObj(node_.Data);
FreeAndNil(obj);
end;
begin
node := FTreeView.Selected;
DelNode(node);
if node.getNextSibling <> nil then
node.getNextSibling.Selected := true
else if node.getPrevSibling <> nil then
node.getPrevSibling.Selected := true
else if node.Parent <> nil then
node.Parent.Selected := true;
node.Delete;
end;
procedure TMenusConfig.Clear();
var
obj: TMenuItemObj;
node: TTreeNode;
begin
node := FTreeView.Items.GetFirstNode;
while node <> nil do
begin
obj := TMenuItemObj(node.Data);
FreeAndNil(obj);
node := node.GetNext;
end;
FTreeView.Items.Clear;
end;
end.
