Delphi - 手把手教你基于D7+Access常用管理系统架构的设计与实现

马绿树 發表於 2019-12-11 16:25:00

Delphi - 手把手教你基于D7+Access常用管理系统架构的设计与实现

<h2>前言</h2>
　　从事软件开发工作好多年了，学的越深入越觉得自己无知，所以还是要对知识保持敬畏之心，活到老，学到老！
健身和代码一样都不能少，身体是革命的本钱，特别是我们这种高危工种，所以小伙伴们运动起来！有没有健身撸铁，体脂现在是多少呀？明年（2020/03/22）徐州的马拉松有没有报名呀！？
　　扯的有点远了，接下来我将抽三天时间手把手教你基于Delphi7+Access，同时搭配第三方控件RC、AlphaControl（第三方控件主要用于美化界面），完成通用管理系统架构的设计。骚年，想想是不是还有点小激动？
　　<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211124520850-364844363.png" alt=""> 
<hr>
<h2> 涉及知识点</h2>
<ul>
<li>Access数据库建立与关键表结构设计</li>
<li>Delphi ADOConnection动态连接Access数据库</li>
<li>Delphi前台fsMDIForm和fsMDIChild窗体设计</li>
<li>dxBarManager方式通用菜单架构设计</li>
<li>主界面常见状态栏涉及与动态更新（软件版本信息、时间状态信息、登录组信息、滚动信息、当前时间...）</li>
<li>Delphi通用登录界面设计及主界面载入交互</li>
<li>MD5方式验证和保存密码</li>
<li>动态窗体菜单列表（打开窗体事件、销毁窗体事件）</li>
<li>RzCheckTree方式设计常见用户权限</li>
<li>imageList图标库</li>
<li>第三方控件：RC、AlphaControl皮肤控件　　</li>
</ul>
<h3>看到这么多知识点是不是感觉有点晕啊！</h3>
<h3>没关系，接下来我们一步一步实现！注意我们的口号，保持对知识的敬畏之心！　　</h3>
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211124701760-429997369.png" alt="">
<hr>
<h2> 整体设计方案</h2>
　　这个是我们系统实现部分的一个设计方案，因为系统是通用的嘛，所以这里我就叫它Common Management System了，下面简称CMS。
　　<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211120525283-790908649.png" alt="">
　　这里暂不做DFEMA和PFEMA的深层次分析，有BUG的系统才是好系统，不然还要开发和维护人员做什么？（客户小姐姐：呸，渣男！）
　　<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211125822248-1650537748.png" alt=""> 
<hr>
<h2> 项目实现</h2>
　　骚年，扶好了，我要教你开车了，啊呸，我要教你开发了。
<h3>Access数据库建立与关键表结构设计 </h3>
　　创建一个Access文件，命名为DataX.mdb，再创建两张表，分别命名为sysUser和sysUserAuthority，其中ID栏位自动生成，VDate栏位为日期格式，其余栏位均为长文本根式，并添加如下数据，如下图。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211134850005-2043019196.png" alt="">
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211135126995-1997985254.png" alt=""> 
<hr>
 Delphi ADOConnection动态连接Access数据库 
　　启动Delphi7，新建一个项目，分别命名为：工程文件命名为：CommonManagementSystem.dpr，单元文件命名为：uMain.pas，主窗体命名为：MainFrm。
然后保存，注意文件的保存位置，因为接下来连接Access数据库时需要根据相对路径来，参考下图。
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191211140623516-452856280.gif" alt="">
　　然后，在主窗体上放一个ADOConnection控件<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211140802952-1960516695.png" alt="">，命名为conMain。接下来在工程onShow事件中写如下代码: 
<div class="cnblogs_code">
<pre> 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, , 0);
19 end;
20 Screen.Cursor := crDefault;
21 except
22 statusPaneAccess.Caption := '数据库未连接';
23 MessageDlg('数据库连接失败，请确认！', mtError, , 0);
24 end;
25 end;</pre>
</div>
 　  OK，到这里工程动态连接Access数据库的功能已经实现了。
