mainfrm.pas

主要提供delphi 5与单片机通讯的源码及定义的通讯协议

unit mainfrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, MSCommLib_TLB, ExtCtrls,unit2, Db, DBTables, Menus;

type
  TfrmMain = class(TForm)
    memdisplay: TMemo;
    btnClose: TButton;
    MSComm1: TMSComm;
    Label1: TLabel;
    btnSend: TButton;
    edtOut: TEdit;
    Timer1: TTimer;
    Button1: TButton;
    RT: TButton;
    lblrts: TLabel;
    Button2: TButton;
    Timer2: TTimer;
    Button3: TButton;
    lblTimer2: TLabel;
    Label4: TLabel;
    edtAddr: TEdit;
    Label5: TLabel;
    edtData1: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    edtData2: TEdit;
    Label8: TLabel;
    edtData3: TEdit;
    edt: TEdit;
    Label9: TLabel;
    Table1: TTable;
    Button4: TButton;
    Button5: TButton;
    Label10: TLabel;
    Edit1: TEdit;
    Label11: TLabel;
    Edit2: TEdit;
    Label12: TLabel;
    Edit3: TEdit;
    Label13: TLabel;
    Edit4: TEdit;
    Label14: TLabel;
    Edit5: TEdit;
    Label15: TLabel;
    Edit6: TEdit;
    Button6: TButton;
    Edit7: TEdit;
    Edit8: TEdit;
    cboCOMMport: TComboBox;
    cboCOMMsetting: TComboBox;
    Label16: TLabel;
    Label17: TLabel;
    ComboBox1: TComboBox;
    MainMenu1: TMainMenu;
    COM1: TMenuItem;
    N1: TMenuItem;
    Memo1: TMemo;
    mnuStart: TMenuItem;
    mnuStop: TMenuItem;
    procedure MSComm1Comm(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RTClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuStartClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  ss:string;
  savef,readf:file of char;
  i,j:integer;
  Comth:COMTHread;
implementation




{$R *.DFM}

procedure TfrmMain.MSComm1Comm(Sender: TObject);
var
   filenrc:char;
   buffer:variant;
   sl:string;
   c:char;
   QQ:BYTE;
begin

   case MSComm1.CommEvent of
   ComEvSend:
   begin
    // while not(eof(readf))do
    // begin
       //read(readf,filenrc);
      // MSComm1.Output:=chr(13);//filenrc;
      // j:=j+1;
      // lblDisplay.Caption:=inttostr(j);
     //  if MSComm1.outbufferCount>=2 then
     //  break;
    // end;
   end;
   ComEvReceive:
   begin
   edit8.text:=mscomm1.input;
   memdisplay.lines.add(edit8.text);
   //  buffer:=MSComm1.Input;
     //sl:=buffer;
     //c:=sl[1];
     //ss:=ss+c;
     //i:=i+1;
    // ASM
    //    MOV DX,$2F8
    //    IN AL,DX
    //    MOV QQ,AL
    // END;
    // lbldisplay.Caption:=buffer;//INTTOSTR(QQ);//
     //if(c=chr(10))or(c=chr(13))then
     begin
     //  ss:=buffer;
       //lbldisplay.Caption:='cr'+Inttostr(i);
     //  memdisplay.lines.add(lbldisplay.Caption);
     end;
   end;
   end;
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  if MSComm1.PortOpen then
    MSComm1.PortOpen:=False;
    MSComm1.RTSEnable:=False;
  close;
  Timer1.Enabled:=false;
  timer2.Enabled:=false;
end;

procedure TfrmMain.btnSendClick(Sender: TObject);
var
   w,w1,w3,W5,w6,W7,W8:byte;
   sta:byte;
   Z:integer;
   data:array[1..3]of word;
   addr:word;
begin
   if MSComm1.PortOpen then
     MSComm1.PortOpen:=False;
   MSComm1.CommPort:=StrToInt(cboCommport.text);
   MSComm1.Settings:=cboCommsetting.text;
   MSComm1.InputLen:=0;
   MSComm1.InBufferCount:=0;
   MSComm1.RThreshold:=1;
   MSComm1.RTSEnable:=False;
   MSComm1.PortOpen:=true;
   Addr:=strtoint(edt.text);
   comth.Data:=Addr;
   ss:='';
   i:=0;
   j:=0;
   w1:=strToInt(edtOut.text);
   W5:=strtoint(edtAddr.text);
   w6:=strtoint(edtdata1.text);
   w7:=strtoint(edtdata2.text);
   w8:=strtoint(edtdata3.text);
   data[1]:=w6;
   data[2]:=W7;
   data[3]:=W8;
   //w:=$11;
   Z:=$AA;
   Z:=Z+W5;
   Z:=Z+W1;
   Z:=Z+data[1];
   Z:=Z+data[2];
   Z:=Z+data[3];
   W3:=Z MOD 256;
   for j:=0 to 0 do
     begin//j
       for i:=0 to 7 do
         begin //i
           case i of
              0:w:=$AA;
              1:w:=w5;
              2:w:=w1;
              3:w:=data[1];
              4:w:=data[2];
              5:w:=data[3];
              6:w:=W3;
              7:w:=$03;
           end;
           asm
             mov al,w//10101010b
             mov dx,$2f8
             out dx,al
             mov dx,$2f8+5
             in al,dx
             and al,01000000b
             mov sta,al
           end;
           while (sta<>$40) do
           begin
             asm
               mov dx,$2f8+5
               in al,dx
               and al,01000000b
               mov sta,al
           end;
         end;
         if ((i=7)and(j=0)) then
         begin
           //memdisplay.lines.Clear;
           if memdisplay.Font.Color=clRed then
              memdisplay.Font.Color:=clBlue
           else
              memdisplay.Font.Color:=clRed;

           asm
             mov dx,$2f8+4
             in al,dx
             and al,$02
             out dx,al
             mov dx,$2f8+6
             in al,dx
           end;
         end;
     // end;
   end;//i}
  end;//j

  //MSComm1.Output:=edtOut.text;
  MSComm1.RTSEnable:=True;
  if MSComm1.RTSEnable then
     lblrts.Caption:='False'
  else
     lblrts.Caption:='True';

end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  randomize;
  edtOut.Text:=inttostr(random(10000));
  btnSendClick(nil);
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  timer1.Enabled:=not timer1.Enabled;
end;

procedure TfrmMain.RTClick(Sender: TObject);
begin
     MSComm1.RTSEnable:=not MSComm1.RTSEnable;
     if MSComm1.RTSEnable then
     lblrts.Caption:='False'
     else
     lblrts.Caption:='True';
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // Button2Click(SELF);
{   if MSComm1.PortOpen then
     MSComm1.PortOpen:=False;
   MSComm1.CommPort:=StrToInt(edtCommport.text);
   MSComm1.Settings:=edtCommsetting.text;
   MSComm1.InputLen:=0;
   MSComm1.InBufferCount:=0;
   MSComm1.RThreshold:=1;
   MSComm1.RTSEnable:=True;
   MSComm1.PortOpen:=true;
     if MSComm1.RTSEnable then
     lblrts.Caption:='False'
     else
     lblrts.Caption:='True';}

end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
   Comth:=COMTHread.Create(False);
   comth.Data:=strtoint(edt.text);   
   Comth.Priority:=tpIdle;
   Comth.Resume;
   //Timer2.Enabled:=true;
   if Timer2.Enabled then
      lblTimer2.Caption:='Timer2开'
   else
      lblTimer2.caption:='Timer2关';
   
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
   if Assigned(Comth)then
   begin
     Comth.Suspend;
     Comth.Free;
   end;
end;

procedure TfrmMain.Timer2Timer(Sender: TObject);
begin
   btnSendClick(self);
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
   Timer2.Enabled:=not Timer2.Enabled;
   if Timer2.Enabled then
      lblTimer2.Caption:='Timer2开'
   else
      lblTimer2.caption:='Timer2关';
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
    memdisplay.Clear;

end;

procedure TfrmMain.Button5Click(Sender: TObject);
var
  i:integer;
begin
  with table1 do
  begin
     Close;
     Open;
     for i:=1 to RecordCount do
     begin
       delete;
       next;
     end;
     Close;  
  end;
  ShowMessage('数据清空!!!');
end;
procedure TfrmMain.Button6Click(Sender: TObject);
begin
   if MSComm1.PortOpen then
     MSComm1.PortOpen:=False;
   MSComm1.CommPort:=StrToInt(cboCommport.text);
   MSComm1.Settings:=cboCommsetting.text;
   MSComm1.InputLen:=0;
   MSComm1.InBufferCount:=0;
   MSComm1.RThreshold:=1;
   MSComm1.RTSEnable:=False;
   MSComm1.PortOpen:=true;
   if strtoint(edit7.text)<256 then   edit7.text:=inttostr((strtoint(edit7.text)+1))
   else edit7.text:='0';
   MSComm1.Output:=edit7.text;
   //msComm1.
  // edit2.text:= MSComm1.Input;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if MSComm1.PortOpen then
    MSComm1.PortOpen:=False;
end;

procedure TfrmMain.mnuStartClick(Sender: TObject);
begin
   if (MSComm1.PortOpen=False) then
   begin
   try
     MSComm1.PortOpen:=true;
   except
     Showmessage('无法打开!!!');
   end
   end;
end;

end.