⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modulecontrol.pas

📁 产品信息系统!关于产品基础信息的系统!功能强大!
💻 PAS
字号:
unit ModuleControl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, ExtCtrls, ActnList, Buttons, StdCtrls, DB, ADODB, ImgList, Menus,
  fcButton, fcImgBtn, fcShapeBtn, fcClearPanel, fcButtonGroup;

type
  TfrmModuleControl = class(TfrmMDIBase)
    pnlNavigator: TPanel;
    pnlCenter: TPanel;
    ActionList: TActionList;
    spb1: TSpeedButton;
    spb2: TSpeedButton;
    spb3: TSpeedButton;
    spb4: TSpeedButton;
    spb5: TSpeedButton;
    spb6: TSpeedButton;
    spb7: TSpeedButton;
    spb8: TSpeedButton;
    spb9: TSpeedButton;
    spb10: TSpeedButton;
    spb11: TSpeedButton;
    spb12: TSpeedButton;
    spb13: TSpeedButton;
    spb14: TSpeedButton;
    spb15: TSpeedButton;
    spb16: TSpeedButton;
    Panel1: TPanel;
    fcBtgNavigator: TfcButtonGroup;
    fcbtn1: TfcShapeBtn;
    fcbtn2: TfcShapeBtn;
    fcbtn3: TfcShapeBtn;
    fcbtn4: TfcShapeBtn;
    QFunctions: TADOQuery;
    ADOCommand1: TADOCommand;
    pnlFlow: TPanel;
    Button1: TButton;
    ImgLeft: TImage;
    ImgRight: TImage;
    ImgFlowRight: TImage;
    ImgLstModule: TImageList;
    MMModule: TMainMenu;
    fcbtn5: TfcShapeBtn;
    fcbtn6: TfcShapeBtn;
    fcbtn7: TfcShapeBtn;
    procedure fcbtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure UpdatePnlCenter(Sender: TObject); //根据选择的模块,更新面板中的快截按钮
    { Private declarations }
  protected
    procedure SetAction(ModuleID: Integer); //根据当前用户的权限,设置子模块控制窗体的Actions的激活状态
    procedure find_item(citem:TMenuItem;ccount:Integer;cstr:string;caction:TContainedAction);
  public
    { Public declarations }
  end;

var
  frmModuleControl  : TfrmModuleControl;
  HeadMenuItem      : TMenuItem;

implementation

uses DataModule, Global, main;
{$R *.dfm}

{根据当前用户的权限,设置子模块控制窗体的Actions的激活状态}
procedure TfrmModuleControl.SetAction(ModuleID: Integer);
var
  i                 : Integer;
  sFunction         : string;           //功能名称,即TAction的Caption属性
begin
  if G_bAdmin then
    for i := 0 to ActionList.ActionCount - 1 do
    begin
      (ActionList.Actions[i] as TAction).Enabled := G_bAdmin;
      (ActionList.Actions[i] as TAction).ImageIndex := i;
    end
  else
    for i := 0 to ActionList.ActionCount - 1 do
    begin
      sFunction := (ActionList.Actions[i] as TAction).Name;
      //激活状态参照权限表中是否有此功能模块
      (ActionList.Actions[i] as TAction).Enabled :=
        dmClient.spUserRight.Locate('fModuleID;fActionName', varArrayOf([ModuleID, sFunction]), []);
      (ActionList.Actions[i] as TAction).ImageIndex := i;
    end;
end;

{根据选择的模块,更新面板中的快截按钮}
procedure TfrmModuleControl.UpdatePnlCenter(Sender: TObject);
var
  iTag              : Integer;          //取得当前单击按钮的Tag;
  i, j              : Integer;
begin
  {先初始化面板上的按钮}
  for i := 0 to pnlCenter.ControlCount - 1 do
    if pnlCenter.Controls[i] is TSpeedButton then
    begin
      (pnlCenter.Controls[i] as TSpeedButton).Action := nil;
      (pnlCenter.Controls[i] as TSpeedButton).Visible := false;
      (pnlCenter.Controls[i] as TSpeedButton).Glyph := nil;
    end;

  iTag := (Sender as TfcShapeBtn).Tag;  //取得当前单击按钮的Tag;
  //pnlFlow.Visible := (iModuleID in [2, 3, 5, 6, 8]) and (iTag = 0);
  pnlFlow.Visible:=False;
  j := 0;

  {*************************************************************
  先历遍ActionList中的Actions,如果其Tag等于当前单击按钮的Tag,
  则把其赋给面板中的SpeedButton
  **************************************************************}
  with ActionList do
    for i := 0 to ActionCount - 1 do
      if Actions[i].Tag = iTag then
      begin
        {查找下一个没有设置Action属性的SpeedButton}
        while not (pnlCenter.Controls[j] is TSpeedButton) do
          j := j + 1;
        {设置Action属性}
        //(pnlCenter.Controls[j] as TSpeedButton).Visible:=False;
        (pnlCenter.Controls[j] as TSpeedButton).Action := Actions[i];
        j := j + 1;
      end;
end;

procedure TfrmModuleControl.fcbtn1Click(Sender: TObject);
begin
  UpdatePnlCenter(Sender);
