?? main.pas.~116~
字號:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, SPComm, ComCtrls, ToolWin, ImgList, StdCtrls,
RzPanel, RzButton, Buttons, cmdHeader,DBCtrls, Mask, Registry,DB, ADODB, Grids, DBGrids,
RzGrids, RzBorder, RzLabel, RzEdit, RzDTP;
type
TUnitDevice=Record
PWSUint:integer;
PWSName:string[25];
Addr:integer;
Name:string[25];
Value,
Max,
Min:word;
CommErr:string[25];
Enabled:boolean;
end;
TProjectInfo=record
prjName, //SaveDataTime, ComPort, BaundRate
cPort,
Baud:string;
sTime, // 保存時間長度間隔多少分鐘 最短5分鐘
defWin:integer;
SavDataTime:TDateTime;//保存數據的時間坐標
end;
TSynComm=record //設備采樣同步標志體
CommErrCount:integer; //設備通訊失敗計數器
CurrentAddr, //當前通訊地址
CurrentUnit:integer; //當前PWS單元號
NextAddr:Boolean; //是否允許采集下個地址信息
U_ID:integer; //巡檢計數器標志
end;
TfrmMain = class(TForm)
Comm1: TComm;
Timer1: TTimer;
meuMain: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
SB1: TStatusBar;
imgList: TImageList;
RzToolbar1: TRzToolbar;
btnToolLogin: TRzToolButton;
RzSpacer1: TRzSpacer;
btnStart: TRzToolButton;
btnStop: TRzToolButton;
RzSpacer2: TRzSpacer;
RzSpacer3: TRzSpacer;
btnClose: TRzToolButton;
Panel1: TPanel;
BitBtn1: TBitBtn;
DataSource1: TDataSource;
adoDBSrc: TADODataSet;
DBGrid2: TDBGrid;
Bevel2: TBevel;
Bevel1: TBevel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
lblConfig: TLabel;
N9: TMenuItem;
meuStart: TMenuItem;
N25: TMenuItem;
meuStop: TMenuItem;
RzSpacer4: TRzSpacer;
Panel3: TPanel;
PB1: TProgressBar;
lblRecived: TEdit;
Panel2: TPanel;
Bevel3: TBevel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
lblFirstRun: TLabel;
edtPwd: TEdit;
cbxUser: TComboBox;
btnLogin: TButton;
btnLogCancel: TButton;
Panel4: TPanel;
GroupBox1: TGroupBox;
Label9: TLabel;
Label10: TLabel;
RzLabel1: TRzLabel;
RzLEDDisplay1: TRzLEDDisplay;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
trvAllDev: TTreeView;
Label6: TLabel;
Label7: TLabel;
edtDecStatus: TEdit;
Bevel4: TBevel;
Bevel5: TBevel;
TrayIcon1: TTrayIcon;
meoRunEvent: TRzMemo;
txtUnitNo: TStaticText;
txtDevName: TStaticText;
txtDevAddrName: TStaticText;
N6: TMenuItem;
meuSereach: TMenuItem;
RzURLLabel1: TRzURLLabel;
Timer2: TTimer;
procedure Timer2Timer(Sender: TObject);
procedure meuSereachClick(Sender: TObject);
procedure btnToolLoginClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnLogCancelClick(Sender: TObject);
procedure lblRecivedChange(Sender: TObject);
procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure Timer1Timer(Sender: TObject);
procedure meuStopClick(Sender: TObject);
procedure meuStartClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btnLoginClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure N5Click(Sender: TObject);
private
procedure savDataFromTreeNode;
procedure prcmenu(meuInfo,DBSql:string);
function CheckUser:boolean;
procedure SetCommPort(cPort,Baud:string);//配置通訊端口
procedure DrawTreeNode;
procedure DrawTreeNodeValue;
procedure UpdateMenu(Fun_ID:integer);
procedure RunOnOff(runon:boolean);
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
PwsU:array of TUnitDevice;//地址信息 動態數組使用時采用 SetLength 初始化
VAdd:array of integer;//有效地址數組
AddrCount:integer;
RegisterAddrCount:integer=0;//有效地址總數
prjInfo:TProjectInfo;//工程信息
mSynComm:TSynComm; //設備采樣同步標志體
CanOP:boolean=False;
Manger:Boolean=False;
implementation
{$R *.dfm}
procedure TfrmMain.BitBtn1Click(Sender: TObject);
begin
Panel1.Visible:=False;
if adoDBSrc.Active then
begin
adoDBSrc.Refresh;
adoDBSrc.Close;
end;
Panel4.Align:=alClient;
Panel4.Visible:=True;
end;
procedure TfrmMain.btnLogCancelClick(Sender: TObject);
begin
Panel2.Visible:=False;
Panel2.SendToBack;
CanOP:=False;
SB1.Panels[9].Text:='還未登錄......';
end;
procedure TfrmMain.btnLoginClick(Sender: TObject);
begin
if CheckUser then
begin
Panel2.Visible:=False;
Panel2.SendToBack;
Panel4.Align:=alClient;
Panel4.Visible:=True;
CanOP:=True;
SetCommPort(prjInfo.cPort,prjInfo.Baud);//配置通訊端口
SB1.Panels[9].Text:='系統待機中......';
RunOnOff(False); //未開始監控
end;
end;
procedure TfrmMain.btnToolLoginClick(Sender: TObject);
begin //
Panel2.BringToFront;
Panel2.Visible:=True;
end;
function TfrmMain.CheckUser: boolean;
var
userType:string;
ILevel:integer;
begin
Result:=False;
if adoDBSrc.Active then adoDBSrc.Close;
adoDBSrc.CommandText:='select * from user where UserName='+''''+cbxUser.Text +'''';
adoDBSrc.Active:=true;
if adoDBSrc.RecordCount=0 then
begin
showmessage(#13+#13+'------您的用戶名輸入有錯!------'+#13+#13);
adoDBSrc.Active:=False;
exit;
end;
if edtPwd.Text<>adoDBSrc.FieldByName('UserPass').AsString then
begin
showmessage('密碼輸入錯誤!');
adoDBSrc.Active:=False;
exit;
end else begin
ILevel:=adoDBSrc.FieldByName('userType').AsInteger;
UpdateMenu(ILevel);
if adoDBSrc.FieldByName('userType').AsInteger=0 then
begin
userType:='操作員';
Manger:=False;
end;
if adoDBSrc.FieldByName('userType').AsInteger>0 then
begin
userType:='管理員';
Manger:=True;
end;
SB1.Panels[3].Text:=userType;
SB1.Panels[1].Text:=adoDBSrc.FieldByName('UserName').AsString;
Result:=True;
if adoDBSrc.Active then adoDBSrc.Close;
end;
end;
procedure TfrmMain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
i:integer; // viewstring,
reStr:string;
rbuf:array[0..64] of byte;
begin
reStr:='';
move(buffer^,rbuf,bufferlength);
for i:=1 to bufferlength do
reStr:=reStr+chr(rbuf[i-1]);
reStr:=reStr;
lblRecived.Text:=reStr;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('您確認要退出本監控系統嗎?',
mtConfirmation, [mbYes, mbNo], 0, mbYes) = mrYes then
begin
CanClose:=True;
end else
CanClose:=False;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
UpdateMenu(-1);
end;
procedure TfrmMain.DrawTreeNode;
var
i,ii:integer;
Node1, Node2: TTreeNode;
nodeFg:boolean;
snode:string;
begin
with trvAllDev.Items do
begin
Clear; { remove any existing nodes }
for I := 0 to AddrCount - 1 do //設定值遍歷
begin
if PwsU[i].Enabled then
begin
if trvAllDev.Items.Count<1 then //還沒有根接點
begin
snode:='PWS'+inttostr(PwsU[i].PWSUint)+'-'+PwsU[i].PWSName;
Node1 := Add(nil,snode ); { Add a root node }
Node1.ImageIndex:=7;
snode:=PWSU[i].Name+'['+Format('%4x',[PWSU[i].Value])+']';
Node2:= AddChild(Node1,snode);
Node2.ImageIndex:=25;
//cbxSereachUnit.Items.Add(inttostr(PwsU[i].PWSUint));
end else
begin //已經有根節點了
nodeFg:=False;
Node1 := trvAllDev.Items[0];
for Ii := 0 to trvAllDev.Items.Count - 1 do
begin
Node1 := trvAllDev.Items[ii];
snode:='PWS'+inttostr(PwsU[i].PWSUint)+'-'+PwsU[i].PWSName;
if Node1.Text=snode then
begin
nodeFg:=True;//找到節點
break;
end;// //找到節點
end;//遍歷結束
if not nodeFg then //遍歷后未找到節點
begin //新建節點
snode:='PWS'+inttostr(PwsU[i].PWSUint)+'-'+PwsU[i].PWSName;
Node1 := Add(nil, snode); { Add a root node }
Node1.ImageIndex:=7;
Node1.Expanded:=True;
//cbxSereachUnit.Items.Add(inttostr(PwsU[i].PWSUint));
end;////遍歷后未找到節點
///
snode:=PWSU[i].Name+'['+Format('%4x',[PWSU[i].Value])+']';
Node2:= AddChild(Node1,snode);
Node2.ImageIndex:=25;
end;
end;//此地址有效
end;//設定值遍歷
end;//with trvAllDev.Items do
trvAllDev.FullExpand;//展開所有節點
end;
procedure TfrmMain.DrawTreeNodeValue;
var
i,ii:integer;
Node1: TTreeNode;
nodeFg:boolean;
snode:string;
begin
with trvAllDev.Items do
begin
for I := 0 to AddrCount - 1 do //設定值遍歷
begin
if PwsU[i].Enabled and (trvAllDev.Items.Count>1) then
begin
snode:='PWS'+inttostr(PwsU[i].PWSUint)+'-'+PwsU[i].PWSName;
nodeFg:=False;
for ii := 0 to trvAllDev.Items.Count - 1 do
begin
Node1 := trvAllDev.Items[ii];
snode:='PWS'+inttostr(PwsU[i].PWSUint)+'-'+PwsU[i].PWSName;
if Node1.Text=snode then
begin
nodeFg:=True;//找到節點
end;// //找到主節點
if nodeFg and (Pos(PwsU[i].Name,Node1.Text)>0) then //再找子節點
begin //
if PWSU[i].CommErr='' then
Node1.Text:=PWSU[i].Name+'['+Format('%4x',[PWSU[i].Value])+']'
else begin
Node1.Text:=PWSU[i].Name+'['+PWSU[i].CommErr+']';
PWSU[i].CommErr:='';
end;
end;
end;//遍歷結束
end;
end;
end;
end;
function DBOK:boolean;
var
reg : TRegistry;
ts : TStrings;
i : integer;
begin
Result:=False;
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;
reg.OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources',false);
ts := TStringList.Create;
reg.GetValueNames(ts);
for i := 0 to ts.Count -1 do
begin
if ts[i]='PWS AccessDB' then Result:=True;
end;
ts.Free;
reg.CloseKey;
reg.free;
if not Result then
begin
Showmessage('請您先安裝ODBC數據庫'+#13
+'名稱:PWS AccessDB'+#13+'類型:Microsoft Access Driver (*.mdb)'+#13
+'數據庫名稱:DcsPT.mdb');
frmMain.Close;
end;
end;
procedure TfrmMain.FormShow(Sender: TObject);
var
i:integer;
begin//完成用戶初始化
DBOK;
if adoDBSrc.Active then adoDBSrc.Close; //檢測用戶以便登錄
adoDBSrc.CommandText:='select * from user';
adoDBSrc.Open;
if adoDBSrc.RecordCount=0 then
lblFirstRun.Visible:=True
else
begin //
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -