unit U_Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,strUtils, iniFiles, Buttons;
type
TReadThread = class(TThread)
private
protected
procedure Execute; override;
end;
type
TFm_Main = class(TForm)
Panel1: TPanel;
Ed_Ch1: TEdit;
Label1: TLabel;
Ed_Ch2: TEdit;
Label2: TLabel;
Tm_Reg: TTimer;
Panel2: TPanel;
SpeedButton1: TSpeedButton;
Tm_Read: TTimer;
ComboBox1: TComboBox;
Label8: TLabel;
Label7: TLabel;
Label6: TLabel;
Bevel1: TBevel;
Label9: TLabel;
Tm_Screen: TTimer;
Label10: TLabel;
Ed_Ch3: TEdit;
Bevel2: TBevel;
Bevel3: TBevel;
SpeedButton2: TSpeedButton;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Ed_Ch4: TEdit;
Ed_Ch5: TEdit;
Ed_Ch6: TEdit;
procedure FormCreate(Sender: TObject);
procedure Tm_RegTimer(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Tm_ReadTimer(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Tm_ScreenTimer(Sender: TObject);
private
public
end;
const
Count_Ch=6;
Time_delay=50;
var
Fm_Main: TFm_Main;
DCB : TDCB;
CT: TCommTimeouts;
hPort : THandle;
RegFile:TFileStream;
ReadThread:TReadThread;
NamePatch:String;
ByteWritten,ByteReaded:dword;
RegStart:boolean=false;
ReadByte:array [0..255] of char;
Value:array[0..16] of string;
RegFileName,StrFile:string;
str,s:string;
tick:integer=0;
tick_reg:integer=0;
INI:TIniFile;
Path:string;
RSPort:string;
Cycle:integer;
implementation
{$R *.dfm}
function parse_date_time(str:string):string;
begin
if(length(str) = 1) then
result:='0'+ str
else
result:=str;
end;
function DeleteLineBreaks(const S: string): string;
var
Source, SourceEnd: PChar;
begin
Source := Pointer(S);
SourceEnd := Source + Length(S);
while Source < SourceEnd do
begin
case Source^ of
#10: Source^ :=#32;
#13: Source^ :=#32;
end;
Inc(Source);
end;
Result := S;
end;
Function DeleteProbel(s: string): string;
var
i, n, L : integer;
st:string;
begin
for i := 1 To length(s) do
begin
n:=pos(' ',s);
If n<>0 Then
begin
Delete(s,n,2);
n:=0;
end;
n:=pos(' ',s);
If n<>0 Then
begin
Delete(s,n,1);
n:=0;
end;
end;
Result:=s;
end;
procedure StartRead;
begin
ReadThread:=TReadThread.Create(True);
with ReadThread do begin
Priority:=tpNormal;
FreeOnTerminate:=True;
Resume;
end
end;
Procedure Create_RegFile;
begin
RegFileName:='Micron_'+datetostr(now)+'.csv';
if FileExists(RegFileName) Then
begin
RegFile := TFileStream.Create(RegFileName,fmOpenWrite or fmShareDenyRead);
RegFile.Seek(0,soFromEnd);
end
else
begin
RegFile:=TFileStream.Create(RegFileName, fmCreate or fmOpenReadWrite or fmShareDenyNone);
StrFile:=StrFile+'Время;SW;LW;RTO;WT;Alarm;Dtemp;';
StrFile:= StrFile +#13+#10;
RegFile.Write(PChar(StrFile)^, Length(StrFile));
end;
end;
Procedure Write_RegFile;
var
str:string;
i:integer;
Min, Hour, Sec, Msec: word;
begin
DecodeTime(Now, Hour, Min, Sec,Msec);
StrFile:='';
StrFile:=StrFile+parse_date_time(IntToStr(Hour))+':'+parse_date_time(IntToStr(Min))+':'+parse_date_time(IntToStr(Sec))+'.'+parse_date_time(IntToStr(Msec))+';'
+Value[1]+';'+Value[2]+';'+Value[3]+';'+Value[4]+';'+Value[5]+';'+Value[6]+';';
StrFile:= StrFile +#13;
RegFile.Write(PChar(StrFile)^, Length(StrFile));
end;
procedure clr_com;
begin
PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
str:='';
s:='';
end;
Function Init_Device():boolean;
begin
NamePatch:=ExtractFilePath('..\');
hPort := CreateFile(PChar(RSPort),GENERIC_READ + GENERIC_WRITE,0, nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hPort = INVALID_HANDLE_VALUE then
begin
exit;
end;
if not GetCommState(hPort, DCB) then ShowMessage('Ошибка чтения настроек порта') else
begin
DCB.BaudRate :=CBR_19200;
DCB.ByteSize :=8;
DCB.StopBits :=ONESTOPBIT;
DCB.Parity :=0;
if not SetCommState(hPort, DCB) then ShowMessage('Ошибка записи настроек порта');
CT.ReadTotalTimeoutConstant:=80;
CT.ReadIntervalTimeout := 80;
CT.ReadTotalTimeoutMultiplier :=80;
CT.WriteTotalTimeoutMultiplier := 80;
CT.WriteTotalTimeoutConstant := 80;
If Not SetCommTimeouts(hPort, CT) Then ShowMessage('Ошибка конфигурации таймаутов !!!');
if not SetupComm(hPort, 2048, 2048) then ShowMessage('Ошибка записи настроек буферов порта');
if PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR) then ;
end;
Result:=True;
Fm_Main.Tm_Read.Interval:=Cycle;
Fm_Main.Tm_Read.Enabled:=True;
end;
Procedure TReadThread.Execute;
var
index:integer;
i:integer;
s1:string;
ch:byte;
begin
clr_com;
str:='';
str:='яяM01R001'+#13;
WriteFile(hPort,pchar(str)^,Length(Str),ByteWritten,Nil);
ReadFile(hport,ReadByte,SizeOf(ReadByte),ByteReaded,Nil);
s:=ReadByte;
s:=DeleteLineBreaks(s);
s:=DeleteProbel(s);
Value[1]:=MidStr(s,7,5);
Value[2]:=MidStr(s,12,5);
Value[3]:=MidStr(s,17,5);
Value[4]:=MidStr(s,22,5);
Value[5]:=MidStr(s,27,5);
Value[6]:=MidStr(s,33,5);
end;
procedure TFm_Main.FormCreate(Sender: TObject);
begin
Path:=GetCurrentDir;
INI := TIniFile.Create(Path+'\Settings.ini');
RSPort:=INI.ReadString('Main','Rsport','COM1');
Cycle:=INI.ReadInteger('Main','Cycle',1000);
Init_Device;
Create_RegFile;
SpeedButton1.Caption:='ЗАПУСТИТЬ'+#13+#10+'РЕГИСТРАЦИЮ';
Label10.Caption:='Период регистрации';
end;
procedure TFm_Main.Tm_RegTimer(Sender: TObject);
begin
If RegStart Then
begin
Write_RegFile;
inc(tick_reg);
Label8.Caption:='Регистрация: '+IntToStr(tick_reg);
end;
end;
procedure TFm_Main.SpeedButton1Click(Sender: TObject);
begin
If SpeedButton1.Down Then
begin
RegStart:=True;
SpeedButton1.Font.Color:=clRed;
SpeedButton1.Caption:='ОСТАНОВИТЬ'+#13+#10+'РЕГИСТРАЦИЮ';
end
Else
begin
RegStart:=False;
SpeedButton1.Font.Color:=clGreen;
SpeedButton1.Caption:='ЗАПУСТИТЬ'+#13+#10+'РЕГИСТРАЦИЮ';
end;
end;
procedure TFm_Main.Tm_ReadTimer(Sender: TObject);
begin
inc(tick);
Label7.Caption:='Опрос Micron: '+IntToStr(tick);
StartRead;
end;
procedure TFm_Main.ComboBox1Change(Sender: TObject);
begin
Case ComboBox1.ItemIndex Of
0: Tm_Reg.Interval:=100;
1: Tm_Reg.Interval:=500;
2: Tm_Reg.Interval:=1000;
3: Tm_Reg.Interval:=5000;
4: Tm_Reg.Interval:=10000;
5: Tm_Reg.Interval:=30000;
6: Tm_Reg.Interval:=60000;
7: Tm_Reg.Interval:=300000;
8: Tm_Reg.Interval:=1000000;
end;
end;
function after(const Search, Find: string): string;
var
index: byte;
begin
index := Pos(Find, Search);
if index = 0 then
Result := ''
else
Result := Copy(Search, index + Length(Find), 255);
end;
procedure TFm_Main.Tm_ScreenTimer(Sender: TObject);
begin
Fm_Main.Ed_Ch1.Text:=Value[1];
Fm_Main.Ed_Ch2.Text:=Value[2];
Fm_Main.Ed_Ch3.Text:=Value[3];
Fm_Main.Ed_Ch4.Text:=Value[4];
Fm_Main.Ed_Ch5.Text:=Value[5];
Fm_Main.Ed_Ch6.Text:=Value[6];
end;
end.
05.02.2014, 12:23
Построение программы
Линейный вид
