unit1.pas

delphi用MSComm进行串口通讯

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MSCommLib_TLB, ComCtrls, Buttons, ExtCtrls;

type
  TF_main = class(TForm)
    MSCom: TMSComm;
    BT_OpenAUTO: TButton;
    bt_ClosAuto: TButton;
    Memo1: TMemo;
    BT_Step: TButton;
    StatusBar1: TStatusBar;
    Image1: TImage;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    LbRef: TLabel;
    Button2: TButton;
    lb_time: TLabel;
    Timer2: TTimer;
    Label1: TLabel;
    procedure BT_OpenAUTOClick(Sender: TObject);
    procedure bt_ClosAutoClick(Sender: TObject);
    procedure MSComComm(Sender: TObject);
    procedure BT_StepClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StatusBar1DblClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type//For scanline simplification
  TRGBArray = ARRAY[0..327] OF TRGBTriple;
  pRGBArray = ^TRGBArray;
var
F_main: TF_main;
CommDataCount:integer;
senddata:array[1..10] of char;
reData:Variant;
sendstr:string;
restr:string;
tempchar:char;
tempSTR:char;
RecData:array[1..6000] of integer;      //串口接受的数据序列
ReciveCurPoint:integer;//串口当前接受本帧的数据顺序

ReciveCurPointTimer:integer;//串口当前接受本帧的数据顺序

ReciveDataToMem:string;

tempi,tempj,tempm,tempn:integer;
function MakeStr(const Args: array of const): string;

implementation

{$R *.dfm}
function MakeStr(const Args: array of const): string;

const
  BoolChars: array[Boolean] of Char = ('F', 'T');
var
  I: Integer;
begin
  Result := '';
  for I := 0 to High(Args) do
    with Args[I] do
      case VType of
        vtInteger:    Result := Result + IntToStr(VInteger);
        vtBoolean:    Result := Result + BoolChars[VBoolean];
        vtChar:       Result := Result + VChar;
        vtExtended:   Result := Result + FloatToStr(VExtended^);

        vtString:     Result := Result + VString^;
        vtPChar:      Result := Result + VPChar;
        vtObject:     Result := Result + VObject.ClassName;
        vtClass:      Result := Result + VClass.ClassName;
        vtAnsiString: Result := Result + string(VAnsiString);
        vtCurrency:   Result := Result + CurrToStr(VCurrency^);
        vtVariant:    Result := Result + string(VVariant^);
        vtInt64:      Result := Result + IntToStr(VInt64^);

    end;
end;

procedure TF_main.BT_OpenAUTOClick(Sender: TObject);
var tempC : char;
begin
tempchar:=char($01);
sendstr:='';
mscom.output:=sendstr+tempchar;
end;

procedure TF_main.bt_ClosAutoClick(Sender: TObject);
begin
tempchar:=char($02);
sendstr:='';
mscom.output:=sendstr+tempchar;
end;

procedure TF_main.MSComComm(Sender: TObject);
var a:Word;
Vbuf:Variant;
//tempdata :Byts
tempdata : array of byte;
tempd:byte;
i:integer;
temps:string;
tempBool:boolean;
begin
if mscom.commEvent =comEvReceive then
        begin
        Vbuf:=mscom.Input;
        //MSCom.InBufferCount := 0; //清空读取缓冲区
        tempBool:=VarIsNumeric(Vbuf);
for i:=0 to VarArrayHighBound(Vbuf,1) do
begin
        tempd:=Vbuf[i];
//        memo2.Lines.Add(intTostr(tempd));
        tempdata:=Vbuf;
        RecData[ReciveCurPoint]:=tempd;
        if Trunc(ReciveCurPoint/10)=ReciveCurPoint/10 then           //整行
                begin
                memo1.Lines.Add(ReciveDataToMem+IntToHex(tempd,2));
                ReciveDataToMem:='';
                end
        else
                ReciveDataToMem:=ReciveDataToMem+IntToHex(tempd,2)+' ';
        ReciveCurPoint:=ReciveCurPoint+1;
        CommDataCount:=CommDataCount+1;
        StatusBar1.Panels[0].Text :='接收：'+intTostr(CommDataCount);
end;
        end

end;

procedure TF_main.BT_StepClick(Sender: TObject);
begin
tempchar:=chr($03); //要发送的数据

sendstr:='';
sendstr:=sendstr + tempchar;
mscom.output:=sendstr;

//MSCom.Output :=sendstr;
//F_main.MSCom.writecommdata(@sbuf[i],1)
end;

procedure TF_main.FormCreate(Sender: TObject);
begin
CommDataCount:=0;