　　骚年，是不是感觉很简单，是的，你没有看错，跟着我一步步做，就是so easy！（🤫，不要忘记我们的口号）其实复杂的功能都是通过简单的功能组合起来的！所以，加油吧！骚年！
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211141556195-677506973.png" alt="">
<hr>
<h3 style="text-align: left">Delphi前台fsMDIForm和fsMDIChild窗体设计</h3>
　　OK，回到主界面，在对象控制面板中选中MainFrm，单击F11，在属性控制面板中设定WindowState属性设置为wsMaximized,FormStyle属性设置为fsMDIForm，后续再建立的From，FormStyle属性都设置为fsMDIChild。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211142731488-181329637.png" alt="">
<hr>
<h3 style="text-align: left">dxBarManager方式通用菜单架构设计</h3>
　　拖一个dxBarManager控件<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211143215885-2087312476.png" alt="">到主界面，命名为dxbarManagerMain，双击该控件打开Toolbars界面，New两个Toolbar分别为菜单和快捷工具条，如下图。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211143258558-608467640.png" alt="">
<ul>
<li style="text-align: left">在控件Commands界面新增Categories分别为主菜单、系统设置和窗口</li>
<li style="text-align: left">在主菜单下建立dxBarSubItem类型的菜单系统设置和窗口</li>
<li style="text-align: left">在系统设置菜单下建立dxBarButton类型的菜单系统权限设置和帮助</li>
<li style="text-align: left">在窗口菜单下建立dxBarButton类型的菜单窗口平铺、窗口层叠和窗口垂直，和dxBarListItem类型的菜单窗口列表</li>
</ul>
<hr>
         注意：这里的菜单类型不能选错！！！
 注意：这里的菜单类型不能选错！！！
 注意：这里的菜单类型不能选错！！！
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211143532058-1392072355.png" alt="" width="331" height="349"><img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211143552036-270943490.png" alt=""><img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211143603004-170964371.png" alt="">
　　OK，菜单设计好之后，我们选中dxbarManagerMain控件，单击F11，设置Style为bmsFlat。然后双击打开控件，选中Toolbars中菜单，单击F11，分别设置IsMainMenu、MultiLine和OneOnRow属性为True。如下图。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211145514701-48173053.png" alt="">
OK，接下来，拖动菜单完成菜单架构设计，快捷工具条暂时不用，后续我们再介绍，请看下图。
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191211150014911-1599062750.gif" alt=""> 
<hr>
<h3> 主界面常见状态栏涉及与动态更新（软件版本信息、时间状态信息、登录组信息、滚动信息、当前时间...） </h3>
　　鼠标点击主界面空白处，单击右键选择 Add a Status Bar，添加一个statusBar控件，命名为statusBarMain，然后选中statusBar，右键单击New一些控件，分别设置其名称、对齐方式、Caption等。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211161618669-1974705391.png" alt=""> 
　　最终效果，如下：
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191211161924106-1675572266.gif" alt="">
　　OK，今天就到这里了，明天，我们继续！骚年，注意关注、收藏、推荐，不要迷了路！！！
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211162404194-190744640.png" alt=""><img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191211162139112-110372021.png" alt="">
<hr>
<h3 style="text-align: left">Delphi通用登录界面设计及主界面载入交互</h3>
小伙伴我回来了，看到大家的评论，不禁老泪纵横，老兵不死，就是干(⊙﹏⊙)。。。。。。。。。。。。。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212124050786-616037989.png" alt=""> 
OK，打起精神我们接着昨天的内容继续。
　　首先打开我们的工程，新建一个Form，命名为FrmLogin，然后开始进行前台布局，注意控件的命名一定要规范哈，我大概搞了一下登录界面，如下图。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212124619315-1663876976.png" alt=""> 
然后，我们新建一个单元文件，命名为sysPublic.pas，用来声明项目公用的函数、过程和变量，代码如下（注意，这里涉及到第三方控件：RC，cx）。 
<div class="cnblogs_code" style="margin-left: 30px"><img id="code_img_closed_0a9acd9f-e455-4958-b350-ca3194e0b9de" class="code_img_closed" src="https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif" alt=""><img id="code_img_opened_0a9acd9f-e455-4958-b350-ca3194e0b9de" class="code_img_opened" style="display: none" src="https://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif" alt="">
<div id="cnblogs_code_open_0a9acd9f-e455-4958-b350-ca3194e0b9de" class="cnblogs_code_hide">
<pre>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.ClassType = FormClass then
 52 begin
 53 {检查窗体是否已经打开，如果没有打开，打开它，
 54 如果已经打开，让它正常显示即可}
 55 Child := Screen.Forms;
 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, '[;]', '', );
 81 s.Text := stringreplace(s.Text, ';', #13 + #10, );
 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.Name = 'RQ1') or (V_Qry.FieldDefList.Name = 'RQ2') then
 90 begin
 91 V_Qry.FieldDefList.Name := s;
 92 end
 93 else
 94 begin
 95 V_Qry.FieldDefList.Name := stringreplace(s, '', ';', );
 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;
