Как сделать чтоб данные с массива передовались на тренд

Тема в разделе "Delphi - СОМ", создана пользователем KuevProger, 24 мар 2009.

Статус темы:
Закрыта.
  1. KuevProger

    KuevProger Гость

    Люди помогите дописать прогу до конца.Есть массив value[1..9] с которого надо передать данные на тренд.
    СПС за ранее вот листинг программы:
    unit U_Main;

    interface
    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls, Buttons,ClipBrd, Grids;

    type

    TReadThread = class(TThread)
    private
    protected
    procedure Execute; override;
    end;


    type
    TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    StringGrid1: TStringGrid;
    Label2: TLabel;
    Timer2: TTimer;
    ComboBox1: TComboBox;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox1Change(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    DCB : TDCB;
    CT: TCommTimeouts;
    hPort : THandle;
    i:integer;
    ReadThread:TReadThread;
    Value:array[1..9] of real;
    tick:integer=0;
    tck_reg:Integer=0;
    Form1: TForm1;
    NamePatch:String;
    RegFileName:string;
    RegFile:TFileStream;
    str,st_file:string;
    implementation

    {$R *.dfm}

    Procedure Create_RegFile;
    var
    n:byte;
    begin
    RegFileName:=DateToStr(now)+'.txt';
    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);
    st_file:=st_file+'Время;';
    For n:=1 To 9 Do
    begin
    st_file:=st_file+'Канал'+IntToStr(n)+';';
    end;
    st_file:=st_file+#13+#10;
    RegFile.Write(Pchar(st_file)^, Length(st_file));
    end;
    end;

    procedure StartRead;
    begin
    ReadThread:=TReadThread.Create(True);
    with ReadThread do begin
    Priority:=tpNormal;
    FreeOnTerminate:=True;
    Resume;
    end;
    end;

    procedure clr_com;
    begin
    PurgeComm(hPort,PURGE_TXCLEAR);
    PurgeComm(hPort,PURGE_RXCLEAR);
    end;

    Function InitADAM():boolean;
    begin
    hPort := CreateFile(PChar('COM1'),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_38400;
    DCB.ByteSize :=8;
    DCB.StopBits :=ONESTOPBIT;
    DCB.Parity := 0;

    if not SetCommState(hPort, DCB) then ShowMessage('Ошибка записи настроек порта');

    CT.ReadTotalTimeoutConstant:=50;
    CT.ReadIntervalTimeout :=25;
    CT.ReadTotalTimeoutMultiplier :=0;
    CT.WriteTotalTimeoutMultiplier := 0;
    CT.WriteTotalTimeoutConstant := 0;
    If Not SetCommTimeouts(hPort, CT) Then ShowMessage('Ошибка конфигурации таймаутов !!!');
    if not SetupComm(hPort, 1024, 1024) then ShowMessage('Ошибка записи настроек буферов порта');
    if PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR) then ;

    Result:=True;
    end;
    end;

    Function ReadValue(Module:byte):string;
    var

    ByteWritten,ByteReaded:dword;
    ReadByte,ReadByte1:array [0..255] of char;
    begin
    str:='#0'+inttostr(Module)+#13;
    clr_com;
    WriteFile(hPort,pchar(Str)^,Length(Str),ByteWritten,Nil);
    ReadFile(hport,ReadByte,SizeOf(ReadByte),ByteReaded,Nil);
    sleep(50);
    Result:=ReadByte;
    end;

    Procedure TReadThread.Execute;
    var
    respone:string;
    num,n,m:byte;

    begin
    For num:=1 To 2 Do
    begin
    respone:=ReadValue(num);
    sleep(10);
    If num=1 Then
    begin
    delete(Respone,1,1);
    n:=1;
    m:=1;
    While n<>57 Do
    begin
    Value[m]:=StrToFloat(copy(Respone,n,6));
    inc(n,7);
    inc(m,1);
    end;
    end;
    If num=2 Then
    begin
    delete(Respone,1,1);
    Value[9]:=StrToFloat(copy(Respone,1,6));
    end;
    end;

    For i:=1 To 9 Do
    begin
    Form1.StringGrid1.Cells[i-1,0]:='CH'+IntToStr(i);
    Form1.StringGrid1.Cells[i-1,1]:=FloatToStr(value);
    end;
    end;
    {+02.409+03.221+03.102+02.988+02.879+02.774+02.673+02.576}---->данные опрашиваемые с модуля ADAM-4019

    {>+19.531}---->данные опрашиваемые с модуля ADAM-4011

    Procedure WriteValue;
    var
    n:byte;
    begin
    st_file:='';
    st_file:=st_file+TimeToStr(now)+';';
    For n:=1 To 9 Do
    begin
    st_file:=st_file+FloatToStr(value[n])+';';
    end;
    st_file:=st_file+#13+#10;
    RegFile.Write(Pchar(st_file)^, Length(st_file));
    end;


    procedure TForm1.FormCreate(Sender: TObject);
    begin
    InitADAM;
    NamePatch:=ExtractFilePath(Application.ExeName);
    Create_RegFile;
    Timer1.Enabled:=True;
    end;

    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    StartRead;
    inc(tick,1);
    Label1.Caption:='Колисество считанных данных с COM порта:'+IntToStr(tick);
    end;


    procedure TForm1.Timer2Timer(Sender: TObject);
    begin
    WriteValue;
    inc(tck_reg,1);
    Label2.Caption:='Количество регистраций:'+IntToStr(tck_reg);
    end;


    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    Timer1.Enabled:=False;
    end;

    procedure TForm1.ComboBox1Change(Sender: TObject);
    begin
    Timer2.Interval:=StrToInt(ComboBox1.Text);
    end;

    procedure TForm1.BitBtn2Click(Sender: TObject);
    begin
    Timer2.Interval:=StrToInt(ComboBox1.Text);
    Timer2.Enabled:=True;
    Timer1.Enabled:=True;
    BitBtn2.Hide;
    BitBtn3.Show;
    end;

    procedure TForm1.BitBtn3Click(Sender: TObject);
    begin
    Timer2.Enabled:=False;
    BitBtn3.Hide;
    BitBtn2.Show;
    end;

    end.
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей