main.pas

给出一个工业ＰＬＣ联网监控的例子

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,  //SaveDataTime1, SaveDataTime2, SaveDataTime3, DefaultWindow, ComPort, BaundRate
		sTime1,sTime2,sTime3,
		cPort,
		Baud:string;
		defWin:integer;
	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;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    SB1: TStatusBar;
    imgList: TImageList;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    RzSpacer1: TRzSpacer;
    RzToolButton4: TRzToolButton;
    RzToolButton5: TRzToolButton;
    RzSpacer2: TRzSpacer;
    RzToolButton7: TRzToolButton;
    RzToolButton8: TRzToolButton;
    RzToolButton9: TRzToolButton;
    RzSpacer3: TRzSpacer;
    RzToolButton10: 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;
    Panel5: TPanel;
    DBGrid1: TDBGrid;
    GroupBox4: TGroupBox;
    cbxSereachUnit: TComboBox;
    Label8: TLabel;
    Label12: TLabel;
    ddtpSereachTime: TDateTimePicker;
    cbxSereach: TCheckBox;
    btnSereach: TButton;
    Button2: TButton;
    Image2: TImage;
    procedure btnSereachClick(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure N21Click(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 prcmenu(meuInfo,DBSql:string);
		function  CheckUser:boolean;
		procedure SetCommPort(cPort,Baud:string);//配置通讯端口
		procedure DrawTreeNode;
		{ 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;   //设备采样同步标志体

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;
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 Access DB' then Result:=True;
	end;
	ts.Free;
	reg.CloseKey;
	reg.free;
end;

procedure TfrmMain.btnLoginClick(Sender: TObject);
begin
	if CheckUser then
	begin
		Panel2.Visible:=False;
		Panel4.Align:=alClient;
		Panel4.Visible:=True;
		SetCommPort(prjInfo.cPort,prjInfo.Baud);//配置通讯端口
		SB1.Panels[9].Text:='系统待机中......';
	end;
end;

function TfrmMain.CheckUser: boolean;
var
	userType:string;
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
			if adoDBSrc.FieldByName('userType').AsInteger=0 then
				userType:='操作员';
			if adoDBSrc.FieldByName('userType').AsInteger=1 then
				userType:='管理员';
			if adoDBSrc.FieldByName('userType').AsInteger=2 then
				userType:='系统管理员';
			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.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:=14;
					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])+']';