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.
delphi 一个自动控制机的硅控板检测程序,用多线程和API,没有用控件,少做改动就能用 用485开发的更多相关文章
- 设计一个自动生成棋盘格子的JS小程序
<!DOCTYPE html> <html> <head> <meta charset="UTF-8"> <title> ...
- CentOS6.4关闭触控板
1. 检查是否安装xorg-x11-app; rpm -qa xorg-x11-apps 如果没有安装使用下面命令安装xorg-x11-app yum install xorg-x11-apps 2. ...
- 第一个FPGA工程----点亮开发板上的3个LED灯
第一个FPGA工程----点亮开发板上的3个LED灯 1.新建FPGA工程 开启Quartus2的画面 File--New Project Wizard..指定工程的路径与工程名 指定所使用的FPGA ...
- iOS开发过程中,触控板的使用技巧
1.在Storyboard鼠标右键可以直接拖线的,如果你用的是外接的第三方鼠标,没必要按着 control 键再用鼠标左键拖线 如果是触控板的话,双指按下去就可以直接拖线,带3Dtouch功能的触控板 ...
- synaptics驱动,插入USB鼠标禁用触控板注册表
Title:synaptics驱动,插入USB鼠标禁用触控板注册表 --2010-11-01 22:21 记得以前用过一个synaptics的驱动,自带有插入USB鼠标禁用触控板的选项的,有些没有自带 ...
- win7下一劳永逸地解决触控板禁用的问题
win7下一劳永逸地解决触控板禁用的问题--有鼠标时触摸板不再可用, 没鼠标时才启用 下载Synaptics触摸板驱动并安装(去官网或驱动之家都可以) →重启 开始→运行→框内输入 regedit 点 ...
- Ubuntu下笔记本触控板的禁启
1.命令行方式,得每次用终端输入命令行设置 sudo rmmod psmouse #禁用触摸板 sudo modprobe psmouse #启用触摸板 2.永久禁用触摸板 打开终端,然后 sudo ...
- Mac触控板常用的手势操作
Mac触控板常用的手势操作 学习了:http://topbook.cc/archives/151 一个手指直接点击,类似Windows中鼠标左键功能,同时在苹果Safari等浏览器中,这个手势还 ...
- Delphi TreeView – 自动展开树形结构
Delphi TreeView – 自动展开树形结构 当处理完TreeView控件树形结构的数据后,需要默认自动全部展开,可以用到TreeView的Expanded属性. 1 2 3 4 5 6 7 ...
随机推荐
- Mongodb在Windows 7下的安装及配置
第一步 下载MongoDB: 下载mongodb的windows版本,有32位和64位版本,根据操作系统情况下载,下载地址:http://www.mongodb.org/downloads 解压缩至指 ...
- in a devstack Openstack env, how to start a service, such as aodh-listener
in terminal, when start the service, the service will run in this terminal, and if kill this termina ...
- A session of Log Collect, Retrieval and Analysis using ELK Stack
Motivation 运维过程中对问题的定位往往需要跟踪和定位日志.分布式和弹性计算的引入,使得日志的定位和分析变得越发复杂. 本次实践主要的目的是考察现有成熟的日志收集.检索和分析方案:Kafka+ ...
- Oracle笔记3-高级查询
高级查询 1.关联查询 作用:可以跨多表查询 --查询出员工的名字和他所在部门的名字 //错误//select first_name,name from s_emp,s_dept; //错误原因:产生 ...
- 将list中的数据通过某一个字段来分类存储的实例
现有学生表 public class Student { /** * 班级id */ private String classId; /** * 学生name */ private String na ...
- thinkphp基于角色的权限控制详解
一.什么是RBAC 基于角色的访问控制(Role-Based Access Control)作为传统访问控制(自主访问,强制访问)的有前景的代替受到广泛的关注. 在RBAC中,权限与角色相关联,用户通 ...
- PHP MVC
学习一个框架之前,基本上我们都需要知道什么是mvc,即model-view-control,说白了就是数据控制以及页面的分离实现,mvc就 是这样应运而生的,mvc分为了三个层次,而且三个层次各司其职 ...
- Eclipse+Tomcat搭建https环境
一.首先在本地建立一个keystore文件 用命令:keytool -v -genkey -alias tomcat -keyalg RSA -keystore c:/tomcat.keystore ...
- oracle-trasnlate函数
1.translate函数语法 TRANSLATE(string,from_str,to_str) 2.作用有两个: 1)可以替换string中的对应字符,from_str和to_str会做字符的一一 ...
- win32程序通过LPCREATESTRUCT中的lpCreateParams传递参数给窗口过程函数
win32窗口程序中如果需要给窗口过程函数传递自定义参数,可以通过LPCREATESTRUCT结构体中的lpCreateParams进行传递. 创建窗口实例函数: m_hWnd = CreateWin ...