commain.pas

来自「IT业进销存管理系统源代码Delphi」· PAS 代码 · 共 1,122 行 · 第 1/3 页

  mnuAbout.Visible        := true;
  MenuRepair(MainMenu1.Items);
end;

//MenuRepair
procedure TfrmComMain.MenuRepair(MenuItem: TMenuItem);
var
  i: integer;
  blnSeparator, blnFirst, blnVisible: boolean;
begin
  blnSeparator := False;
  blnFirst := True;
  for i := 0 to MenuItem.Count - 1 do
  begin
    if (blnFirst) and (MenuItem[i].Caption = '-') and (MenuItem[i].Visible) then
      MenuItem[i].Visible := False;
    if blnSeparator and (MenuItem[i].Visible) and (MenuItem[i].Caption = '-') then
      MenuItem[i].Visible := False;
    if MenuItem[i].Visible then
    begin
      if (MenuItem[i].Caption <> '-') then
        blnFirst := False;
      blnSeparator := (MenuItem[i].Caption = '-');
    end;
    if MenuItem[i].Count > 0 then
      MenuRepair(MenuItem[i]);
  end;
  blnFirst := true;
  for i := MenuItem.Count - 1 downto 0 do
  begin
    if (blnFirst) and (MenuItem[i].Caption = '-') and (MenuItem[i].Visible) then
      MenuItem[i].Visible := False;
    if (MenuItem[i].Visible) and (MenuItem[i].Caption <> '-') then
      blnFirst := False;
  end;
  blnVisible := False;
  for i := 0 to MenuItem.Count - 1 do
    if (MenuItem[i].Visible) then
      blnVisible := true;
  MenuItem.Visible := blnVisible;
end;

//BeginShow
procedure TfrmComMain.BeginShow(Sender: TObject);
var
  strCaption: string;
begin
  Animate1.Active := True;
  pnlMain.Visible := True;
  pnlMain.Repaint;
  if Sender is TMenuItem then
  begin
    if Pos('(&', TMenuItem(Sender).Caption) = 0 then
      strCaption := TMenuItem(Sender).Caption
    else
      strCaption := Copy(TMenuItem(Sender).Caption+'a', 1, Pos('(&', TMenuItem(Sender).Caption) - 1);
    labMain.Caption := '正在打开"' + strCaption + '", 请稍候 ...';
    labBack.Caption := labMain.Caption;
  end
  else
  begin
    labMain.Caption := '正在打开, 请稍候 ...';
    labBack.Caption := labMain.Caption;
  end;
  labMain.Repaint;
  labBack.Repaint;
  SaveInCommonUse(Sender);
end;

//EndShow
procedure TfrmComMain.EndShow(Sender: TObject);
begin
  frmMain.Animate1.Active := False;
  frmMain.pnlMain.Visible := False;
end;

//SaveInCommonUse
procedure TfrmComMain.SaveInCommonUse(Sender: TObject);
begin
  if Sender is TMenuItem then
    with Data.Tmp do
    begin
      Close;
      CommandText := 'select * from AppInCommonUse ' +
        'where uID = ' + IntToStr(pintUserId) + ' and ' +
        'mName = ''' + TMenuItem(Sender).Name + '''';
      Open;
      if IsEmpty then
      begin
        Close;
        CommandText := 'insert into AppInCommonUse ' +
          '(uID, mName, UseCount) ' +
          'values (' + IntToStr(pintUserId) + ', ''' +
          TMenuItem(Sender).Name + ''', 1)';
      end
      else
      begin
        Close;
        CommandText := 'update AppInCommonUse ' +
          'set UseCount = UseCount + 1 ' +
          'where uID = ' + IntToStr(pintUserId) + ' and ' +
          'mName = ''' + TMenuItem(Sender).Name + '''';
      end;
      Execute;
    end;
end;

//IsOpenMdiForm
function TfrmComMain.IsOpenMdiForm(strName: string): boolean;
var
  i: integer;
begin
  result := False;
  for i := 0 to MDIChildCount - 1 do
    if UpperCase(MDIChildren[i].Name) = UpperCase(strName) then
    begin
      result := True;
      break;
    end;
end;

{-Create App 成生系统表-}

//AppBtn1.Click
procedure TfrmComMain.AppBtn1Click(Sender: TObject);
var
  s, strFile: string;
begin
  screen.Cursor := crHourGlass;
  with Data.Tmp do
  begin
    Close;
    CommandText := 'delete from AppMenu';
    Execute;
  end;
  MainMenu1.Tag := 0;   // 代表 mLevel 的值
  PopupMenu1.Tag := 0;  // 代表 mIndex 的值
  GetMnuInfo(MainMenu1.Items);
  //删除固有菜单
  with Data.Tmp do
  begin
    Close;
    CommandText := 'delete from AppMenu where mName in (' +
      '''mmuPrintSet'', ''mnuChangUser'', ''mnuExit'', ' +
      '''mnuStatusBar'', ''mnuCascade'', ''mnuHorizontally'', ' +
      '''mnuWindow'', ''mnuMinAll'', ''mnuCloseAll'', ' +
      '''mnuCalendar'', ''mnuCalculator'', ''mnuAbout''' +
      '''mnuToolBar'', ''mnuStatusBar'')';
    Execute;
  end;
  // App.txt
  with Data.Tmpl do
  begin
    Close;
    CommandText := 'select mName,mIndex from AppMenu order by mIndex';
    Open;
    while not Eof do
    begin
      strFile := Copy(FieldByName('mName').AsString, 4, Length(FieldByName('mName').AsString));
      if FileExists(strFile + '.dfm') then
      begin
        s := 'SAction(''' + FieldByName('mName').AsString + ''', ''' + strFile + ''', '''');';
        AppMemo.Lines.Add('  ' + s);
      end;
      Next;
    end;
    AppMemo.Lines.SaveToFile(AppPath.Text + 'App.txt');
  end;
  MessageDlg('Set AppMenu OK! 请把 App.txt 中的代码复盖 Main.pas 中的过程 AppBtn2Click, 再执行第二步.', mtInformation, [mbOk], 0);
  screen.Cursor := crDefault;
  Close;
