Delphi - 手把手教你基于D7+Access常用管理系统架构的设计与实现
前言
从事软件开发工作好多年了,学的越深入越觉得自己无知,所以还是要对知识保持敬畏之心,活到老,学到老!
健身和代码一样都不能少,身体是革命的本钱,特别是我们这种高危工种,所以小伙伴们运动起来!有没有健身撸铁,体脂现在是多少呀?明年(2020/03/22)徐州的马拉松有没有报名呀!?
扯的有点远了,接下来我将抽三天时间手把手教你基于Delphi7+Access,同时搭配第三方控件RC、AlphaControl(第三方控件主要用于美化界面),完成通用管理系统架构的设计。骚年,想想是不是还有点小激动?
涉及知识点
- Access数据库建立与关键表结构设计
- Delphi ADOConnection动态连接Access数据库
- Delphi前台fsMDIForm和fsMDIChild窗体设计
- dxBarManager方式通用菜单架构设计
- 主界面常见状态栏涉及与动态更新(软件版本信息、时间状态信息、登录组信息、滚动信息、当前时间...)
- Delphi通用登录界面设计及主界面载入交互
- MD5方式验证和保存密码
- 动态窗体菜单列表(打开窗体事件、销毁窗体事件)
- RzCheckTree方式设计常见用户权限
- imageList图标库
- 第三方控件:RC、AlphaControl皮肤控件
看到这么多知识点是不是感觉有点晕啊!
没关系,接下来我们一步一步实现!注意我们的口号,保持对知识的敬畏之心!
整体设计方案
这个是我们系统实现部分的一个设计方案,因为系统是通用的嘛,所以这里我就叫它Common Management System了,下面简称CMS。
这里暂不做DFEMA和PFEMA的深层次分析,有BUG的系统才是好系统,不然还要开发和维护人员做什么?(客户小姐姐:呸,渣男!)
项目实现
骚年,扶好了,我要教你开车了,啊呸,我要教你开发了。
Access数据库建立与关键表结构设计
创建一个Access文件,命名为DataX.mdb,再创建两张表,分别命名为sysUser和sysUserAuthority,其中ID栏位自动生成,VDate栏位为日期格式,其余栏位均为长文本根式,并添加如下数据,如下图。
Delphi ADOConnection动态连接Access数据库
启动Delphi7,新建一个项目,分别命名为:工程文件命名为:CommonManagementSystem.dpr,单元文件命名为:uMain.pas,主窗体命名为:MainFrm。
然后保存,注意文件的保存位置,因为接下来连接Access数据库时需要根据相对路径来,参考下图。
然后,在主窗体上放一个ADOConnection控件,命名为conMain。接下来在工程onShow事件中写如下代码:
1 procedure TMainFrm.FormShow(Sender: TObject); 2 begin 3 // 动态连接Access数据库 4 try 5 Screen.Cursor := crSQLWait; 6 ChDir(ExtractFilePath(Application.ExeName)); 7 ChDir('..'); 8 try //动态加载数据库 9 conMain.Connected := False; 10 conMain.ConnectionString := 'Provider=Microsoft.Jet.OlEDB.4.0;Data Source=' + GetCurrentDir + '\DataX\DataX.mdb' + ';User ID=admin;Password=;Persist security Info=False'; 11 conMain.Connected := True; 12 conMain.LoginPrompt := False; 13 statusPaneAccess.Caption := '数据库已连接';//状态栏控件statusPane 14 Screen.Cursor := crDefault; 15 except 16 Screen.Cursor := crDefault; 17 statusPaneAccess.Caption := '数据库未连接'; 18 MessageDlg('数据库连接失败,请确认!', mtError, [mbOK], 0); 19 end; 20 Screen.Cursor := crDefault; 21 except 22 statusPaneAccess.Caption := '数据库未连接'; 23 MessageDlg('数据库连接失败,请确认!', mtError, [mbOK], 0); 24 end; 25 end;
OK,到这里工程动态连接Access数据库的功能已经实现了。
骚年,是不是感觉很简单,是的,你没有看错,跟着我一步步做,就是so easy!(🤫,不要忘记我们的口号)其实复杂的功能都是通过简单的功能组合起来的!所以,加油吧!骚年!
Delphi前台fsMDIForm和fsMDIChild窗体设计
OK,回到主界面,在对象控制面板中选中MainFrm,单击F11,在属性控制面板中设定WindowState属性设置为wsMaximized,FormStyle属性设置为fsMDIForm,后续再建立的From,FormStyle属性都设置为fsMDIChild。
dxBarManager方式通用菜单架构设计
拖一个dxBarManager控件到主界面,命名为dxbarManagerMain,双击该控件打开Toolbars界面,New两个Toolbar分别为菜单和快捷工具条,如下图。
- 在控件Commands界面新增Categories分别为主菜单、系统设置和窗口
- 在主菜单下建立dxBarSubItem类型的菜单系统设置和窗口
- 在系统设置菜单下建立dxBarButton类型的菜单系统权限设置和帮助
- 在窗口菜单下建立dxBarButton类型的菜单窗口平铺、窗口层叠和窗口垂直,和dxBarListItem类型的菜单窗口列表
注意:这里的菜单类型不能选错!!!
注意:这里的菜单类型不能选错!!!
注意:这里的菜单类型不能选错!!!
OK,菜单设计好之后,我们选中dxbarManagerMain控件,单击F11,设置Style为bmsFlat。然后双击打开控件,选中Toolbars中菜单,单击F11,分别设置IsMainMenu、MultiLine和OneOnRow属性为True。如下图。
OK,接下来,拖动菜单完成菜单架构设计,快捷工具条暂时不用,后续我们再介绍,请看下图。
主界面常见状态栏涉及与动态更新(软件版本信息、时间状态信息、登录组信息、滚动信息、当前时间...)
鼠标点击主界面空白处,单击右键选择 Add a Status Bar,添加一个statusBar控件,命名为statusBarMain,然后选中statusBar,右键单击New一些控件,分别设置其名称、对齐方式、Caption等。
最终效果,如下:
OK,今天就到这里了,明天,我们继续!骚年,注意关注、收藏、推荐,不要迷了路!!!
Delphi通用登录界面设计及主界面载入交互
小伙伴我回来了,看到大家的评论,不禁老泪纵横,老兵不死,就是干(⊙﹏⊙)。。。。。。。。。。。。。
OK,打起精神我们接着昨天的内容继续。
首先打开我们的工程,新建一个Form,命名为FrmLogin,然后开始进行前台布局,注意控件的命名一定要规范哈,我大概搞了一下登录界面,如下图。
然后,我们新建一个单元文件,命名为sysPublic.pas,用来声明项目公用的函数、过程和变量,代码如下(注意,这里涉及到第三方控件:RC,cx)。
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
1 unit SysPublic; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Dialogs, Forms, 7 Classes, Variants, StdCtrls, Db, 8 Controls, WinSock, ShellApi, jpeg, graphics, TypInfo, 9 ExtCtrls, ComObj, ComCtrls, IdSMTP, IdMessage, 10 RzChkLst, ActnList, DBCtrls, RzTreeVw, RzGroupBar, DateUtils, 11 StrUtils, Math, RzPanel, cxStyles, RzDBCmbo, RzDBBnEd, 12 cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, 13 cxDBData, cxTextEdit, cxGridCustomTableView, cxGridTableView, 14 cxGridDBTableView, Ora, MemDS, DBAccess, cxGridLevel, cxClasses, dxBar, 15 cxControls, cxGridCustomView, cxGrid, cxDropDownEdit, cxGridBandedTableView, cxGridDBBandedTableView, cxGridExportLink, Clipbrd, 16 IdBaseComponent, IdComponent, RzDBEdit, IdHash, IdHashMessageDigest, 17 IdFTP, IdFTPCommon, nb30, CwMboxLib_TLB, TlHelp32, winspool, Registry, 18 IdIPWatch, ADODB; 19 var 20 sysMsgBuffer, //消息缓存 21 sysWorkNO, //工号 22 sysUserName, //用户名称 23 sysGroupName, //登录组 24 sysRealName, //用户姓名 25 sysMac, //MAC地址 26 sysIP, //IP地址 27 sysDataXPath: string; //数据库地址 28 function GetMd5Str(ContenStr: string): string; //获取Md5码 29 procedure OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent); 30 procedure ExecSQL(sSQL: string); 31 procedure SetParam(V_Qry: TADOQuery; V_Param: string); 32 procedure Openquery(Q: TADOQuery; V_Sql: string); 33 procedure ComboAdd(Sender: Tstrings; SQLStr: string); 34 procedure ShowDxBarManagerMenu(); 35 36 function GetIPAddress(): Variant; 37 function SaveToExcel(GridMain: TcxGrid; FileName: string): string; 38 function GetSql(Ssql, V_Param: string): Variant; 39 function GetPosName(sName: string): string; 40 41 implementation 42 uses uMain; 43 44 procedure OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent); 45 {根据传递过来的参数,打开相应的窗体} 46 var 47 i: integer; 48 Child: TForm; 49 begin 50 for i := 0 to Screen.FormCount - 1 do 51 if Screen.Forms[i].ClassType = FormClass then 52 begin 53 {检查窗体是否已经打开,如果没有打开,打开它, 54 如果已经打开,让它正常显示即可} 55 Child := Screen.Forms[i]; 56 if Child.WindowState = wsMinimized then 57 ShowWindow(Child.handle, SW_SHOWNORMAL) 58 else 59 ShowWindow(Child.handle, SW_SHOWNA); 60 if (not Child.Visible) then Child.Visible := True; 61 Child.BringToFront; 62 Child.Setfocus; 63 TForm(fm) := Child; 64 exit; 65 end; 66 Child := TForm(FormClass.NewInstance); 67 TForm(fm) := Child; 68 Child.Create(AOwner); 69 end; 70 71 procedure SetParam(V_Qry: TADOQuery; V_Param: string); 72 var 73 i: Integer; 74 S: tstringlist; 75 begin 76 s := tstringlist.Create; 77 s.Clear; 78 if v_Param <> '' then 79 begin 80 s.Text := stringreplace(v_Param, '[;]', '[KEY]', [rfReplaceAll]); 81 s.Text := stringreplace(s.Text, ';', #13 + #10, [rfReplaceAll]); 82 if S.Count > V_Qry.Fields.Count then 83 begin 84 ShowMessage('参数个数超过要求:' + V_Param + '[' + V_Qry.SQL.Text + ']'); 85 Abort; 86 end; 87 for i := 0 to s.Count - 1 do 88 begin 89 if (V_Qry.FieldDefList[i].Name = 'RQ1') or (V_Qry.FieldDefList[i].Name = 'RQ2') then 90 begin 91 V_Qry.FieldDefList[i].Name := s[i]; 92 end 93 else 94 begin 95 V_Qry.FieldDefList[i].Name := stringreplace(s[i], '[KEY]', ';', [rfReplaceAll]); 96 end; 97 end; 98 end; 99 end; 100 101 procedure OpenQuery(Q: TADOQuery; V_Sql: string); 102 begin 103 Q.Close; 104 Q.SQL.Text := V_Sql; 105 end; 106 107 procedure ComboAdd(Sender: Tstrings; SQLStr: string); 108 var 109 i, r: Integer; 110 begin 111 with MainFrm.qryTmp do 112 begin 113 Close; 114 SQL.Clear; 115 SQL.Add(SQLStr); 116 Open; 117 First; 118 R := RecordCount; 119 for i := 1 to r do 120 begin 121 Sender.Add(Fields[0].AsString); 122 Next; 123 end; 124 Close; 125 end; 126 end; 127 128 procedure ExecSQL(sSQL: string); 129 begin 130 MainFrm.qryTmp.Close; 131 MainFrm.qryTmp.SQL.Text := sSQL; 132 MainFrm.qryTmp.ExecSQL; 133 end; 134 135 function GetIPAddress(): Variant; 136 var 137 IPAddress: TIdIPWatch; 138 IPAdd_Buff: string; 139 begin 140 IPAddress := TIdIPWatch.Create(nil); 141 IPAdd_Buff := IPAddress.LocalIP; 142 if IPAdd_Buff <> '' then 143 begin 144 Result := IPAdd_Buff; 145 end 146 else 147 begin 148 Result := ''; 149 ShowMessage('获取IP地址错误,请确认!'); 150 Abort; 151 end; 152 end; 153 154 function SaveToExcel(GridMain: TcxGrid; FileName: string): string; 155 var 156 SaveFileDialog: TSaveDialog; 157 begin 158 SaveFileDialog := TSaveDialog.Create(nil); 159 SaveFileDialog.FileName := FileName; 160 SaveFileDialog.Filter := '*.xls'; 161 if SaveFileDialog.Execute then 162 begin 163 if pos('.XLS', UpperCase(SaveFileDialog.FileName)) <= 0 then 164 SaveFileDialog.FileName := SaveFileDialog.FileName + '.XLS'; 165 ExportGridToExcel(SaveFileDialog.FileName, gridMain); 166 ShowMessage('数据已成功导出到您指定的目录中'); 167 end; 168 Result := SaveFileDialog.FileName; 169 SaveFileDialog.Free; 170 end; 171 172 function GetSql(Ssql, V_Param: string): Variant; 173 var 174 S: Tstringlist; 175 I: Integer; 176 begin 177 S := Tstringlist.Create; 178 S.Clear; 179 OpenQuery(MainFrm.qryTmp, Ssql); 180 SetParam(MainFrm.qryTmp, V_Param); 181 MainFrm.qryTmp.Open; 182 if MainFrm.qryTmp.IsEmpty then 183 Result := '' 184 else 185 Result := MainFrm.qryTmp.Fields[0].Value; 186 if VarIsNull(result) then 187 begin 188 result := ''; 189 end; 190 MainFrm.qryTmp.Close; 191 MainFrm.qryTmp.Free; 192 end; 193 194 function GetPosName(sName: string): string; 195 var 196 s: string; 197 begin 198 s := Trim(sName); 199 if pos('(', s) > 0 then 200 s := copy(s, 0, pos('(', s) - 1); 201 Result := s; 202 end; 203 204 205 //获取MD5码 206 //ContenStr:原码,返回MD5码 207 208 function GetMd5Str(ContenStr: string): string; 209 var 210 RegMd5: TIdHashMessageDigest5; 211 RegDigest: T4x4LongWordRecord; 212 begin 213 RegMd5 := TIdHashMessageDigest5.Create; 214 RegDigest := RegMd5.HashValue(ContenStr); 215 Result := LowerCase(RegMd5.AsHex(RegDigest)); 216 end; 217 218 //刷线主界面菜单权限 219 220 procedure ShowDxBarManagerMenu(); 221 var 222 dxBar: TdxBarManager; 223 i, l, lIndex: integer; 224 sCap, sSql, m_menu_group, m_menu: string; 225 begin 226 with MainFrm.qryTmp do 227 begin 228 Close; 229 SQL.Clear; 230 SQL.Text := 'select a.GroupName, b.MenuName, a.UserName from sysUser a, sysUserAuthority b where a.GroupName = b.GroupName and a.UserName=:UserName and b.SystemName=:SystemName'; 231 Parameters.ParamByName('UserName').Value := sysUserName; 232 Parameters.ParamByName('SystemName').Value := 'CMS'; 233 234 Open; 235 dxBar := MainFrm.dxBarManagerMain; 236 for i := 1 to dxBar.Categories.Count - 2 do 237 begin 238 m_menu_group := dxBar.Categories.Strings[i]; 239 for l := 0 to dxBar.ItemCount - 1 do 240 begin 241 if dxBar.Items[l] is TdxBarButton then 242 begin 243 if dxBar.Items[l].Category = i then 244 begin 245 sCap := dxBar.Items[l].Caption; 246 lIndex := dxBar.Items[l].Index; 247 m_menu := sCap; 248 if Locate('MenuName', sCap, []) then 249 dxBar.Items[l].Enabled := true 250 else 251 dxBar.Items[l].Enabled := false; 252 end; 253 end; 254 end; 255 end; 256 end; 257 258 end; 259 260 end.
好,我们在主窗体OnShow事件中(连接Access数据库下面),写如下代码,功能是:主窗体Show之前,登录窗体先弹出来。
1 // 系统登录 2 if not assigned(FrmLogin) then 3 FrmLogin := TFrmLogin.create(Application); 4 FrmLogin.ShowModal;
然后,开始写登录事件,同时,更新主界面菜单权限和状态栏信息。
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
1 begin 2 // 检查录入完整性 3 if (Trim(edtUserName.Text) = '') or (Trim(edtPassCode.Text) = '') then 4 begin 5 MessageDlg('用户名或者密码不能为空,请确认!', mtWarning, [mbOK], 0); 6 edtUserName.SetFocus; 7 Abort; 8 end; 9 // 开始登录 10 with qryLogin do 11 begin 12 Close; 13 SQL.Clear; 14 SQL.Text := 'select * from sysUser t where UserName=:UserName and PassCode =:PassCode'; 15 Parameters.ParamByName('UserName').Value := Trim(edtUserName.Text); 16 Parameters.ParamByName('PassCode').Value := GetMd5Str(Trim(edtPassCode.Text)); 17 Open; 18 if FindFirst then 19 begin 20 sysUserName := FieldByName('UserName').AsString; 21 sysGroupName := FieldByName('GroupName').AsString; ; 22 sysWorkNO := FieldByName('WorkNO').AsString; ; 23 sysRealName := FieldByName('RealName').AsString; 24 // 刷新菜单权限 25 ShowDxBarManagerMenu(); 26 // 更新状态栏信息 27 MainFrm.statusPaneUser.Caption := '登录用户[' + sysUserName + '] 登陆组[' + sysGroupName + ']'; 28 FrmLogin.Tag := 1; 29 FrmLogin.Close; 30 end 31 else 32 begin 33 MessageDlg('用户名或者密码不正确,请确认!', mtWarning, [mbOK], 0); 34 edtUserName.SetFocus; 35 Abort; 36 end; 37 end; 38 39 end;
我们这里用FrmLogin.Tag作为标记登录成功与否的标记,默认情况下设置为0,密码验证通过时,tag赋值为1,然后在FrmLogin的Close事件中判断其是否为1,否则直接终止程序。
1 procedure TFrmLogin.FormClose(Sender: TObject; var Action: TCloseAction); 2 begin 3 if FrmLogin.Tag <> 1 then 4 Application.Terminate; 5 end;
OK,看下现在的效果。
注意,我这里手工在Access数据库中增加了一个用户admin,分组为查询组,其菜单权限相比于管理组,少了一个帮助的菜单。那小伙伴该问了,后续所有的权限都要在Access里面改??当然不是了,下面我们会继续讲解权限的管理。
MD5方式验证和保存密码
这里相信你在上面登录相关代码中已经看到了,MD5转换就是一个函数搞定的事。保存密码也是一样,直接调用MD5转换函数进行转化,然后再保存到数据库即可。
//获取MD5码 //ContenStr:原码,返回MD5码 //需要引用 IdHash, IdHashMessageDigest单元 function GetMd5Str(ContenStr: string): string; var RegMd5: TIdHashMessageDigest5; RegDigest: T4x4LongWordRecord; begin RegMd5 := TIdHashMessageDigest5.Create; RegDigest := RegMd5.HashValue(ContenStr); Result := LowerCase(RegMd5.AsHex(RegDigest)); end;
动态窗体菜单列表(打开窗体事件、销毁窗体事件)
首先,根据实际情况,一般除主窗体之外的所有窗体的FormStyle属性都要设置成fsMDIChild,然后在Project-Options中将子窗体移到右边。如下图。
另外,分别在子窗体的Create、Close和Destroy写如下事件(注意主界面窗体列表菜单的名称为dxBarListWindows):
1 procedure TFrmMDIChildTest.FormClose(Sender: TObject; 2 var Action: TCloseAction); 3 begin 4 //窗口关闭时,从内存中移除窗口 5 Action := caFree; 6 FrmMDIChildTest := nil; 7 end; 8 9 procedure TFrmMDIChildTest.FormCreate(Sender: TObject); 10 begin 11 //窗口创建时,在窗口菜单中加入窗口的菜单 12 MainFrm.dxBarListWindows.Items.AddObject(Caption, Self); 13 end; 14 15 procedure TFrmMDIChildTest.FormDestroy(Sender: TObject); 16 begin 17 //窗口关闭时,在窗口菜单中移除窗口的菜单 18 with MainFrm.dxBarListWindows.Items do 19 Delete(IndexOfObject(Self)); 20 end;
主界面窗口列表菜单下(name:dxBarListWindows),需要再增加如下事件用来激活窗体列表:
1 procedure TMainFrm.dxBarListWindowsClick(Sender: TObject); 2 begin 3 with dxBarListWindows do 4 TCustomForm(Items.Objects[ItemIndex]).Show; 5 end; 6 7 procedure TMainFrm.dxBarListWindowsGetData(Sender: TObject); 8 begin 9 with dxBarListWindows do 10 ItemIndex := Items.IndexOfObject(ActiveMDIChild); 11 end;
好的,我们再看下效果,可以完成窗体列表中相关菜单的添加、激活和销毁:
RzCheckTree方式设计常见用户权限
这里主要用到checkTree和数据的增删改查。
源码如下:
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
1 unit uUserSet; 2 3 interface 4 5 uses 6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 Dialogs, sCalculator, cxStyles, cxCustomData, cxGraphics, cxFilter, 8 cxData, cxDataStorage, cxEdit, DB, cxDBData, cxTextEdit, cxDropDownEdit, 9 ADODB, Ora, ComCtrls, RzTreeVw, StdCtrls, RzCmboBx, RzLabel, cxGridLevel, 10 cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, 11 cxControls, cxGridCustomView, cxGrid, Mask, RzEdit, RzRadChk, RzButton, 12 ExtCtrls, RzPanel, RzTabs, cxCalendar, cxCheckBox, dxBar; 13 14 type 15 TFrmUserSet = class(TForm) 16 pageControlMain: TRzPageControl; 17 tabSheetUserSet: TRzTabSheet; 18 groupBoxParams: TRzGroupBox; 19 btnRefresh: TRzBitBtn; 20 btnAdd: TRzBitBtn; 21 btnSave: TRzBitBtn; 22 btnDelete: TRzBitBtn; 23 checkBoxUserName: TRzCheckBox; 24 edtUserName: TRzEdit; 25 btnDodify: TRzBitBtn; 26 cxGridMain: TcxGrid; 27 cxGridMainDBTableView1: TcxGridDBTableView; 28 cxGridMainLevel1: TcxGridLevel; 29 tabSheetAuthSet: TRzTabSheet; 30 groupBoxParamsA: TRzGroupBox; 31 labGroupName: TRzLabel; 32 lblNewGroupName: TRzLabel; 33 cbbGroupName: TRzComboBox; 34 btnSaveA: TRzBitBtn; 35 btnDeleteA: TRzBitBtn; 36 edtNewGroupName: TRzEdit; 37 btnAddA: TRzBitBtn; 38 checkTreeMain: TRzCheckTree; 39 qryTmp: TADOQuery; 40 qryUser: TADOQuery; 41 dsUser: TDataSource; 42 qryUserAuthority: TADOQuery; 43 cxGridMainDBTableView1Column1: TcxGridDBColumn; 44 cxGridMainDBTableView1Column2: TcxGridDBColumn; 45 cxGridMainDBTableView1Column3: TcxGridDBColumn; 46 cxGridMainDBTableView1Column4: TcxGridDBColumn; 47 cxGridMainDBTableView1Column5: TcxGridDBColumn; 48 cxGridMainDBTableView1Column6: TcxGridDBColumn; 49 cxGridMainDBTableView1Column7: TcxGridDBColumn; 50 procedure btnRefreshClick(Sender: TObject); 51 procedure FormClose(Sender: TObject; var Action: TCloseAction); 52 procedure FormDestroy(Sender: TObject); 53 procedure FormCreate(Sender: TObject); 54 procedure btnAddClick(Sender: TObject); 55 procedure btnSaveClick(Sender: TObject); 56 procedure btnDeleteClick(Sender: TObject); 57 procedure btnDodifyClick(Sender: TObject); 58 procedure LoadMenu(dxBar: TdxBarManager); 59 procedure cbbGroupNameClick(Sender: TObject); 60 procedure btnSaveAClick(Sender: TObject); 61 procedure btnDeleteAClick(Sender: TObject); 62 procedure btnAddAClick(Sender: TObject); 63 procedure qryUserBeforePost(DataSet: TDataSet); 64 private 65 { Private declarations } 66 public 67 { Public declarations } 68 end; 69 70 var 71 FrmUserSet: TFrmUserSet; 72 73 implementation 74 uses 75 uMain, sysPublic; 76 {$R *.dfm} 77 78 procedure TFrmUserSet.LoadMenu(dxBar: TdxBarManager); 79 var 80 I, L: integer; 81 Tnode: TTreenode; 82 begin 83 with checkTreeMain.Items do 84 begin 85 Clear; 86 for i := 0 to dxBar.Categories.Count - 1 do 87 begin 88 Tnode := AddChild(nil, GetPosName(dxBar.Categories.Strings[i])); 89 for l := 0 to dxBar.ItemCount - 1 do 90 if dxBar.Items[l] is TdxBarButton then 91 if dxBar.Items[l].Category = i then 92 begin 93 AddChild(Tnode, GetPosName(dxBar.Items[l].Caption)); 94 end; 95 end; 96 end; 97 with qryTmp do 98 begin 99 Close; 100 SQL.Text := 'select MenuName from sysUserAuthority where SystemName=''CMS'' and GroupName=:GroupName'; 101 Parameters.ParamByName('GroupName').Value := cbbGroupName.Text; 102 Open; 103 for i := 0 to checkTreeMain.Items.Count - 1 do 104 if checkTreeMain.Items[i].Level > 0 then 105 if Locate('MenuName', checkTreeMain.Items[i].Text, []) then 106 checkTreeMain.ItemState[i] := csChecked; 107 Close; 108 end; 109 end; 110 111 procedure TFrmUserSet.btnRefreshClick(Sender: TObject); 112 begin 113 if not checkBoxUserName.Checked then 114 begin 115 with qryUser do 116 begin 117 Close; 118 SQL.Clear; 119 SQL.Text := 'select * from sysUser t'; 120 Open; 121 end; 122 end 123 else 124 begin 125 with qryUser do 126 begin 127 Close; 128 SQL.Clear; 129 SQL.Text := 'select * from sysUser t where t.UserName =''' + edtUserName.text + ''' or t.WorkNO =''' + edtUserName.text + ''''; 130 Open; 131 end; 132 end; 133 btnDodify.Enabled := True; 134 end; 135 136 procedure TFrmUserSet.FormClose(Sender: TObject; var Action: TCloseAction); 137 begin 138 //窗口关闭时,从内存中移除窗口 139 Action := caFree; 140 FrmUserSet := nil; 141 end; 142 143 procedure TFrmUserSet.FormDestroy(Sender: TObject); 144 begin 145 //窗口关闭时,在窗口菜单中移除窗口的菜单 146 with MainFrm.dxBarListWindows.Items do 147 Delete(IndexOfObject(Self)); 148 end; 149 150 procedure TFrmUserSet.FormCreate(Sender: TObject); 151 begin 152 //窗口创建时,在窗口菜单中加入窗口的菜单 153 MainFrm.dxBarListWindows.Items.AddObject(Caption, Self); 154 cbbGroupName.Items.Clear; 155 ComboAdd(cbbGroupName.Items, 'select distinct GroupName from sysUserAuthority where SystemName=''CMS'' order by GroupName'); 156 TcxComboBoxProperties(cxGridMainDBTableView1Column4.Properties).Items.Text := cbbGroupName.Items.Text; 157 cbbGroupName.ItemIndex := 0; 158 cbbGroupName.OnClick(Self); 159 end; 160 161 procedure TFrmUserSet.btnAddClick(Sender: TObject); 162 begin 163 qryUser.Append; 164 btnSave.Enabled := True; 165 end; 166 167 procedure TFrmUserSet.btnSaveClick(Sender: TObject); 168 begin 169 qryUser.Post; 170 btnSave.Enabled := False; 171 MessageDlg('保存成功,请不要重复操作!', mtInformation, [mbOK], 0); 172 end; 173 174 procedure TFrmUserSet.btnDeleteClick(Sender: TObject); 175 begin 176 case MessageDlg('删除将无法恢复,您确认要继续删除吗?', mtWarning, [mbYes, 177 mbNo], 0) of 178 mrYes: 179 begin 180 qryUser.Delete; 181 btnSave.Enabled := False; 182 MessageDlg('删除成功,请不要重复操作!', mtInformation, [mbOK], 0); 183 end; 184 mrNo: 185 begin 186 Exit; 187 end; 188 end; 189 end; 190 191 procedure TFrmUserSet.btnDodifyClick(Sender: TObject); 192 begin 193 btnSave.Enabled := True; 194 btnDelete.Enabled := True; 195 qryUser.Edit; 196 end; 197 198 procedure TFrmUserSet.cbbGroupNameClick(Sender: TObject); 199 begin 200 LoadMenu(MainFrm.dxBarManagerMain); 201 end; 202 203 procedure TFrmUserSet.btnSaveAClick(Sender: TObject); 204 var 205 I: Integer; 206 begin 207 for i := 0 to checkTreeMain.Items.Count - 1 do 208 begin 209 if checkTreeMain.Items[i].Level > 0 then 210 if checkTreeMain.ItemState[i] = csChecked then 211 begin 212 with qryTmp do 213 begin 214 Close; 215 SQL.Clear; 216 SQL.Text := 'SELECT * FROM sysUserAuthority WHERE GROUPNAME =:GROUPNAME AND MENUNAME =:MENUNAME'; 217 Parameters.ParamByName('GROUPNAME').Value := cbbGroupName.Text; 218 Parameters.ParamByName('MENUNAME').Value := checkTreeMain.Items.Item[i].Text; 219 Open; 220 if RecordCount = 0 then 221 begin 222 qryUserAuthority.Close; 223 qryUserAuthority.SQL.Clear; 224 qryUserAuthority.SQL.Text := 'INSERT INTO sysUserAuthority(GROUPNAME, MENUNAME, SystemName) VALUES(:GROUPNAME, :MENUNAME, :SystemName)'; 225 qryUserAuthority.Parameters.ParamByName('GROUPNAME').Value := cbbGroupName.Text; 226 qryUserAuthority.Parameters.ParamByName('MENUNAME').Value := checkTreeMain.Items.Item[i].Text; 227 qryUserAuthority.Parameters.ParamByName('SystemName').Value := 'CMS'; 228 qryUserAuthority.ExecSQL; 229 end; 230 end; 231 end 232 else 233 begin 234 ExecSql('DELETE FROM sysUserAuthority WHERE SystemName= ''CMS'' AND GROUPNAME=''' + cbbGroupName.Text + ''' AND MENUNAME=''' + checkTreeMain.Items.Item[i].Text + ''''); 235 end; 236 end; 237 TcxComboBoxProperties(cxGridMainDBTableView1Column4.Properties).Items.Text := cbbGroupName.Items.Text; 238 ShowMessage('保存成功!'); 239 end; 240 241 procedure TFrmUserSet.btnDeleteAClick(Sender: TObject); 242 begin 243 if MessageDLG('您确定要删除该分组权限吗?', mtconfirmation, [MBOK, MBCANCEL], 0) = MRCANCEL then exit; 244 ExecSql('Delete from sysUserAuthority where SystemName=''' + Application.Title + ''' AND groupname=''' + cbbGroupName.Text + ''''); 245 end; 246 247 procedure TFrmUserSet.btnAddAClick(Sender: TObject); 248 begin 249 if edtNewGroupName.Text = '' then 250 begin 251 ShowMessage('请先输入组名!'); 252 exit; 253 end; 254 cbbGroupName.Items.Add(edtNewGroupName.Text); 255 cbbGroupName.ItemIndex := cbbGroupName.Items.Count - 1; 256 cbbGroupName.OnClick(self); 257 ShowMessage('添加成功!'); 258 edtNewGroupName.Text := ''; 259 end; 260 261 procedure TFrmUserSet.qryUserBeforePost(DataSet: TDataSet); 262 begin 263 if (Pos(' ', qryUser.FieldByName('UserName').AsString) > 0) or (Pos(' ', qryUser.FieldByName('PassCode').AsString) > 0) then 264 begin 265 ShowMessage('用户名或密码中不能有空格!请重新输入'); 266 Abort; 267 end; 268 if (qryUser.State = dsInsert) or ((qryUser.State = dsEdit) and (Length(qryUser.FieldByName('PassCode').AsString) < 20)) then 269 begin 270 qryUser.FieldByName('PassCode').AsString := GetMd5Str(qryUser.FieldByName('PassCode').AsString); 271 end; 272 end; 273 274 end.
OK,今天就到这里吧,其实整个通用的管理系统架构基本已经完成了,我们明天主要完善/美化一下界面。
感觉写博客比做技术还累,专业的事情交给专业的人做(⊙﹏⊙)。。。。。。
能看到这里的绝逼是Delphi真爱。。。。。
imageList图标库
小伙伴,今天我们继续打卡。
imageList图标仓库,主要用于菜单的美化。
在主界面拖一个imageList控件,命名为imageListMain,然后添加一些图标进去。如下图。
然后,完成dxBarManagerMain和imageListMain的绑定(dxBarManagerMain的image属性)。
OK,至此,就可以为主菜单增加图标了(选中菜单,根据需要选择imageIndex)。
第三方控件:RC、AlphaControl皮肤控件
后来我想了一下,关于第三方库,就不再讲解了,大家有兴趣可以自行研究。说句傲娇的话,做技术最重要的是功能,花里胡哨的干啥呀!
不过话说回来,好的UI界面能够极大的提高用户体验(啪啪打脸(⊙﹏⊙)),下面带大家看下AlphaControl皮肤控件的Demo效果(到这里下载控件包AlphaControl官网)。
最后
最后,作为一名程序员,语言只是一种工具,如何快速、高效的达到项目需求,才是最主要的。
最最重要的是:我们要时刻保持对技术的热爱,兴趣是最好的老师,活到老学到老!
OK,最后看下我们这个项目的总体效果!
任何疑问、建议、意见请留言或者私信我哦~~~~
源码已上传GitHub,点击下载源码,有任何疑问欢迎和我交流。
作者:Jeremy.Wu
出处:https://www.cnblogs.com/jeremywucnblog/
本文版权归作者和博客园共有,欢迎转载,但未经作者同意必须保留此段声明,且在文章页面明显位置给出原文连接,否则保留追究法律责任的权利。