前言
从事软件开发工作好多年了，学的越深入越觉得自己无知，所以还是要对知识保持敬畏之心，活到老，学到老！
健身和代码一样都不能少，身体是革命的本钱，特别是我们这种高危工种，所以小伙伴们运动起来！有没有健身撸铁，体脂现在是多少呀？明年（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）。
 
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, '[;]', '[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.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, '[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;
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.
View Code 好，我们在主窗体OnShow事件中（连接Access数据库下面），写如下代码，功能是：主窗体Show之前，登录窗体先弹出来。
1 // 系统登录
2 if not assigned(FrmLogin) then
3 FrmLogin := TFrmLogin.create(Application);
4 FrmLogin.ShowModal;
然后，开始写登录事件，同时，更新主界面菜单权限和状态栏信息。
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;
View Code 我们这里用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和数据的增删改查。
源码如下：
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[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.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, [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.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, [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.
View Code
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/
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
来源：https://www.cnblogs.com/jeremywucnblog/p/12022001.html |
发表于 2019-12-11 16:25:00
