⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tpwin.pas

📁 Monitor.dfm Meter.dpr pasMain.pas
💻 PAS
📖 第 1 页 / 共 2 页
字号:
           end
     else
          if sz = '2' then
           begin
           cmbport.itemindex := 1;
           nCOm := 2;
           end
          else
           begin
           cmbport.itemindex := 2;
           ncom := 3;
          end;
      szMid:= szInitMid;
      txtMid.text := szMid;    
      szDb1:= szInitDb1;
      txtDB1.text := szDB1;
      szRDb1:=szInitRdb1;
      szDb2:=szInitDb2;
      txtDB2.text := szDB2;
      szRdb2:=szInitRdb2;
      szMsg := szInitMsg;
      txtMsg.text := szMsg;
      szRmsg:=szMess_Recv;
      cmbSend.Enabled := True;
      cmbCheck.Enabled := True;
      cmbReceive.Enabled := False;
      cmdOpenMidFile.Enabled := True;
      txtMid.Enabled := True;
      szOnlineno := txtOnlineno.text;
      szNoFile := txtNoFile.text;
      nSingle := opComstatus.itemindex;
      nEndOff := opComMode.itemindex;
      szmacNo := szInitMach_id;
      OPCOMMODEClick(opcommode);
end;

procedure TFrmtpwin.CMDOPENNOFILEClick(Sender: TObject);
begin
     opendialog1.Filter := 'DAT文件(*.DAT)|*.dat';
     if opendialog1.execute then
          BEGIN
               TXTNOFILE.text:=opendialog1.FileName;
               SZNOFILE := TXTNOFILE.TEXT;
          END;
end;

procedure TFrmtpwin.CMBRECEIVEClick(Sender: TObject);
VAR
NRESULT : INTEGER;
SZSTRING:STRING;
begin
if frmmain.mscomm.portopen=true then frmmain.mscomm.portopen:=false;
nResult := wReceive(szRDB1, szRDB2, szRMsg, szMacNo, nSingle, nBaud, nCOM, nEndOff, 1);
if nResult <> 0 THEN
   BEGIN
        STR(nResult,SZSTRING);
       	MessageDLG('不能接收数据'+ chr(13) + '错误号:'+SZSTRING,
        MTINFORMATION,[MBOK],0);
   END
else
	MessageDLG('Receive success!',MTINFORMATION,[MBOK],0);
End;

procedure TFrmtpwin.CMBBAUDChange(Sender: TObject);
begin
 case cmbBaud.itemindex of  
      0:nBaud := 38400;
      1:nbaud := 19200;
      2:nBaud := 9600;
  end;    
end;

procedure TFrmtpwin.CMBPORTChange(Sender: TObject);
begin
     case cmbport.ItemIndex of
     0:ncom := 1;
     1:ncom := 2;
     2:ncom := 3;
     3:ncom := 4;
     end;
end;

procedure TFrmtpwin.OPCOMMODEClick(Sender: TObject);
begin
   nSingle := opCommode.itemindex;
if nSingle = 0 then
   begin
	txtOnlineno.Enabled := True;
	cmdOpenOnlineFile.Enabled := True;
	cmbOnlineno.Enabled := True;
	cmbRec_no.Enabled := False;
   end
else
    begin
	txtOnlineno.Enabled := False;
	cmdOpenOnlineFile.Enabled := False;
	cmbOnlineno.Enabled := False;
	cmbRec_no.Enabled := True;
    end;    
if nSingle <> 1 then
	cmbRegister.Enabled := False
else
	cmbRegister.Enabled := True;

if nSingle = 2 then
   begin
	opComstatus.Enabled := False;
	opComstatus.controls[0].Enabled := False;
	opComstatus.controls[1].Enabled := False;
	opComstatus.controls[2].Enabled := False;
	txtMacNo.Enabled := False;
   end        
else
   begin
   	opComstatus.Enabled := True;
	opComstatus.controls[0].Enabled := True;
	opComstatus.controls[1].Enabled := True;
	opComstatus.controls[2].Enabled := True;
	txtMacNo.Enabled := True
   end;     
end;

procedure TFrmtpwin.OPCOMSTATUSClick(Sender: TObject);
begin
nEndOff := opComstatus.itemindex ;
end;

procedure TFrmtpwin.CMBCHECKClick(Sender: TObject);
var
nResult:integer;
hfile:integer;
sz:string;
begin
nResult := wCheck(szMid, szMsg, szDB1, szDB2, szMacNo, 1);
if nResult <> 0 then
	MessageDlg('Fatal Error, can''t check file(s).' + chr(13) + 'Error no:'+inttostr(nResult),mtinformation,[mbok],0)
else
	if fileexists(szWorkPath + '\takemem.cbq') then
           begin
		hfile := fileopen(szWorkPath + '\takemem.cbq',fmOpenWrite);
		fileread(hfile,sz,256);
		fileclose(hfile);
		MessageDlg('Check successfully!' + chr(13) + sz, mtInformation,[mbok],0);
           end     
	else
            begin
		sz := 'File TAKEMEM.CBQ not exist!';
		Messagedlg('Check failure!' + chr(13) + sz, mtInformation,[mbok],0);
            end;    

end;

procedure TFrmtpwin.CMBONLINENOClick(Sender: TObject);
var 
nResult:integer;
begin
nResult := wOnlineno(nBaud, nCOM, szOnlineno, 1);
if nResult <> 0 then
	MessageDlg('Fatal Error, can''t get online info(s).' + chr(13) + 'Error no:'+inttostr(nResult), mtinformation,[mbok],0)
else
	MessageDlg('Getting online info success!', mtinformation, [mbok],0);

(*use &szOnlineno
brow
use*)
end;

procedure TFrmtpwin.CMBREC_NOClick(Sender: TObject);
var
nResult:integer;
 F: TextFile;
begin
nResult := Rece_no(szNoFile, nBaud, nCOM, 1);
if nResult <> 0 then
	MessageDlg('Fatal Error, can''t get machine info(s).'+chr(13)+ 'Error no:'+inttostr(nResult),mtinformation, [mbok],0)
else
       begin
	Messagedlg('Getting machine number success!', mtInformation,[mbok],0);
	if fileexists(szNoFile) then
           begin
	    AssignFile(F,szNoFile);
            reset(f);
            readLn(f,szMacNo);
            txtMacNo.text := szMacNo ;
	    closefile(f);        
           end     
	else
		MessageDlg('Can''t find machine number file: ' + szNoFile+' !', mtinformation,[mbok],0);
      end;          
end;

procedure TFrmtpwin.CMBREGISTERClick(Sender: TObject);
var
nResult:integer;
begin
nResult := wRegister(nBaud, nCOM);
if nResult <> 0 then
	MessageDlg('Can''t register the machine, check it!', mtinformation,[mbok],0)
else
	MessageDlg('Register success!',mtinformation,[mbok],0);
end;

procedure TFrmtpwin.TXTMIDChange(Sender: TObject);
begin
     szmid := txtmid.text
end;

procedure TFrmtpwin.TXTDB1Change(Sender: TObject);
begin
     if tabcontrol1.TabIndex = 0 then
        szDb1 := txtdb1.text
     else
         szRdb1 := txtdb1.text;   
end;

procedure TFrmtpwin.TXTDB2Change(Sender: TObject);
begin
     if  tabcontrol1.tabindex = 0 then
         szDb2 := txtDb2.text
     else        
         szRdb2 := txtDb2.text;

end;

procedure TFrmtpwin.TXTMSGChange(Sender: TObject);
begin
     if tabcontrol1.TabIndex = 0 then
        szMsg := txtMsg.text
     else
        szRMsg := txtmsg.text;
                    
end;

procedure TFrmtpwin.TXTONLINENOChange(Sender: TObject);
begin
 szOnlineno := txtOnlineno.text;
end;

procedure TFrmtpwin.TXTNOFILEChange(Sender: TObject);
begin
szNoFile := txtNoFile.text;
end;

procedure TFrmtpwin.TXTMACNOChange(Sender: TObject);
begin
szMacNo := txtMacNo.text;
end;

procedure TFrmtpwin.FormDestroy(Sender: TObject);
begin
  
  SZiNITBAUD := pchar(INTTOSTR(NBAUD));
  SZINITPORT := pchar(INTTOSTR(NCOM));
  SZINITDB1 := pchar(SZDB1);
  SZINITDB2 := pchar(SZDB2);
  SZINITMID := pchar(SZMID);
  SZINITMSG := pchar(SZMSG);
  SZINITMACH_ID := pchar(SZMACNO);
  szInitRDb1:=Pchar(szRdb1);
  szInitRDb2:=Pchar(szRdb2);
  szMess_Recv:=Pchar(szRMsg);
  writeprivateprofilestring('setup','speed',szInitBaud,'tpwin.ini');
  writeprivateprofilestring('setup','port',szInitPort,'tpwin.ini');
  writeprivateprofilestring('setup','DBF_SendA',szInitDb1,'tpwin.ini');
  writeprivateprofilestring('setup','DBF_SendB',szInitDb2,'tpwin.ini');
  writeprivateprofilestring('setup','Mid',szInitMid,'tpwin.ini');
  writeprivateprofilestring('setup','Mess_Send',szInitMsg,'tpwin.ini');
  writeprivateprofilestring('setup','Mach_id',szInitMach_Id,'tpwin.ini');
  writeprivateprofilestring('setup','DBF_RecvA',szInitRDb1,'tpwin.ini');  
  writeprivateprofilestring('setup','DBF_RecvB',szInitRDb2,'tpwin.ini');
  writeprivateprofilestring('setup','Mess_Recv',szMess_Recv,'tpwin.ini');  
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -