• delphi 一个自动控制机的硅控板检测程序,用多线程和API,没有用控件,少做改动就能用 用485开发



    一个自动控制机的硅控板检测程序,用多线程和API,没有用控件,少做改动就能用
    Unit CommThread;

    Interface

    Uses
      Windows, Classes, SysUtils, Graphics, Controls, Forms,
      Dialogs, ComCtrls, ExtCtrls;
    Type
      TThreadParam = Record
        SusPended: Boolean;
        BaulSpeed: integer;
        Port: Byte;
        Parity: Boolean;
        StopBit: byte;
        StartBit: Byte;
        SB: TStatusBar;
        LEDs: Array[0..24] Of TShape;
      End;

    Type
      TReadThread = Class(TThread)
      Private
        { Private declarations }
        hComm: THandle;
        Port: integer;
        FErr: Boolean;
        FPortDescription: String;
        FShape: Array[0..24] Of TShape;
        FSB: TStatusBar;
        cc: TCOMMCONFIG;
        Data: String;
        Procedure ReadPort; //读取串行端口数据
        Procedure UpdateUI;
      Protected
        Procedure Execute; Override;
      Public
        Constructor Create(ThdPrm: TThreadParam);
      End;

    Implementation
    //uses Unit1; // 声明引用Unit1,必须放在implementation区段

    Constructor TReadThread.Create(ThdPrm: TThreadParam);
    Var
      i: integer;
    Begin
      Port := thdprm.Port;
      FSB := thdprm.SB;
      For i := 0 To 24 Do
      Begin
        FShape[i] := thdPrm.LEDs[i];
      End;
      FreeOnTerminate := True;
      Inherited Create(ThdPrm.SusPended);
    End;

    Procedure TReadThread.Execute;
    Var
      PortToOpen: String;
    Begin
      PortToOpen := 'COM' + inttostr(Port); // 选择所要打开的COM
      hComm := CreateFile(PChar(PortToOpen), GENERIC_READ Or GENERIC_WRITE,
        0, Nil, OPEN_EXISTING, 0, 0); // 打开COM
      If (hComm = INVALID_HANDLE_VALUE) Then
      Begin //如果COM 未打开
        FErr := True;
        FPortDescription := '打开端口错误!';
      End
      Else
      Begin
        FErr := False;
        FPortDescription := '打开端口成功';
        GetCommState(hComm, cc.dcb); // 得知目前COM 的状态
        cc.dcb.BaudRate := CBR_9600; // 设置波特率为9600
        cc.dcb.ByteSize := 8; //字节为 8 bit
        cc.dcb.Parity := NOPARITY; // Parity 为 None
        cc.dcb.StopBits := ONESTOPBIT; // 1 个Stop bit
        If Not SetCommState(hComm, cc.dcb) Then
        Begin // 设置COM 的状态
          Ferr := True;
          FPortDescription := FPortDescription + ',设置错误!';
          CloseHandle(hComm); //关闭通信端口
        End
        Else
        Begin
          FErr := False;
          FPortDescription := FPortDescription + ',设置成功';
          While Not Terminated Do
          Begin
            Synchronize(ReadPort); //刚才所定义的读取数据函数
          End;
          Synchronize(UpdateUI);
        End;
      End;

    End;


    Procedure TReadThread.ReadPort;
    Var
      i: integer;
      inbuff: Array[0..29] Of Char;
      nBytesRead, dwEvent, dwError: LongWORD;
      cs: TCOMSTAT;
      Rights, Emptys, Errs: integer;
    Const
      RightColor = clBlue;
      ErrorColor = clRed;
      EmptyColor = clWhite;
    Begin
      Rights := 0;
      Emptys := 0;
      Errs := 0;
      If (hComm = INVALID_HANDLE_VALUE) Then
      Begin
        Fsb.Panels[3].Text := FPortDescription;
        Terminate; //先判断是否已打开通信端口
        Exit;
      End
      Else
      Begin
        Fsb.Panels[3].Text := FPortDescription;
        ClearCommError(hComm, dwError, @CS); //取得状态
        ReadFile(hComm, inbuff, cs.cbInQue, nBytesRead, Nil); // 接收COM 的数据
        //串行在读取数据后,会自动将缓冲区中已被读取的数据清除掉
        If cs.cbInQue = 0 Then exit;
        // 数据是否大于我们所准备的Buffer
        If cs.cbInQue <> sizeof(inbuff) Then
        Begin
          PurgeComm(hComm, PURGE_RXCLEAR); // 清除COM 数据
          exit;
        End;
        Data := Copy(inbuff, 1, cs.cbInQue); //取出数据
        For i := 1 To 25 Do
        Begin
          If (UpperCase(Data[i]) = 'Y') Then
          Begin
            FShape[i].Brush.Color := RightColor;
            Rights := Rights + 1;
          End
          Else
            If (UpperCase(Data[i]) = 'N') Then
            Begin
              FShape[i].Brush.Color := EmptyColor;
              Emptys := Emptys + 1;
            End
            Else
              If (UpperCase(Data[i]) = 'E') Then
              Begin
                FShape[i].Brush.Color := ErrorColor;
                Errs := Errs + 1;
              End;
        End;
        Fsb.Panels[0].Text := '正确:' + IntTostr(Rights);
        fsb.Panels[1].Text := '空槽:' + IntTostr(Emptys);
        fsb.Panels[2].Text := '错误:' + IntTostr(Errs);
        Fsb.Panels[3].Text := FPortDescription;
        Fsb.Panels[4].Text := '数据:' + Data;
      End;
    End;

    Procedure TReadThread.UpdateUI;
    Begin
      Fsb.Panels[0].Text := '正确:' + IntTostr(0);
      fsb.Panels[1].Text := '空槽:' + IntTostr(0);
      fsb.Panels[2].Text := '错误:' + IntTostr(0);
      Fsb.Panels[3].Text := '';
      Fsb.Panels[4].Text := '数据:' + Data;
    End;

    End.

  • 相关阅读:
    .net 5中配置Quartz集群
    .net 5中使用Quartz构建单机版定时任务器
    error: src refspec future does not match any
    .net core通过jenkins + gogs + docker实现自动化部署
    Format of the initialization string does not conform to specification starting at index 75
    .net core中解决vue使用axios请求接口时未携带cookie信息的处理
    .net core在Docker->Linux及Window平台环境变量的获取的兼容
    centos7.x中安装mysql
    使用docker部署.net core3.1时的Dockerfile写法(持续补充)
    ARTS-WEEK-019
  • 原文地址:https://www.cnblogs.com/zhangzhifeng/p/6207136.html
Copyright © 2020-2023  润新知