一个自动控制机的硅控板检测程序,用多线程和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.

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

  1. 设计一个自动生成棋盘格子的JS小程序

    <!DOCTYPE html> <html> <head> <meta charset="UTF-8"> <title> ...

  2. CentOS6.4关闭触控板

    1. 检查是否安装xorg-x11-app; rpm -qa xorg-x11-apps 如果没有安装使用下面命令安装xorg-x11-app yum install xorg-x11-apps 2. ...

  3. 第一个FPGA工程----点亮开发板上的3个LED灯

    第一个FPGA工程----点亮开发板上的3个LED灯 1.新建FPGA工程 开启Quartus2的画面 File--New Project Wizard..指定工程的路径与工程名 指定所使用的FPGA ...

  4. iOS开发过程中,触控板的使用技巧

    1.在Storyboard鼠标右键可以直接拖线的,如果你用的是外接的第三方鼠标,没必要按着 control 键再用鼠标左键拖线 如果是触控板的话,双指按下去就可以直接拖线,带3Dtouch功能的触控板 ...

  5. synaptics驱动,插入USB鼠标禁用触控板注册表

    Title:synaptics驱动,插入USB鼠标禁用触控板注册表 --2010-11-01 22:21 记得以前用过一个synaptics的驱动,自带有插入USB鼠标禁用触控板的选项的,有些没有自带 ...

  6. win7下一劳永逸地解决触控板禁用的问题

    win7下一劳永逸地解决触控板禁用的问题--有鼠标时触摸板不再可用, 没鼠标时才启用 下载Synaptics触摸板驱动并安装(去官网或驱动之家都可以) →重启 开始→运行→框内输入 regedit 点 ...

  7. Ubuntu下笔记本触控板的禁启

    1.命令行方式,得每次用终端输入命令行设置 sudo rmmod psmouse #禁用触摸板 sudo modprobe psmouse #启用触摸板 2.永久禁用触摸板 打开终端,然后 sudo ...

  8. ​Mac触控板常用的手势操作

    ​Mac触控板常用的手势操作 学习了:http://topbook.cc/archives/151   一个手指直接点击,类似Windows中鼠标左键功能,同时在苹果Safari等浏览器中,这个手势还 ...

  9. Delphi TreeView – 自动展开树形结构

    Delphi TreeView – 自动展开树形结构 当处理完TreeView控件树形结构的数据后,需要默认自动全部展开,可以用到TreeView的Expanded属性. 1 2 3 4 5 6 7 ...

随机推荐

  1. Node调用C++(dll)

    最近开始搞毕设了,打算用自己拿手的js来搞,但是仿佛入坑了,Node还不是很熟.总之,兵来将挡,水来土掩嘛,带着问题学习才是最高效的. 折腾1:Node 调用 C++ 刚开始,虽然我老师把dll文件给 ...

  2. Add and Search Word

    Trie 树的一个应用 Design a data structure that supports the following two operations: void addWord(word) b ...

  3. 解决织梦DEDEcms指定arclist的特定ID排序的方法

    转载网址:http://blog.hrseo.net/xuexi/184.html 替换/include/taglib/arclist.lib.php这个文件,下载链接: http://pan.bai ...

  4. Struts2学习笔记

    一.struts2的工作原理 上图为struts整体结构. 1.客户端初始化一个指向servlet的请求: 2.请求通过一系列过滤器(其中的ActionContextCleanUp为可选过滤器,对st ...

  5. Spring可以将简单的组件配置

    这次听了老师的课程,觉得还是需要更加集中的去把各种题进行一个分类吧,然后有针对的去准备,虽然据说这一块在面试中也不容易考到,但是毕竟是难点,还是需要好好准备一下的.因为在dp这个方面,我算是一个比较新 ...

  6. 最小生成树——prim算法

    prim算法是选取任意一个顶点作为树的一个节点,然后贪心的选取离这棵树最近的点,直到连上所有的点并且不够成环,它的时间复杂度为o(v^2) #include<iostream>#inclu ...

  7. http权威指南

    我的plan :one day two hour,one week done!!!争取不超过2周看完

  8. 11.12模拟考T2(GCD)

    2.梅花桩   (blossom.pas/c/cpp) [问题描述] 小x在练习一门轻功,这门轻功是在梅花桩上跳来跳去,这门轻功是严格按照直线从一个梅花桩直接跳到另外一个梅花桩上.因为小x有恐高症,所 ...

  9. UVA 1151

    /* 题意:有n个点,现在需要联通所有,有q种套餐可以选择, 当然套餐之外也可以自己添加边,意为达到最短距离. 题意很明显,不知道需要使用哪一种套餐, 那么需要枚举每一种套餐的情况. 然后再进行对比. ...

  10. WIN7 WIN8 WIN10你们的WmiPrvSE.exe系统占用资源厉害吗?

    大家一起来做个实验吧.把你的支付宝安全控件和支付宝数字证书两个东东都卸掉.试试看电脑是否年轻几岁? 出处:百度贴吧原帖