unt_frmmenuwizard.pas

一个DELPHI下的菜单构件

unit unt_FrmMenuWizard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls, StdCtrls;

type
  TFrmMenuWizard = class(TForm)
    OpenDialog1: TOpenDialog;
    Label12: TLabel;
    Label13: TLabel;
    edtDprFile: TEdit;
    btnOpenDprDlg: TButton;
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Panel2: TPanel;
    btnOK: TBitBtn;
    btnNext: TBitBtn;
    LblXMLMenu: TLabel;
    procedure btnOpenDprDlgClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    procedure GetAllEvn(ssInfo, ssEvnList: TStringList);
  public
    { Public declarations }
    CurEvnList: TStringList;
  end;

var
  FrmMenuWizard: TFrmMenuWizard;

implementation

uses unt_FrmMenuDesign;

{$R *.dfm}

{ TFrmMenuWizard }

procedure TFrmMenuWizard.GetAllEvn(ssInfo, ssEvnList: TStringList);
var
  nID, nPos: Integer;
  nCaseIndent, nCurIndent: Integer; //缩进
  sEvnID, sEvnName, sTemp: String;
begin
  nID := 0;
  ssEvnList.Clear;

  //定位到RunAppEvn函数入口
  repeat
    Inc(nID);
    nPos := Pos('runappevn', LowerCase(ssInfo.Strings[nID]));
  until (nPos > 0) or (nID >= ssInfo.Count - 1);
  //如果不符合工程规范则退出
  if nID >= ssInfo.Count - 1 then exit;

  //定位到Case语句
  repeat
    Inc(nID);
    nPos := Pos('case ', LowerCase(ssInfo.Strings[nID]));
  until (nPos > 0) or (nID >= ssInfo.Count - 1);
  //如果不符合工程规范则退出
  if nID >= ssInfo.Count - 1 then exit;


  nCaseIndent := nPos + 1; //Case字句缩进值（相邻级缩进为2）

  //读取操作信息
  repeat
    Inc(nID);
    sTemp := ssInfo.Strings[nID];
    nPos := Pos(':', sTemp);
    if nPos > 0 then
    begin
      nCurIndent := Length(sTemp) - Length(TrimLeft(sTemp));
      //如果是操作入口(根据缩进判断)则添加
      if (nCurIndent = nCaseIndent) then
      begin
        sEvnID := Trim(Copy(sTemp, 1, nPos - 1)); //操作编号
        sEvnName := '';
        nPos := Pos('//', sTemp);
        //如果有操作的名称则添加
        if nPos > 1 then sEvnName := Trim(Copy(sTemp, nPos + 2, 254));

        ssEvnList.Add(sEvnID + ' - ' + sEvnName);
      end;
    end;
    //判断是否函数结束
    nPos := Pos('end;', LowerCase(sTemp));
  until (nPos = 1) or (nID >= ssInfo.Count - 1);
end;

procedure TFrmMenuWizard.btnOpenDprDlgClick(Sender: TObject);
begin
  OpenDialog1.Filter := '应用模块工程文件(*.dpr)|*.dpr';
  if OpenDialog1.Execute then
    edtDprFile.Text := OpenDialog1.FileName;
end;

procedure TFrmMenuWizard.btnNextClick(Sender: TObject);
var
  TempList: TStringList;
begin
  if (Trim(edtDprFile.Text) = '') or (not FileExists(Trim(edtDprFile.Text))) then
  begin
    Application.MessageBox('请正确输入应用模块工程文件的名称！', '系统提示', MB_ICONINFORMATION);
    Exit;
  end;
  TempList := TStringList.Create;
  try
    TempList.LoadFromFile(Trim(edtDprFile.Text));
    GetAllEvn(TempList, CurEvnList);
    FrmMenuDesign := TFrmMenuDesign.Create(nil);
    try
      with FrmMenuDesign.CmbEvntParam do
      begin
        Clear;
        Text := '';
        Items := CurEvnList;
      end;
      FrmMenuDesign.ShowModal;
      if FileExists(FrmMenuDesign.CurXMLFile) then
      begin
        LblXMLMenu.Caption := '当前应用菜单文件保存在：'+FrmMenuDesign.CurXMLFile;
        btnOK.Caption := '完成(&O)';
      end else
      begin
        LblXMLMenu.Caption := '';
        btnOK.Caption := '退出(&E)';
      end;
    finally
      FrmMenuDesign.Free;
    end;
  finally
    TempList.Free;
  end;
end;

procedure TFrmMenuWizard.FormCreate(Sender: TObject);
begin
  CurEvnList := TStringList.Create;
  LblXMLMenu.Caption := '';
end;

procedure TFrmMenuWizard.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  CurEvnList.Free;
end;

procedure TFrmMenuWizard.btnOKClick(Sender: TObject);
begin
  Close;
end;

end.