239 for l := 0 to dxBar.ItemCount - 1 do
240 begin
241 if dxBar.Items is TdxBarButton then
242 begin
243 if dxBar.Items.Category = i then
244 begin
245 sCap := dxBar.Items.Caption;
246 lIndex := dxBar.Items.Index;
247 m_menu := sCap;
248 if Locate('MenuName', sCap, []) then
249 dxBar.Items.Enabled := true
250 else
251 dxBar.Items.Enabled := false;
252 end;
253 end;
254 end;
255 end;
256 end;
257
258 end;
259
260 end.</pre>
</div>
View Code</div>
 好，我们在主窗体OnShow事件中（连接Access数据库下面），写如下代码，功能是：主窗体Show之前，登录窗体先弹出来。　　
<div class="cnblogs_code">
<pre>1 // 系统登录
2 if not assigned(FrmLogin) then
3 FrmLogin := TFrmLogin.create(Application);
4 FrmLogin.ShowModal;</pre>
</div>
　　然后，开始写登录事件，同时，更新主界面菜单权限和状态栏信息。　　
<div class="cnblogs_code" style="margin-left: 30px"><img id="code_img_closed_09e751c9-ec2e-478f-851c-8c093990ea78" class="code_img_closed" src="https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif" alt=""><img id="code_img_opened_09e751c9-ec2e-478f-851c-8c093990ea78" class="code_img_opened" style="display: none" src="https://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif" alt="">
<div id="cnblogs_code_open_09e751c9-ec2e-478f-851c-8c093990ea78" class="cnblogs_code_hide">
<pre> 1 begin
 2 // 检查录入完整性
 3 if (Trim(edtUserName.Text) = '') or (Trim(edtPassCode.Text) = '') then
 4 begin
 5 MessageDlg('用户名或者密码不能为空，请确认！', mtWarning, , 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, , 0);
34 edtUserName.SetFocus;
35 Abort;
36 end;
37 end;
38
39 end;</pre>
</div>
View Code</div>
 　　我们这里用FrmLogin.Tag作为标记登录成功与否的标记，默认情况下设置为0，密码验证通过时，tag赋值为1，然后在FrmLogin的Close事件中判断其是否为1，否则直接终止程序。　　
<div class="cnblogs_code">
<pre>1 procedure TFrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);
2 begin
3 if FrmLogin.Tag <> 1 then
4 Application.Terminate;
5 end;</pre>
</div>
　　OK，看下现在的效果。　　<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191212131702004-166977520.gif" alt="">
 　　注意，我这里手工在Access数据库中增加了一个用户admin，分组为查询组，其菜单权限相比于管理组，少了一个帮助的菜单。那小伙伴该问了，后续所有的权限都要在Access里面改？？当然不是了，下面我们会继续讲解权限的管理。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212132254450-218898054.png" alt="">　　　　
<hr>
MD5方式验证和保存密码　　
　　这里相信你在上面登录相关代码中已经看到了，MD5转换就是一个函数搞定的事。保存密码也是一样，直接调用MD5转换函数进行转化，然后再保存到数据库即可。　
<div class="cnblogs_code">
<pre>//获取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;</pre>
</div>
 
<hr>
<h3> 动态窗体菜单列表（打开窗体事件、销毁窗体事件）</h3>
　　首先，根据实际情况，一般除主窗体之外的所有窗体的FormStyle属性都要设置成fsMDIChild，然后在Project-Options中将子窗体移到右边。如下图。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212151124967-1889137987.png" alt="">
　　另外，分别在子窗体的Create、Close和Destroy写如下事件（注意主界面窗体列表菜单的名称为dxBarListWindows）：　
<div class="cnblogs_code">
<pre> 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;</pre>
</div>
 　　主界面窗口列表菜单下（name：dxBarListWindows），需要再增加如下事件用来激活窗体列表：
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212151909700-1920346634.png" alt=""> 
<div class="cnblogs_code">
<pre> 1 procedure TMainFrm.dxBarListWindowsClick(Sender: TObject);
 2 begin
 3 with dxBarListWindows do
 4 TCustomForm(Items.Objects).Show;
 5 end;
 6
 7 procedure TMainFrm.dxBarListWindowsGetData(Sender: TObject);
 8 begin
 9 with dxBarListWindows do
10 ItemIndex := Items.IndexOfObject(ActiveMDIChild);
11 end;</pre>
</div>
 　　好的，我们再看下效果，可以完成窗体列表中相关菜单的添加、激活和销毁：
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191212152136744-1254596305.gif" alt="">
<hr>
 RzCheckTree方式设计常见用户权限