MSCom.CommPort := 1; //指定端口
MSCom.Settings := '9600,N,8,1'; //其它参数
MSCom.InBufferSize := 1024; //接收缓冲区
//MSCom.InBufferSize := 1; //接收缓冲区
MSCom.OutBufferSize := 512; //发送缓冲区
MSCom.InputMode := comInputModeBinary; //接收模式
MSCom.InputLen := 0; //一次读取所有数据
MSCom.SThreshold := 1; //一次发送所有数据
MSCom.InBufferCount := 0; //清空读取缓冲区
MSCom.OutBufferCount := 0; //清空发送缓冲区
//MSCom.PortOpen:=true; //打开端口
MSCom.RThreshold := 1; //设置接收多少字节开产生oncomm事件  
ReciveDataToMem:='';
end;

procedure TF_main.StatusBar1DblClick(Sender: TObject);
begin
CommDataCount:=0;
memo1.Lines.Clear;
F_main.StatusBar1.Refresh;
end;

procedure TF_main.BitBtn1Click(Sender: TObject);
var     BMPCur : TBitmap; // Store Image for 'reset'
        O, T, C, B : pRGBArray;  // Scanlines
     i,j,m,n:integer;
begin
//image1.Picture.
  BMPCur := TBitmap.Create;  // Copy image to 24-bit bitmap
  BMPCur.Width:=image1.Width;  // Add a box around the outside...
  BMPCur.Height:=image1.Height;
  BMPCur.PixelFormat := pf24bit;
  for j:=1 to  round(ReciveCurPoint/10) do
    begin
    T:=BMPCur.ScanLine[3*j-2];
    for i:=1 to 10 do
        begin
        T[3*i-2].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i-2].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i-2].rgbtRed:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtRed:=RecData[(j-1)*10+i];
        T[3*i].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i].rgbtRed:=RecData[(j-1)*10+i];
        end;
    T:=BMPCur.ScanLine[3*j-1];
    for i:=1 to 10 do
        begin
        T[3*i-2].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i-2].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i-2].rgbtRed:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtRed:=RecData[(j-1)*10+i];
        T[3*i].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i].rgbtRed:=RecData[(j-1)*10+i];
        end;
    T:=BMPCur.ScanLine[3*j];
    for i:=1 to 10 do
        begin
        T[3*i-2].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i-2].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i-2].rgbtRed:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i-1].rgbtRed:=RecData[(j-1)*10+i];
        T[3*i].rgbtBlue:=RecData[(j-1)*10+i];
        T[3*i].rgbtGreen:=RecData[(j-1)*10+i];
        T[3*i].rgbtRed:=RecData[(j-1)*10+i];
        end;
    end;
  Image1.Picture.Assign(BMPCur);
  Image1.Refresh;
end;

procedure TF_main.Timer1Timer(Sender: TObject);
var temp,i : integer;
begin

if ReciveCurPointTimer=ReciveCurPoint then
   begin
   if ReciveCurPoint<>1 then
        begin
        BitBtn1Click(self);
        if memo1.Lines.Count>1000 then
            for i:=1 to memo1.Lines.Count-1000 do
                begin
                //memo1.Lines.Clear;
                memo1.Lines.Delete(0);
                end;
        ReciveCurPoint:=1;
        ReciveDataToMem:='';
        temp:=strTOint(LBRef.Caption);
        temp:=temp+1;
       if temp=10 then temp:=0;
        LBRef.Caption :=intTostr(temp);
        memo1.Lines.Add(' ')
        end;
   end
else
    ReciveCurPointTimer:=ReciveCurPoint;
end;

procedure TF_main.FormShow(Sender: TObject);
begin
        try
        MSCom.PortOpen:=true;
        bt_ClosAuto.Enabled :=true;
        bt_openAuto.Enabled :=true;
        bt_Step.Enabled :=true;
        except
        application.MessageBox('错误','端口未能打开',0);
        end;

end;

procedure TF_main.Button2Click(Sender: TObject);
begin
MSCom.InBufferCount := 0; //清空读取缓冲区
tempchar:=chr($04); //要发送的数据 ，04表示请求C51连续向上发从0到200测试

sendstr:='';
sendstr:=sendstr + tempchar;
mscom.output:=sendstr;

end;

procedure TF_main.Timer2Timer(Sender: TObject);
var temp : integer;
begin
temp:=strToint(lb_time.Caption)+1;
if temp>=100 then
        lb_time.Caption :='0'
else
        lb_time.Caption :=intTostr(temp);
end;

end.