MainUnit.pas 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218
  1. unit MainUnit;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  5. DB, DBClient, ZjGridDBA, ZJGrid, ExtCtrls, ComCtrls, ToolWin, Dialogs,
  6. ServerServices, AnimateWinService, Menus, StdCtrls, TypeUnit, TypeConfig;
  7. type
  8. TfrmMian = class(TForm)
  9. StatusBar1: TStatusBar;
  10. CoolBar1: TCoolBar;
  11. ToolBar1: TToolBar;
  12. tbOpen: TToolButton;
  13. tbExit: TToolButton;
  14. tvTree: TTreeView;
  15. Splitter1: TSplitter;
  16. zgClientInfo: TZJGrid;
  17. zaClientInfo: TZjGridDBA;
  18. PopupMenu: TPopupMenu;
  19. muShow: TMenuItem;
  20. muExit: TMenuItem;
  21. N1: TMenuItem;
  22. tbPort: TToolButton;
  23. tbClose: TToolButton;
  24. tbDeleteClient: TToolButton;
  25. procedure FormCreate(Sender: TObject);
  26. procedure FormDestroy(Sender: TObject);
  27. procedure tbExitClick(Sender: TObject);
  28. procedure muExitClick(Sender: TObject);
  29. procedure muShowClick(Sender: TObject);
  30. procedure tbOpenClick(Sender: TObject);
  31. procedure tbPortClick(Sender: TObject);
  32. procedure tbCloseClick(Sender: TObject);
  33. procedure tbDeleteClientClick(Sender: TObject);
  34. private
  35. FServer: TScServer;
  36. FAnimateWin: TAnimateWinService;
  37. procedure InitTV;
  38. procedure ExitApp;
  39. procedure RefreshTV;
  40. procedure AddTVNode(AType, ACount: Integer);
  41. function ChangePort: string;
  42. procedure ChangeStatus(const Value: string);
  43. procedure WMClose(var Message: TWMClose); message WM_CLOSE;
  44. procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
  45. procedure SMClientCount(var Msg: TMessage); message SM_ClientCount;
  46. procedure SMStatus(var Msg: TMessage); message SM_Status;
  47. public
  48. { Public declarations }
  49. end;
  50. var
  51. frmMian: TfrmMian;
  52. implementation
  53. {$R *.dfm}
  54. procedure TfrmMian.FormCreate(Sender: TObject);
  55. begin
  56. FServer := TScServer.Create;
  57. FAnimateWin := TAnimateWinService.Create;
  58. FAnimateWin.WinControl := Self;
  59. InitTV;
  60. zaClientInfo.DataSet := FServer.ClientInfoService.cdsClientInfo;
  61. // SetWindowLong(application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
  62. end;
  63. procedure TfrmMian.FormDestroy(Sender: TObject);
  64. begin
  65. FreeAndNil(FServer);
  66. FAnimateWin.Free;
  67. end;
  68. procedure TfrmMian.InitTV;
  69. var
  70. vNode: TTreeNode;
  71. begin
  72. vNode := tvTree.Items.AddChild(nil, '服务器');
  73. vNode := tvTree.Items.AddChild(vNode, FServer.ServerIP);
  74. vNode := tvTree.Items.Add(vNode, FServer.Port);
  75. tvTree.Items[0].Expand(True);
  76. end;
  77. procedure TfrmMian.tbExitClick(Sender: TObject);
  78. begin
  79. ExitApp;
  80. end;
  81. procedure TfrmMian.muExitClick(Sender: TObject);
  82. begin
  83. ExitApp;
  84. end;
  85. procedure TfrmMian.ExitApp;
  86. begin
  87. FAnimateWin.DelIconFromTray;
  88. Application.Terminate;
  89. end;
  90. procedure TfrmMian.muShowClick(Sender: TObject);
  91. begin
  92. Show;
  93. end;
  94. procedure TfrmMian.WMClose(var Message: TWMClose);
  95. begin
  96. FAnimateWin.MinAnimate;
  97. FAnimateWin.AddIconToTray;
  98. Hide;
  99. end;
  100. procedure TfrmMian.tbOpenClick(Sender: TObject);
  101. begin
  102. if FServer.OpenServer then
  103. begin
  104. ChangeStatus('打开');
  105. tbPort.Enabled := False;
  106. end;
  107. end;
  108. procedure TfrmMian.tbPortClick(Sender: TObject);
  109. begin
  110. FServer.Port := ChangePort;
  111. RefreshTV;
  112. end;
  113. function TfrmMian.ChangePort: string;
  114. begin
  115. Result := '';
  116. while Result = '' do
  117. begin
  118. {要加空格,否则汉字显示不全,可能是TLabel对文字支持问题}
  119. if not InputQuery('输入端口号', '值: ', Result) then Exit;
  120. end;
  121. end;
  122. procedure TfrmMian.RefreshTV;
  123. begin
  124. tvTree.Items.Clear;
  125. InitTV;
  126. end;
  127. procedure TfrmMian.TrayIconMessage(var Msg: TMessage);
  128. var
  129. MousePt: TPoint; //鼠标点击位置
  130. begin
  131. if (Msg.LParam = WM_RBUTTONUP) then // 用鼠标右键点击图标
  132. begin
  133. GetCursorPos(MousePt); // 获取光标位置
  134. SetForegroundWindow(Handle); // 弹出菜单自动隐藏
  135. PopupMenu.Popup(MousePt.X, MousePt.Y); // 在光标位置弹出选单
  136. end
  137. else if (Msg.LParam = WM_LBUTTONDBLCLK) then Show;
  138. end;
  139. procedure TfrmMian.ChangeStatus(const Value: string);
  140. begin
  141. StatusBar1.Panels[0].Text := Format(' 服务器状态:%s', [Value]);
  142. end;
  143. procedure TfrmMian.SMClientCount(var Msg: TMessage);
  144. var
  145. iV0, iV1, iV2: Integer;
  146. begin
  147. iV0 := Msg.WParamHi;
  148. AddTVNode(Flag_Version_0, iV0);
  149. end;
  150. procedure TfrmMian.AddTVNode(AType, ACount: Integer);
  151. var
  152. Flag: Boolean;
  153. sText: string;
  154. vNode, cNode: TTreeNode;
  155. begin
  156. sText := CfgManager.GetAppType(AType) + ':';
  157. vNode := tvTree.Items.GetFirstNode;
  158. cNode := vNode.getFirstChild;
  159. Flag := False;
  160. while Assigned(cNode) do
  161. begin
  162. if Pos(sText, cNode.Text) <> 0 then
  163. begin
  164. cNode.Text := Format('%s%d', [sText, ACount]);
  165. Flag := True;
  166. Break;
  167. end;
  168. cNode := cNode.GetNext;
  169. end;
  170. if not Flag then
  171. begin
  172. cNode := tvTree.Items.AddChild(vNode, Format('%s%d', [sText, ACount]));
  173. end;
  174. end;
  175. procedure TfrmMian.tbCloseClick(Sender: TObject);
  176. begin
  177. FServer.CloseServer;
  178. tbPort.Enabled := True;
  179. ChangeStatus('关闭');
  180. end;
  181. procedure TfrmMian.tbDeleteClientClick(Sender: TObject);
  182. begin
  183. if zgClientInfo.CurRow - zgClientInfo.FixedRowCount <= zaClientInfo.RecordCount - 1 then
  184. FServer.DeleteClient;
  185. end;
  186. procedure TfrmMian.SMStatus(var Msg: TMessage);
  187. begin
  188. ChangeStatus('关闭');
  189. end;
  190. end.