witam
mam taki problem. Mam uklad do pomiaru temp na atmega polaczony z kompem przez rs232. mikrokontroler wysyla mi dane (2 temp) do komputera i ja to odbieram przez rs232 w delphi w polu RichEdit. Problem w tym ze jesli nacisne przycisk jakiś na ukladzie to uklad wysyla mi jakis znak np. "a" do kompa (tak chciałem) i jesli w buforze znajdzie sie litera "a" to program rozpoczyna animacje.
Wiem jak zrobić animacje ale nie wiem w jaki sposób moge odczytać dane z bufora kompa. Nie wiem jak to rozdzielić aby znaleźć to "a". Prosze o pomoc, załączam swoj program.
unit temprs;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, OleCtrls, ShockwaveFlashObjects_TLB;
type
TForm1 = class(TForm)
CloseComm: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
OpenComm: TButton;
TimerON: TButton;
TimerOFF: TButton;
RichEdit1: TRichEdit;
Timer1: TTimer;
TrackBar1: TTrackBar;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
StatusBar1: TStatusBar;
Flashcichy: TShockwaveFlash;
procedure CloseCommClick(Sender: TObject);
procedure OpenCommClick(Sender: TObject);
procedure TimerONClick(Sender: TObject);
procedure TimerOFFClick(Sender: TObject);
procedure TimerOnTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
function Write_Comm(hCommDev: THANDLE;
nNumberOfBytesToWrite: DWORD): BOOL;
function Read_Comm(hCommDev: THANDLE; Buf_Size: DWORD): BOOL;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
// -- wartości flag sterujących portu szeregowego --
dcb_fBinary = $0001;
dcb_fParity = $0002;
dcb_fOutxCtsFlow = $0004;
dcb_fOutxDsrFlow = $0008;
// -- fDtrControl --
DTR_CONTROL_ENABLE = $0010;
DTR_CONTROL_HANDSHAKE = $0020;
dcb_fDsrSensitivity = $0040;
dcb_fTXContinueOnXoff = $0080;
dcb_fOutX = $0100;
dcb_fInX = $0200;
dcb_fErrorChar = $0400;
dcb_fNull = $0800;
// -- fRtsControl --
RTS_CONTROL_ENABLE = $1000;
RTS_CONTROL_HANDSHAKE = $2000;
RTS_CONTROL_TOGGLE = $3000;
dcb_fAbortOnError = $4000;
cbInQueue = 16;
cbOutQueue = 16;
var
query : PChar = 'CDAT?'+#13+#10;// przykładowe zapytanie
// zakończone parą znaków CR LF
Buffer_O : ARRAY[0..cbOutQueue] of Char; // bufor wyjściowy
Buffer_I : ARRAY[0..cbInQueue] of Char; // bufor wejściowy
Number_Bytes_Read : DWORD;
hCommDev : THANDLE;
lpFileName : PChar;
fdwEvtMask : DWORD;
Stat : TCOMSTAT;
Errors : DWORD;
dcb : TDCB;
resourcestring
s1 = 'Niewłaściwa nazwa portu lub jest on aktywny ';
s2 = 'Uwaga !';
s3 = 'Blad';
//---------------------------------------------------------
procedure TForm1.CloseCommClick(Sender: TObject);
begin
Timer1.Enabled := FALSE;
CloseHandle(hCommDev);
Application.Terminate();
end;
//---------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := FALSE;
Timer1.Interval := 2000;
TrackBar1.Max := 2000;
TrackBar1.Min := 100;
TrackBar1.Frequency := 50;
end;
//---------------------------------------------------------
function TForm1.Write_Comm(hCommDev: THANDLE;
nNumberOfBytesToWrite: DWORD): BOOL;
var
NumberOfBytesWritten : DWORD;
begin
WriteFile(hCommDev, Buffer_O, nNumberOfBytesToWrite,
NumberOfBytesWritten, NIL);
Result := WaitCommEvent(hCommDev, fdwEvtMask, NIL);
end;
//---------------------------------------------------------
function TForm1.Read_Comm(hCommDev: THANDLE;
Buf_Size: DWORD): BOOL;
var
nNumberOfBytesToRead: DWORD;
begin
Result := FALSE;
ClearCommError(hCommDev, Errors, @Stat);
if (Stat.cbInQue > 0) then
begin
if (Stat.cbInQue > Buf_Size) then
nNumberOfBytesToRead := Buf_Size
else
nNumberOfBytesToRead := Stat.cbInQue;
Result := ReadFile(hCommDev, Buffer_I,
nNumberOfBytesToRead,
Number_Bytes_Read, NIL);
end;
end;
//---------------------------------------------------------
procedure TForm1.OpenCommClick(Sender: TObject);
begin
if (CheckBox1.Checked = TRUE) then
lpFileName := 'COM1';
hCommDev := CreateFile(lpFileName, GENERIC_READ or
GENERIC_WRITE,0, NIL,
OPEN_EXISTING, 0, 0);
if (hCommDev <> INVALID_HANDLE_VALUE) then
begin
SetupComm(hCommDev, cbInQueue, cbOutQueue);
dcb.DCBlength := sizeof(dcb);
GetCommState(hCommDev, dcb);
if (CheckBox2.Checked = TRUE) then
dcb.BaudRate := CBR_9600;
//-- przykładowe ustawienia flag sterujących DCB --
dcb.Flags := dcb.Flags or dcb_fParity;
dcb.Parity := ODDPARITY;
dcb.StopBits :=ONESTOPBIT;
dcb.ByteSize :=7;
SetCommState(hCommDev, dcb);
GetCommMask(hCommDev, fdwEvtMask);
SetCommMask(hCommDev, EV_TXEMPTY);
StatusBar1.Panels[0].Text := 'Port '+lpFileName+ ' jest otwarty';
end
else
case hCommDev of
IE_BADID:
Application.MessageBox(PChar(s1),PChar(s2),MB_OK);
end;
end;
//---------------------------------------------------------
procedure TForm1.TimerONClick(Sender: TObject); //rozpocznij pomiar
begin
if (hCommDev <> INVALID_HANDLE_VALUE)
and (hCommDev > 0) then
begin
StrCopy(Buffer_O, query);
Timer1.Enabled := TRUE;
StatusBar1.Panels[1].Text := 'Trwa odbiór danych z portu '+lpFileName;
Flashcichy.Movie := ExtractFilePath(Application.ExeName) + 'napis.swf';
Flashcichy.Play;
end
else
Application.MessageBox(PChar(s1),PChar(s2),MB_OK);
end;
//---------------------------------------------------------
procedure TForm1.TimerOFFClick(Sender: TObject); //zakończ pomiar
begin
StatusBar1.Panels[1].Text := 'Transmisja z portu '+lpFileName+' zakończona';
Flashcichy.Movie := ExtractFilePath(Application.ExeName) + 'koniec.swf';
Flashcichy.Play; //animacje zakańczająca pomiary
Timer1.Enabled := FALSE;
end;
//---------------------------------------------------------
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Timer1.Interval := TrackBar1.Position;
Edit1.Text := IntToStr(TrackBar1.Position);
end;
//---------------------------------------------------------
procedure TForm1.TimerOnTimer(Sender: TObject);
begin
Repeat
// wysłanie zapytania
FlushFileBuffers(hCommDev);
Until (Write_Comm(hCommDev, StrLen(Buffer_O)) <> FALSE);
if (Read_Comm(hCommDev, SizeOf(Buffer_I)) = TRUE) then
// odbiór danych
begin
if (Buffer_I = 'a') then
begin
Flashcichy.Movie := ExtractFilePath(Application.ExeName) + 'koniec.swf';
Flashcichy.Play;
end
else if (Buffer_I <> 'a') then
RichEdit1.Text := Buffer_I;
end
else
RichEdit1.Text := s3;
end;
//---------------------------------------------------------
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=CaFree;
end;
//---------------------------------------------------------
end.