end;

procedure TfrmModuleControl.find_item(citem:TMenuItem;ccount:Integer;cstr:string;caction:TContainedAction);
var
    i:integer;
    cstr1:string;
    caction1:TContainedAction;
begin
    //if ccount<>0 then
    //begin
        cstr1:=cstr;
        //caction1:=TContainedAction.Create(self);
        //caction1:=caction;
        if (Trim(citem.Caption)=Trim(cstr)) then //and (caction1.Tag>=0) then
        begin
            HeadMenuItem:=citem;
            //ShowMessage(HeadMenuItem.Caption);
            exit;
        end
        //else if caction1.Tag<0 then
        //begin
            //HeadMenuItem:=nil
        //end
        else
        begin
        end;

        for i:=0 to citem.Count-1 do
        begin
            self.find_item(citem[i],citem[i].Count,cstr1,caction1);
        end;
    //end
    //else
    //begin
        //exit;
   // end;
end;

procedure TfrmModuleControl.FormCreate(Sender: TObject);
var
//   i,groupindex1                :Integer;
  i: Integer;
  NewMenuItem: TMenuItem;

begin
  inherited;
  ImgLeft.Picture.LoadFromFile('Bmp\ModuleLeft.Bmp');
  ImgRight.Picture.LoadFromFile('Bmp\ModuleRight.Bmp');
  ImgFlowRight.Picture.LoadFromFile('Bmp\ModuleRight.Bmp');
  ImgFlowRight.SendToBack;

//  groupindex1:=1;
  //生成菜单
  with ActionList do
    for i := 0 to ActionCount - 1 do
    begin
        if Actions[i].tag<0 then
            Continue;
        HeadMenuItem:=nil;
        //for j:=0 to MMModule.Items.Count-1 do
        //begin
            //ShowMessage(self.MMModule.Items[j].Caption);
            self.find_item(Self.MMModule.Items,self.MMModule.Items.Count,Trim(Actions[i].Category),Actions[i]);
        //end;
        //if HeadMenuItem<>nil then
            //ShowMessage(HeadMenuItem.Caption)
        //else
            //ShowMessage('xian');
        //ShowMessage(Actions[i].Category);
      //HeadMenuItem := MMModule.Items.Find(Trim(Actions[i].Category));
      //if HeadMenuItem<>nil then
        //ShowMessage(HeadMenuItem.Caption);
      //如果是新组
      if HeadMenuItem = nil then
      begin
        NewMenuItem := TMenuItem.create(self);
        NewMenuItem.Caption := Actions[i].Category;
        NewMenuItem.GroupIndex := 2;
        {if (iModuleID in [2, 3, 5, 6, 8]) then
          iTag := Actions[i].Tag - 1
        else
          iTag := Actions[i].Tag;

        if MMModule.Items.Count > iTag then
          MMModule.Items.Insert(iTag, NewMenuItem)
        else}
          MMModule.Items.Add(NewMenuItem);

        HeadMenuItem := NewMenuItem;

        NewMenuItem := TMenuItem.create(self);
        NewMenuItem.Action := Actions[i];
        HeadMenuItem.Add(NewMenuItem);
        //self.Refresh;
        //ShowMessage('jin');
      end
      else
      begin
        NewMenuItem := TMenuItem.create(self);
        NewMenuItem.Action := Actions[i];
        HeadMenuItem.Add(NewMenuItem)
      end;
    end;

  SetAction(iModuleID);
  //初始选择第一个单元
  fcbtn1Click(fcbtn1);

  if G_bAdmin then
    self.Button1.Visible:=True
  else
    self.Button1.Visible:=False;
end;

procedure TfrmModuleControl.Button1Click(Sender: TObject);
var
  i                 : Integer;
  sID               : string;
begin
  inherited;
  with ADOCommand1 do
  begin
    parameters.ParamValues['iModuleID'] := iModuleID;
    try
        try
          Execute;
        except
          ShowMessage('出错!');
          Exit;
        end;
    finally
        //ShowMessage('正确!');
    end;
  end;
  try
      try
          if not QFunctions.Active then QFunctions.Open;
          for i := 1 to ActionList.ActionCount do
          begin
            if ActionList.Actions[i-1].Tag=-1 then
                Continue;

            QFunctions.Append;
            if i<10 then
                sID := '0' + InttoStr(i)
            else
                sID:=IntToStr(i);
            QFunctions.FieldbyName('fID').asInteger := StrtoInt(InttoStr(iModuleID) + copy(sID, Length(sID) - 1, Length(sID)));
            QFunctions.FieldbyName('fModuleID').asInteger := iModuleID;
            QFunctions.FieldbyName('fActionName').asString := (ActionList.Actions[i - 1] as TAction).Name;
            QFunctions.FieldbyName('fName').asString := (ActionList.Actions[i - 1] as TAction).Caption;
            QFunctions.FieldbyName('fRun').asBoolean := True;
          end;
          QFunctions.Post;
      except
        ShowMessage('出错!');
        exit;
      end;
  finally
    //ShowMessage('正确!');
  end;
  ShowMessage('正确!');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -