📄 main.pas.~122~
字号:
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, // 保存时间长度间隔多少分钟 最短５分钟
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('%d',[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 + -