end;

//2.GetMnuInfo 取TMenuItem的属性
procedure TfrmComMain.GetMnuInfo(mnuTmp: TMenuItem);
var
  i: integer;
begin
  if mnuTmp.Count = 0 then
    if pDataBaseType = 'SERVER' then
      SaveAppMenu(mnuTmp, '0')
    else
      SaveAppMenu(mnuTmp, 'false')
  else
  begin
    if pDataBaseType = 'SERVER' then
      SaveAppMenu(mnuTmp, '1')
    else
      SaveAppMenu(mnuTmp, 'true');
    MainMenu1.Tag := MainMenu1.Tag + 1;
    for i := 0 to mnuTmp.Count - 1 do
      GetMnuInfo(mnuTmp.Items[i]);
    MainMenu1.Tag := MainMenu1.Tag - 1;
  end;
end;

//3.SaveAppMenu 保存TMenuItem的属性到数据库
procedure TfrmComMain.SaveAppMenu(mnuTmp: TMenuItem; strIsParent: string);
var
  strCaption: string;
begin
  if (MainMenu1.Tag <> 0) and (mnuTmp.Caption <> '-') and mnuTmp.Visible then
  begin
    PopupMenu1.Tag := PopupMenu1.Tag + 1;
    if Pos('(&', mnuTmp.Caption) = 0 then
      strCaption := mnuTmp.Caption
    else
      strCaption := Copy(mnuTmp.Caption+'a', 1, Pos('(&', mnuTmp.Caption) - 1);
    with Data.Tmp do
    begin
      Close;
      CommandText := 'insert into AppMenu ' +
        '(mName, mCaption, mLevel, mIndex, mIsParent) values ' +
        '(''' + mnuTmp.Name + ''',''' + strCaption + ''',''' + IntToStr(MainMenu1.Tag - 1) + ''',''' + IntToStr(PopupMenu1.Tag) + ''',' + strIsParent + ')';
      Execute;
    end;
  end;
end;

//AppBtn2.Click
procedure TfrmComMain.AppBtn2Click(Sender: TObject);
begin
  screen.Cursor := crHourGlass;
  with Data.Tmp do
  begin
    Close;
    CommandText := 'delete from AppAction';
    Execute;
  end;
  screen.Cursor := crDefault;
end;

//2.SAction 生成AppAction
procedure TfrmComMain.SAction(AMenuName, AFormNames, AOther: string);
var
  i, j, l, intTag: integer;
  strFList, strFName, strMx, strClass, strName, strCaption, strOther: string;
begin
  strFList := AFormNames;
  strOther := AOther;
  //AppAction.aIndex
  AppMemo.Tag := 1;
	while strFList <> '' do
  begin
		if Pos(';', strFList) <> 0 then
    begin
      strFName := Copy(strFList, 1, Pos(';', strFList) - 1);
      strFList := Copy(strFList, Pos(';', strFList) + 1, Length(strFList));
    end else
    begin
      strFName := strFList;
			strFList := '';
		end;
		if Pos('-', strFName) <> 0 then
    begin
  		strMx := Copy(strFName, 1, Pos('-', strFName)- 1) + ' - ';
      strFName := Copy(strFName, Pos('-', strFName) + 1, Length(strFName));
    end
    else
  		strMx := '';
    if FileExists(AppPath.Text + strFName + '.pas') then
    begin
      AppMemo.Lines.LoadFromFile(AppPath.Text + strFName + '.pas');
      l := Pos('class(T', AppMemo.Lines.Text);
      strClass := '';
      if l > 0 then
        for i := l + 6 to l + 50 do
        begin
          if AppMemo.Lines.Text[i] = ')' then
            break;
          strClass := strClass + AppMemo.Lines.Text[i];
        end;
      //frmComJbzl
      if (strClass = 'TfrmComJbzl') or (strClass = 'TfrmComFlzl') or
        (strClass = 'TfrmComDczl') or (strClass = 'TfrmComDjzb') or
        (strClass = 'TfrmComLbzb') then
      begin
        SaveAction(AMenuName, strFName, 'aPrint',  strMx + '打印');
        SaveAction(AMenuName, strFName, 'aNew',    strMx + '增加');
        SaveAction(AMenuName, strFName, 'aModify', strMx + '修改');
        SaveAction(AMenuName, strFName, 'aDel',    strMx + '删除');
        SaveAction(AMenuName, strFName, 'aTotal',  strMx + '统计');
      end;
      //frmComDjzb
      if (strClass = 'TfrmComDjzb') then
        SaveAction(AMenuName, strFName, 'aView',   strMx + '查看');
      //frmComDj
      if (strClass = 'TfrmComDj') then
      begin
        SaveAction(AMenuName, strFName, 'aPrint',  strMx + '打印');
        SaveAction(AMenuName, strFName, 'aNew',    strMx + '新单');
        SaveAction(AMenuName, strFName, 'aDel',    strMx + '删单');
        SaveAction(AMenuName, strFName, 'aInsert', strMx + '增加');
        SaveAction(AMenuName, strFName, 'aDelete', strMx + '删除');
      end;
      //Add Action
      AppMemo.Lines.LoadFromFile(strFName + '.dfm');
      with AppMemo.Lines do
        for i := 0 to Count - 1 do
        begin
          if (Pos('TAction', Strings[i]) > 0) and (Pos('TActionList', Strings[i]) = 0) then
          begin
            strName := trim(Strings[i]);
            strName := Copy(strName, Pos(' ', strName) + 1, Length(strName));
            strName := Copy(strName, 1, Pos(':', strName) - 1);
            intTag := 0;
            strCaption := '';
            for j := i + 1 to i + 3 do
            begin
              if Pos('Tag = ', Strings[j]) > 0 then
                intTag := 1;
              if Pos('Caption = ', Strings[j]) > 0 then
                strCaption := Copy(Strings[j], Pos(' = ', Strings[j]) + 4, Length(Strings[j]) - (Pos(' = ', Strings[j]) + 4));
            end;
            if intTag = 0 then
              SaveAction(AMenuName, strFName, strName, strMx + strCaption)
            else
              SaveAction(AMenuName, strFName, strName, 'Delete Action');
          end;
        end;
      //Other Action
      while strOther <> '' do
      begin
        if Pos(';', strOther) <> 0 then
        begin
          strName := Copy(strOther, 1, Pos(';', strOther) - 1);
          strOther := Copy(strOther, Pos(';', strOther) + 1, Length(strOther));
        end else
        begin
          strName := strOther;
          strOther := '';
        end;
        if Pos('-', strName) <> 0 then
        begin
          strCaption := Copy(strName, 1, Pos('-', strName)- 1);
          strName := Copy(strName, Pos('-', strName) + 1, Length(strName));
          SaveAction(AMenuName, strFName, strName, strCaption);
        end;
      end;
    end
    else
      ShowMessage(PChar('File ''' + strFName + '.pas'' not find!'));
  end;
end;

//SaveAction
procedure TfrmComMain.SaveAction(mName, fName, aName, aCaption: string);
begin
  if (aCaption = '') or (aName = 'aRefresh') or (aName = 'aSearch') or
    (aName = 'aAll') or (aName = 'aViewMode') or (aName = 'aSetViewMode') or
    (aName = 'aDetail') or (aName = 'aView') then
    exit;
  fName := 'frm' + fName;  
  if Pos('(&', aCaption) > 0 then
    aCaption := Copy(aCaption+'a', 1, Pos('(&', aCaption) - 1);
  with Data.Tmp do
  begin
    Close;
    if aCaption = 'Delete Action' then
      CommandText := 'delete from AppAction ' +
        'where mName = ''' + mName + ''' and ' +
        'fName = ''' + fName + ''' and ' +
        'aName = ''' + aName + ''''
    else
      CommandText := 'insert into AppAction (mName, fName, aName, aCaption, aIndex) ' +
        'values (''' + mName + ''', ''' + fName + ''', ''' + aName + ''', ' +
        '''' + aCaption + ''', ' + IntToStr(AppMemo.Tag) + ')';
    Execute;
  end;
  AppMemo.Tag := AppMemo.Tag + 1;
end;

end.