这里主要用到checkTree和数据的增删改查。
源码如下： 
<div class="cnblogs_code"><img id="code_img_closed_2137018a-7dbf-42df-898f-cc15e40deec1" class="code_img_closed" src="https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif" alt=""><img id="code_img_opened_2137018a-7dbf-42df-898f-cc15e40deec1" class="code_img_opened" style="display: none" src="https://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif" alt="">
<div id="cnblogs_code_open_2137018a-7dbf-42df-898f-cc15e40deec1" class="cnblogs_code_hide">
<pre>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));
 89 for l := 0 to dxBar.ItemCount - 1 do
 90 if dxBar.Items is TdxBarButton then
 91 if dxBar.Items.Category = i then
 92 begin
 93 AddChild(Tnode, GetPosName(dxBar.Items.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.Level > 0 then
105 if Locate('MenuName', checkTreeMain.Items.Text, []) then
106 checkTreeMain.ItemState := 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, , 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, , 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.Level > 0 then
210 if checkTreeMain.ItemState = 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.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.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.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, , 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.</pre>
</div>
View Code</div>
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191212152258978-161086499.gif" alt="">
　　OK，今天就到这里吧，其实整个通用的管理系统架构基本已经完成了，我们明天主要完善/美化一下界面。
　　感觉写博客比做技术还累，专业的事情交给专业的人做(⊙﹏⊙)。。。。。。
　　能看到这里的绝逼是Delphi真爱。。。。。
　　<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212153145363-1461428253.png" alt=""><img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191212153536279-423500493.png" alt=""> 
<h3> </h3>
<hr>
<h3>imageList图标库</h3>
　　小伙伴，今天我们继续打卡。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191213100042746-569754121.png" alt="">
　　imageList图标仓库，主要用于菜单的美化。
　　在主界面拖一个imageList控件<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191213094038680-1739990997.png" alt="">，命名为imageListMain，然后添加一些图标进去。如下图。
<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191213094453825-274124672.png" alt="">
　　然后，完成dxBarManagerMain和imageListMain的绑定（dxBarManagerMain的image属性）。
　　OK，至此，就可以为主菜单增加图标了（选中菜单，根据需要选择imageIndex）。
　　<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191213095109356-1859721106.png" alt=""> 
<h3>第三方控件：RC、AlphaControl皮肤控件</h3>
　　后来我想了一下，关于第三方库，就不再讲解了，大家有兴趣可以自行研究。说句傲娇的话，做技术最重要的是功能，花里胡哨的干啥呀！ 
　　<img src="https://img2018.cnblogs.com/i-beta/1335881/201912/1335881-20191213095622504-1854012873.png" alt=""> 
　　不过话说回来，好的UI界面能够极大的提高用户体验（啪啪打脸(⊙﹏⊙)），下面带大家看下AlphaControl皮肤控件的Demo效果（到这里下载控件包AlphaControl官网）。
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191213100654526-938145255.gif" alt="">
<h2>最后</h2>
　　最后，作为一名程序员，语言只是一种工具，如何快速、高效的达到项目需求，才是最主要的。
　　最最重要的是：我们要时刻保持对技术的热爱，兴趣是最好的老师，活到老学到老！
　　OK，最后看下我们这个项目的总体效果！
<img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191213102102733-985615066.gif" alt="">　　
<hr>
<h2 style="text-align: center"><img src="https://img2018.cnblogs.com/common/1335881/201912/1335881-20191211132122009-1318556551.gif" alt=""> </h2>
任何疑问、建议、意见请留言或者私信我哦~~~~
源码已上传GitHub，点击下载源码，有任何疑问欢迎和我交流。 
<div id="AllanboltSignature">
<p id="PSignature" style="padding: 10px 10px 10px 60px; background: url("https://images.cnblogs.com/cnblogs_com/jeremywucnblog/1607637/o_191206011825obs.png") 1% no-repeat rgba(229, 241, 244, 1); font-family: 微软雅黑; font-size: 11px; border: 1px dashed rgba(224, 224, 224, 1)">  作者：Jeremy.Wu   出处：https://www.cnblogs.com/jeremywucnblog/
   本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
 

</div> 
来源：https://www.cnblogs.com/jeremywucnblog/p/12022001.html

頁: [1]

琼殿技术论坛's Archiver

Delphi - 手把手教你基于D7+Access常用管理系统架构的设计与实现