unit LIBcom;
interface
//**** LIB USES ****************************************************************
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vacomm, VaClasses;
//**** GLOBAL CLASSES **********************************************************
type TCOMForm = class(TForm) // CLASS form
procedure VaComm1RxFlag(Sender: TObject); // CLASS procedure for RXflag event
procedure VaComm1RxChar(Sender: TObject; Count: Integer); // CLASS procedure for RXChar event
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
//**** LIB FUNCTIONS ***********************************************************
function COMpolldata(SetPortNum:byte):string; //
COM - Poll data return RX as string (termination deleted)
//**** LIB GLOBAL CONSTANTS ****************************************************
//**** LIB GLOBAL VARIABLES ****************************************************
var COMForm: TCOMForm; //
COM - referenz auf das Form des
COM Ports
VaComm1: TVaComm; //
COM - referenz auf den
com port direkt
implementation
//**** LIB LOCAL USES **********************************************************
uses AppMain;
//**** LIB LOCAL CONSTANTS *****************************************************
//**** LIB LOCAL VARIABLES *****************************************************
var TXTerm:string; //
COM - Character for termination (carrige return)
RXTerm:string; //
COM - Character for termination (carrige return)
COMtimeout:word; //
COM - Timeout time in [ms] for RX data
//******************************************************************************
//**** LIB CODE START **********************************************************
//******************************************************************************
//****
COM TX RX FUNCTIONS *****************************************************
//**
COM - tx data (-> string OK, ER)
function COMtxdata(txdata:string):string;
begin
if ((VaComm1.Active=true) and (VaComm1.PortNum > 0)) then begin // CHECK if
com availible
txdata:=txdata + TXTerm; // ADD Terminierung
VaComm1.WriteText(AnsiString(txdata)); // TX string
result:='OK'; // SET result OK
end else result:='ER'; // SET result error no
com port
end;
//**
COM - rx data LOOP (-> rxstring, ER) <-------------- klassische Abfrage die auch funktioniert
function COMrxdataLoop():string;
var Tick: DWord; // VAR loc timer [ms]
Stat: Byte; // VAR loc status loop 0:running 1:string complete 2:timeout
RChr: Ansichar; // VAR loc to collect char from
com buffer
begin
if ((VaComm1.Active=true) and (VaComm1.PortNum > 0)) then begin // CHECK if
com availible
Tick := GetTickCount + COMtimeout; // GET actual system tick (ms) + Timeout
Stat:=0; // SET stat on initial 0
result:=''; // CLEAR result var
while (Stat = 0) do begin
if (GetTickCount > Tick) then Stat:=2; // SET exit loop status on timeout
if (VaComm1.ReadBufUsed > 0) then begin // CHECK if
COM port buffer is filled
VaComm1.ReadChar(RChr); // READ a char from buffer
result:=result + Char(RChr); // ADD char from buffer to result
end;
if (length(result) > 0) then begin // CHECK length of result
if (result[length(result)] = RXTerm[1]) then Stat:=1; // SET exit loop on string received (using termination)
end;
end;
if (Stat = 2) then result:='ER'; // SET result on Timeout
end else result:='ER'; // SET result error no
com port
end;
//**
COM - rx data EVENT term flag
procedure TCOMForm.VaComm1RxFlag(Sender: TObject);
begin
Form1.Label1.Caption:=Form1.Label1.Caption + ' - Hello FLAG'; // DUMMY CODE <------ Event der nicht funktioniert
end;
//**
COM - rx data EVENT term char
procedure TCOMForm.VaComm1RxChar(Sender: TObject; Count: Integer);
begin
Form1.Label1.Caption:=Form1.Label1.Caption + ' - Hello CHAR'; // DUMMY CODE <------ Event der nicht funktioniert (selbes problem wie oben)
end;
//****
COM FUNCTIONS ***********************************************************
//**
COM - init port
procedure COMinitport(SetPortNum:byte);
begin
VaComm1:=TVaComm.Create(COMForm); // CREATE
com port
VaComm1.PortNum:=SetPortNum; // SET port number (as port is not open)
VaComm1.Baudrate:=br57600; // SET Boud Rate = 57600
VaComm1.Databits:=db8; // SET Data Bits = 8
VaComm1.Stopbits:=sb1; // SET Stop Bits = 1
VaComm1.Parity:=paNone; // SET Set Parity = None
VaComm1.EventChars.EventChar:=#13; // SET ENABLE RX flag ***** ENABLE VACOMM.MonitorEvents ceRXFlag in Propreties ****** ( in VaComm file add 2x [ceError, ceRxChar, ceRxFlag, ceTxEmpty])
VaComm1.MonitorEvents:=[ceError, ceRxChar, ceRxFlag, ceTxEmpty]; // SET ENABLE cdRXFlag
TXterm:=#13; // SET Character for termination (carrige return)
RXterm:=#13; // SET Character for termination (carrige return)
COMtimeout:=500; // SET Timeout time in [ms]
end;
//**
COM - open port (use
com port on given form)
procedure COMopen();
begin
VaComm1.Open; // OPEN
com port
VaComm1.WriteText(AnsiString(TXterm)); // TX termination to clear all slaves
APPDelay(200); // DELAY
VaComm1.PurgeReadWrite; // CLEAR i/o port (for all slaves)
end;
//**
COM - close port
procedure COMclose();
begin
if (VaComm1.Active=true) then VaComm1.Close; // CLOSE
com port if open
end;
//****
COM OPERATION ***********************************************************
//**
COM - poll data
function COMpolldata(SetPortNum:byte):string;
begin
COMinitport(SetPortNum); // SET comport setup
COMopen();
COMtxdata('M1'); // TX << M1 >>
//Form1.Label1.Caption:=COMrxdataLoop; // READ read buffer (so funktioniert die POLL abfrage)
if (VaComm1.Active=true) then VaComm1.Close; // CLOSE
com port if open
end;
end.