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

📄 unitmain.~pas

📁 社区服务系统
💻 ~PAS
字号:
unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, ToolWin, ComCtrls, jpeg, ImgList, StdCtrls,ADODB,
  DB, ActnList, OleCtrls;

type                                                                                   
  TfrmMain = class(TForm)
    Splitter1: TSplitter;
    StatusMain: TStatusBar;
    mmuMainMenu1: TMainMenu;
    ActionList1: TActionList;
    Action1: TAction;
    N1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Image1: TImage;
    N2: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    procedure ToolButton9Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);

  private
    { Private declarations }
    procedure statusBarMain;                                                // 状态栏
    procedure TopMenu;                                                      //顶部菜单的动态生成
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  adore : TADOQuery;
  strUserNo : string;                                                      //变量strUserNo用来保存登陆用户的编号
  rs : TADOQuery;
  strUname : string;                                                       //登录用户名
  strsql : string;                                                         
  mnuTop,mnuchild : TMenuItem;                                             //菜单项     
  str_power : string;                                                      //权限标志,例如0代表添加
  aryPower : array of string;                                              //用来存放权限标志

implementation
uses unitADOConn,UnitLog,UnitUser,UnitData,UnitCommunity,UnitHouse,UnitPerson,UnitPersonHealth,U_type;
{$R *.dfm}

