📄 unitmain.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 + -