Delphi - 手把手教你基於D7+Access經常使用管理系統架構的設計與實現

時間 2019-12-17

標籤 delphi 手把手基於 d7+access access 經常使用管理系統架構設計實現欄目 Delphi 简体版

原文原文鏈接

前言

　　從事軟件開發工做好多年了，學的越深刻越以爲本身無知，因此仍是要對知識保持敬畏之心，活到老，學到老！php

健身和代碼同樣都不能少，身體是革命的本錢，特別是咱們這種高危工種，因此小夥伴們運動起來！有沒有健身擼鐵，體脂如今是多少呀？明年（2020/03/22）徐州的馬拉松有沒有報名呀！？node

　　扯的有點遠了，接下來我將抽三天時間手把手教你基於Delphi7+Access，同時搭配第三方控件RC、AlphaControl（第三方控件主要用於美化界面），完成通用管理系統架構的設計。騷年，想一想是否是還有點小激動？程序員

涉及知識點

Access數據庫創建與關鍵表結構設計
Delphi ADOConnection動態鏈接Access數據庫
Delphi前臺fsMDIForm和fsMDIChild窗體設計
dxBarManager方式通用菜單架構設計
主界面常見狀態欄涉及與動態更新（軟件版本信息、時間狀態信息、登陸組信息、滾動信息、當前時間...）
Delphi通用登陸界面設計及主界面載入交互
MD5方式驗證和保存密碼
動態窗體菜單列表（打開窗體事件、銷燬窗體事件）
RzCheckTree方式設計常見用戶權限
imageList圖標庫
第三方控件：RC、AlphaControl皮膚控件

看到這麼多知識點是否是感受有點暈啊！

不要緊，接下來咱們一步一步實現！注意咱們的口號，保持對知識的敬畏之心！　　

總體設計方案

　　這個是咱們系統實現部分的一個設計方案，由於系統是通用的嘛，因此這裏我就叫它Common Management System了，下面簡稱CMS。sql

　　這裏暫不作DFEMA和PFEMA的深層次分析，有BUG的系統纔是好系統，否則還要開發和維護人員作什麼？（客戶小姐姐：呸，渣男！）數據庫

項目實現

　　騷年，扶好了，我要教你開車了，啊呸，我要教你開發了。緩存

Access數據庫創建與關鍵表結構設計

　　建立一個Access文件，命名爲DataX.mdb，再建立兩張表，分別命名爲sysUser和sysUserAuthority，其中ID欄位自動生成，VDate欄位爲日期格式，其他欄位均爲長文本根式，並添加以下數據，以下圖。架構

Delphi ADOConnection動態鏈接Access數據庫 ide

　　啓動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[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.

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[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.