procedure TfrmMain.ToolButton9Click(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  try
    Application.CreateForm(TfrmLogin, frmLogin);
    if frmLogin.ShowModal=1 then
      strUname := frmLogin.edtuser.Text
    else                                                                   //登录成功后将登录用户名赋给strUname
    begin
      close;
      exit;
    end;
  finally
    frmLogin.Free;                                                          //登录成功后将登录窗口释放掉
  end;
  //  tvmenulist;                                                             //树型菜单列表
    statusBarMain;                                                          //状态栏
    TopMenu;                                                                //动态生成顶部菜单
end;





procedure TfrmMain.statusBarMain;
var
  strRName : string;
  i,j : integer;
begin
  try
    rs := TADOQuery.Create(nil);
    rs.Connection := adoconn;

    //-----------------------------------------根据登陆用户名找到用户所拥有的角色------------------------------
    rs.SQL.Text :='select r.Rname,r.Rpower from TUser u,TUserRole ur,TRole r';
    rs.SQL.Text := rs.SQL.Text + ' where u.Uname = :strUname and u.UNo= :strUserNo and u.UNo=ur.UNo';
    rs.SQL.Text := rs.SQL.Text + ' and ur.Rno=r.Rno';
    rs.Parameters.ParamByName('strUname').Value := strUname;
    rs.Parameters.ParamByName('strUserNo').Value := strUserNo;
    rs.Open;
    while not rs.Eof do
    begin
      if strRName<>'' then
        strRName := strRName +','+ rs.fieldbyname('Rname').AsString                       //用户拥有多个角色,用逗号隔开
      else                                                                                //以备状态栏清晰显示出来
        strRName :=rs.fieldbyname('Rname').AsString;
      str_power := rs.fieldbyname('Rpower').AsString;
      if pos(',',str_power)=0 then
      begin
        if str_power='0' then
          blnAdd := true
        else if str_power='1' then
               blnModify := true
        else if str_power='2' then
               blnDel := true
        else if str_power='3' then
               blnView := true;
      end
      else
      begin
        i := 0;
        while pos(',',str_power)>0 do
        begin
          setlength(aryPower,i+1);
          aryPower[i] := copy(str_power,1,1);
          str_power := copy(str_power,pos(',',str_power)+1,length(str_power));
          i := i+1;
        end;
          setlength(aryPower,i+1);
          aryPower[i] := str_power;
        for j:=0 to i do
        begin
          if aryPower[j]='0' then
            blnAdd := true
          else if aryPower[j]='1' then
                 blnModify := true
          else if aryPower[j]='2' then
                 blnDel := true
          else if aryPower[j]='3' then
                 blnView := true;
        end;
      end;
      rs.Next;
    end;
    rs.Close;

    statusMain.Panels[0].Text := '操作员:'+strUname;
    statusMain.Panels[1].Text := '用户类型:'+ strRName;
    statusMain.Panels[2].Text := '版权所有:林宗明,邹家杰,余鸿,徐嵩,林闽奇,石娜,刘初阳,刘必虾,连宗江,陆涛,李政,魏天恩,吴乙敏';
  except
    on e:exception do
    begin
      showmessage(e.Message);
    end;
  end;
end;


{
*************************************************************************************
函数名称: 顶部菜单的生成
功能描述: 根据登录用户的权限,将用户没有的功能菜单设为不可见
输入参数: 无
输出参数: 无
返回 值:  无
说   明:
*************************************************************************************
}
procedure TfrmMain.TopMenu;
var
   strFno : string;
   mnuTop,mnuchild : TMenuItem;
begin
  try
    adopub.Close;
    adopub.SQL.Text :='select UNo from TUser where Uname= :strUname';                        //根据strUname 中已知的用户名得到用户编号
    adopub.Parameters.ParamByName('strUname').Value := strUname;
    adopub.Open;
    if adopub.RecordCount<>0 then
      strUserNo := adopub.fieldbyname('UNo').AsString;                                       //将登陆用户编号保存在strUserNo中
    adopub.Close;
  except
    on e:exception do
    begin
      showmessage(e.Message);
    end;
  end;                                                         
  try
    adopub.SQL.Text :='select distinct f.Fno,f.Fname,f.Fpater,f.Flever from TUser u,TUserRole ur,TRole r,TRoleFunction rf,TFunction f';
    adopub.SQL.Text :=adopub.SQL.text + ' where u.Uname = :strUname and u.UNo= :strUserNo and u.UNo=ur.UNo and ur.Rno=r.Rno';
    adopub.SQL.text :=adopub.SQL.text + ' and r.Rno=rf.Rno and rf.Fno=f.Fno and Flever=0 order by f.Fno';
    adopub.Parameters.ParamByName('strUname').Value := strUname;
    adopub.Parameters.ParamByName('strUserNo').Value := strUserNo;
    adopub.Open;

    while not adopub.Eof do
    begin
        strFno := adopub.fieldbyname('Fno').AsString;

        mnuTop := TMenuItem.Create(mmuMainMenu1);
        mnuTop.Caption := adopub.fieldbyname('Fname').AsString;
        mmuMainMenu1.Items.Add(mnuTop);
                                                                                        //插入菜单
        adoshare.Close;
        adoshare.SQL.Text :='select distinct f.Fno,f.Fname,f.Fpater,f.Flever from TUser u,TUserRole ur,TRole r,TRoleFunction rf,TFunction f';
        adoshare.SQL.text := adoshare.SQL.text + ' where u.Uname = :strUname and u.UNo= :strUserNo and u.UNo=ur.UNo and ur.Rno=r.Rno';
        adoshare.SQL.text := adoshare.SQL.text + ' and r.Rno=rf.Rno and rf.Fno=f.Fno order by f.Fno';
        adoshare.Parameters.ParamByName('strUname').Value := strUname;
        adoshare.Parameters.ParamByName('strUserNo').Value := strUserNo;
        adoshare.Open;

        while not adoshare.Eof do
        begin
          if adoshare.FieldByName('Fpater').asstring=strFno then                       //找到父菜单
          begin
            mnuchild := TMenuItem.Create(mmuMainMenu1);
            mnuchild.Caption := adoshare.fieldbyname('Fname').AsString;
            mnuTop.Add(mnuchild);                                                      //插入下级菜单
            mnuchild.OnClick := Action1Execute;
            mnuchild.ImageIndex := 7;                                                  //指定下级菜单的图片
          end;
          adoshare.Next;
        end;
        adoshare.Close;
      adopub.Next;
    end;
    adopub.Close;
  except
    on e:exception do
    begin
      showmessage(e.Message);
    end;
  end;
end;


{
*************************************************************************************
函数名称: Action事件赋给顶部菜单单击事件
功能描述: 用户每单击一个菜单项将调用该事件
输入参数: 无
输出参数: 无
返回 值:  无
说   明:
*************************************************************************************
}
procedure TfrmMain.Action1Execute(Sender: TObject);
var
  strMenu : string;
begin
  //showmessage((sender as TMenuItem).Caption);
  strMenu := (sender as TMenuItem).Caption;
  if strMenu='用户管理' then                                                  //根据菜单项的caption属性调用相应的模块
  begin
    Application.CreateForm(TfrmUser, frmUser);
    frmUser.ShowModal;
  end
  {else if strMenu='角色管理' then
       begin
         Application.CreateForm(TfrmRole, frmRole);
         frmRole.ShowModal;
       end
  else if strMenu='数据字典' then
       begin
         Application.CreateForm(TfrmData, frmData);
         frmData.ShowModal;
       end      }
  else if  strMenu='社区资料管理' then
       begin
         Application.CreateForm(TfrmCommunity, frmCommunity);
         frmCommunity.ShowModal;
       end
  else if  strMenu='家庭资料' then
       begin
         Application.CreateForm(TfrmHouse, frmHouse);
         frmHouse.ShowModal;
       end
  else if  strMenu='个人基本资料' then
       begin
         Application.CreateForm(TfrmPerson, frmPerson);
         frmPerson.ShowModal;
       end
  else if  strMenu='个人健康档案' then
       begin
         Application.CreateForm(TfrmPersonHealth, frmPersonHealth);
         frmPersonhealth.ShowModal;
       end
  {else if  strMenu='糖尿病' then
       begin
          Application.CreateForm(Tfrmdiabetes, frmdiabetes);
          frmdiabetes.ShowModal;
       end
  else if  strMenu='慢性病人数查询' then
       begin
          Application.CreateForm(TfrmCount, frmCount);
          frmCount.ShowModal;
       end;    }
end;

procedure TfrmMain.N3Click(Sender: TObject);
begin
  if MessageDlg('您是否要退出系统?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
  self.Close;
end;

procedure TfrmMain.N2Click(Sender: TObject);
begin
  //panel1.Visible:=true;
//  tvFunction.Visible:=true;
//  ShockwaveFlash1.Visible:=false;
end;

procedure TfrmMain.N4Click(Sender: TObject);
begin
  //panel1.Visible:=false;
  //tvFunction.Visible:=false;
  //ShockwaveFlash1.Visible:=true;
end;

procedure TfrmMain.N6Click(Sender: TObject);
begin
  Application.CreateForm(Tfrmtype, frmtype);
  frmtype.ShowModal;
end;

end.


⌨️ 快捷键说明

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