procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer); var NouveauMsg,MsgInt : string; PosEndTrame,i,p : Integer; begin {*** lecture du port com 1 ***} ComPort1.ReadStr(NouveauMsg, Count); MonMessage := MonMessage + NouveauMsg; MonMessage := Uppercase(MonMessage); PosEndTrame := Pos(#13, MonMessage); if PosEndTrame <> 0 then while PosEndTrame <> 0 do begin TrameCp := Copy(MonMessage, 0, PosEndTrame -1); { *** Remplacement du caractère $F8 par $B0 ***} // p := pos( chr($F8), TrameCp); // if p>0 then // si le caractère est présent, on le remplace // TrameCp[p] := chr($B0); richEditRecept.Lines.Add(TrameCp); // dans tous les cas, la trame est ajoutée Inc (Cpt_Evt); { *** lecture des caractères ASCII *** } MsgInt :=''; For i := 1 to length(NouveauMsg) do MsgInt := MsgInt + '/' + inttostr (ord(NouveauMsg[i])); RichEditInt.Lines.Text := RichEditInt.Lines.Text + MsgInt; { *** Mis en couleur de certaines lignes et écriture dans les RichEdit respectif *** } if (pos(' OPR ', TrameCP)) <> 0 then begin RichEdit_OPR.SelAttributes.Color := clBlue; RichEdit_OPR.Lines.Add(TrameCp); Inc (Cpt_Alm_Inhi); end; if (Pos(' ALM ', TrameCp)) <> 0 then begin RichEditLog.SelAttributes.Color := clred ; richEditLog.Lines.Add(TrameCp); Inc (Cpt_ALM); end; if (Pos(' ACK ', TrameCp)) <> 0 then begin //RichEditLog.SelAttributes.Color := $000080FF; // Orange RichEditLog.SelAttributes.Color := clTeal; richEditLog.Lines.Add(trameCp); end; if (Pos(' RTN ', TrameCp)) <> 0 then begin RichEditLog.SelAttributes.Color := clLime; RichEditLog.Lines.Add(trameCp); end; MonMessage := Copy(MonMessage, PosEndTrame +1, Length(MonMessage)); PosEndTrame := Pos(#13, MonMessage); end; end;
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionfunction Port_2_Str( vInput : string ): string; var p:integer; vTmp : string; vNbr, err : integer; begin result:=''; vTmp := trim( vInput ); if vTmp[1]='/' then delete(vTmp, 1, 1); p:= pos('/', vTmp); while p>0 do begin val( copy(vTmp,1, p-1), vNbr, Err); if Err=0 then result := result + chr( vNbr ); delete(vTmp, 1, p); p:= pos('/', vTmp); end; end; procedure TForm1.Button1Click(Sender: TObject); begin memo2.text := Port_2_Str( Memo1.text ); end;
val( vTmp vNbr, Err); if Err=0 then result := result + chr( vNbr );
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer); var NouveauMsg,MsgInt : string; PosEndTrame,i : Integer; begin {*** lecture du port com 1 ***} ComPort1.ReadStr(NouveauMsg, Count); MonMessage := MonMessage + NouveauMsg; MonMessage := Uppercase(MonMessage); PosEndTrame := Pos(#13, MonMessage); if PosEndTrame <> 0 then while PosEndTrame <> 0 do begin TrameCp := Copy(MonMessage, 0, PosEndTrame -1); { *** Remplacement du caractère $F8 par $B0 ***} //p := pos(#32, TrameCp); // if p>0 then // si le caractère est présent, on le remplace // TrameCp[p] := (#33); richEditRecept.Lines.Add(TrameCp); // dans tous les cas, la trame est ajoutée Inc (Cpt_Evt); { *** lecture des caractères ASCII *** } MsgInt :=''; For i := 1 to length(NouveauMsg) do MsgInt := MsgInt + '/' + inttostr (ord(NouveauMsg[i])); RichEditInt.Lines.Text := RichEditInt.Lines.Text + MsgInt;
Function Conversion( vInput : string):string; var p,vNbr,Err : integer; vTmp : string; Begin result:=''; vTmp := trim( vInput ); if vTmp[1]='/' then delete (vTmp,1,1); p:= pos ('/', vTmp); While p>0 do begin val( copy(vTmp,1,p-1), vNbr, Err); if Err = 0 then result := result + chr( vNbr ); delete(vTmp,1,p); p:= pos('/',vTmp); end; // val( vTmp vNbr,Err); // if err=0 then result := result + chr(vNbr); end; procedure TForm1.Button1Click(Sender: TObject); begin richEdit_conv.Lines.Text := conversion(RicheditRecept.Lines.Text); end;
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, CPort, CPortCtl, ComCtrls, jpeg, Menus; type TForm1 = class(TForm) ComPort1: TComPort; Timer1: TTimer; ComLed3: TComLed; Label3: TLabel; Timer2: TTimer; Edit1: TEdit; Edit2: TEdit; Image1: TImage; Button4: TButton; Label12: TLabel; Label13: TLabel; Label14: TLabel; MainMenu1: TMainMenu; Fichier1: TMenuItem; Quitter1: TMenuItem; Aide1: TMenuItem; GroupBox1: TGroupBox; GroupBox2: TGroupBox; RichEditRecept: TRichEdit; RichEditLog: TRichEdit; RichEdit_OPR: TRichEdit; Label4: TLabel; Label5: TLabel; RichEditInt: TRichEdit; RichEdit_Conv: TRichEdit; Button1: TButton; procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure ComPort1RxChar(Sender: TObject; Count: Integer); procedure Button4Click(Sender: TObject); procedure Quitter1Click(Sender: TObject); procedure Aide1Click(Sender: TObject); procedure RichEditReceptChange(Sender: TObject); procedure RichEditLogChange(Sender: TObject); procedure RichEdit_OPRChange(Sender: TObject); procedure RichEditIntChange(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } MonMessage : String; mess : string; public { Public declarations } end; var Form1: TForm1; AllowedDateTime: string; NomFichEvenement: string; NomFichEvenement1: string; ExtRecept: string; NomFichAlarme : string; NomFichAlarme1 : string; ExtLog : string; LegalDateTime : string; TrameCp : string; Cpt_ALM, Cpt_Evt,Cpt_Alm_Inhi : integer; implementation {$R *.dfm} Function Conversion( vInput : string):string; var p,vNbr,Err : integer; vTmp : string; Begin result:=''; vTmp := trim( vInput ); if vTmp[1]='/' then delete (vTmp,1,1); p:= pos ('/', vTmp); While p>0 do begin val( copy(vTmp,1,p-1), vNbr, Err); if Err = 0 then result := result + chr( vNbr ); delete(vTmp,1,p); p:= pos('/',vTmp); end; end; procedure TForm1.Timer1Timer(Sender: TObject); // Gestion du Port Com begin If comport1.Port = 'COM1' Then begin comport1.SetDTR(true); // met à l'état de travail "0" la sortie DTR (+10V) comport1.SetRTS(true); // met à l'état de travail "0" la sortie RTS (+10V) end Else begin comport1.SetDTR(false) ; comport1.SetRTS(false); end; end; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Enabled:=true; Application.Title:='Alarmes CMR'; end; // Retourne un string sous la forme "ddmmyyyyhhmmss" : function AllowedStrDateTime(const sDate, sTime: string): string; var AllowedStrDate, AllowedStrTime: string; begin AllowedStrDate := Copy(sDate, 1 , 2) +' '+ Copy(sDate, 4, 2) +' '+ Copy(sDate, 7, 4); AllowedStrTime := Copy(sTime, 1, 2) +'H'+ Copy(sTime, 4, 2) +'min'+ Copy(sTime, 7, 2)+'s'; Result := AllowedStrDate + ' à ' + AllowedStrTime; end; procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer); var NouveauMsg,MsgInt : string; PosEndTrame,i : Integer; begin {*** lecture du port com 1 ***} ComPort1.ReadStr(NouveauMsg, Count); MonMessage := MonMessage + NouveauMsg; MonMessage := Uppercase(MonMessage); PosEndTrame := Pos(#13, MonMessage); if PosEndTrame <> 0 then while PosEndTrame <> 0 do begin TrameCp := Copy(MonMessage, 0, PosEndTrame -1); richEditRecept.Lines.Add(TrameCp); // dans tous les cas, la trame est ajoutée Inc (Cpt_Evt); { *** lecture des caractères ASCII *** } MsgInt :=''; For i := 1 to length(NouveauMsg) do MsgInt := MsgInt + '/' + inttostr (ord(NouveauMsg[i])); RichEditInt.Lines.Text := RichEditInt.Lines.Text + MsgInt; { *** Mis en couleur de certaines lignes et écriture dans les RichEdit respectif *** } if (pos(' OPR ', TrameCP)) <> 0 then begin RichEdit_OPR.SelAttributes.Color := clBlue; RichEdit_OPR.Lines.Add(TrameCp); Inc (Cpt_Alm_Inhi); end; if (Pos(' ALM ', TrameCp)) <> 0 then begin RichEditLog.SelAttributes.Color := clred ; richEditLog.Lines.Add(TrameCp); Inc (Cpt_ALM); end; if (Pos(' ACK ', TrameCp)) <> 0 then begin //RichEditLog.SelAttributes.Color := $000080FF; // Orange RichEditLog.SelAttributes.Color := clTeal; richEditLog.Lines.Add(trameCp); end; if (Pos(' RTN ', TrameCp)) <> 0 then begin RichEditLog.SelAttributes.Color := clLime; RichEditLog.Lines.Add(trameCp); end; MonMessage := Copy(MonMessage, PosEndTrame +1, Length(MonMessage)); PosEndTrame := Pos(#13, MonMessage); end; end; procedure TForm1.Timer2Timer(Sender: TObject);// gestion de date et heure, Enregistrement Auto const EnregistAuto=('00:00:00'); Begin label5.Caption := ('Nb d'' évènements ' + inttostr (Cpt_Evt)) ; label4.Caption := ('Nb d'' alarmes ' + inttostr(Cpt_ALM)) ; label14.Caption := FormatDateTime('dddddd tt', Now); Edit1.Text := DateToStr(Date); Edit2.Text := TimeToStr(Time); if Edit2.Text = EnregistAuto then begin // envoi des évènements sur un disque local NomFichEvenement := 'E:CMREvènementsEvènements.txt '; // PC en machine // NomFichEvenement := 'E:CMREvènementsEvènements.txt '; // Pc portable ExtRecept := ExtractFileExt(NomFichEvenement); Delete(NomFichEvenement, Pos(ExtRecept, NomFichEvenement), Length(ExtRecept)); AllowedDateTime := AllowedStrDateTime (Edit1.Text,Edit2.Text); NomFichEvenement := Format('%s %s %s', [NomFichEvenement, AllowedDateTime, ExtRecept]); label12.Visible := true; label12.Caption := AllowedDateTime; // envoi des alarmes sur un disque local NomFichAlarme := 'E:CMRAlarmesAlarmes.txt '; // PC en machine // NomFichAlarme := 'E:CMRAlarmesAlarmes.txt '; // Pc portable ExtLog := ExtractFileExt(NomFichAlarme); Delete(NomFichAlarme, Pos(Extlog, NomFichAlarme), Length(ExtLog)); AllowedDateTime := AllowedStrDateTime (Edit1.Text,Edit2.Text); NomFichAlarme := Format('%s %s %s', [NomFichAlarme, AllowedDateTime, Extlog]); label12.Visible := true; label12.Caption := AllowedDateTime; end; end; procedure TForm1.Button4Click(Sender: TObject); //Enregistement manu begin // envoi des évènements sur un disque local NomFichEvenement := 'E:CMREvènementsEvènements.txt '; // Chemin d'enregistrement ExtRecept := ExtractFileExt(NomFichEvenement); Delete(NomFichEvenement, Pos(ExtRecept, NomFichEvenement), Length(ExtRecept)); AllowedDateTime := AllowedStrDateTime (Edit1.Text,Edit2.Text); NomFichEvenement := Format('%s %s %s', [NomFichEvenement, AllowedDateTime, ExtRecept]); // MemoRecept.Lines.SaveToFile(NomFichEvenement); RichEditRecept.Lines.SaveToFile(NomFichEvenement); label12.Visible := true; label12.Caption := AllowedDateTime; end; procedure TForm1.Quitter1Click(Sender: TObject); begin comport1.SetDTR(false); // met à l'état de repos "1" la sortie DTR (-10V) comport1.SetRTS(false); // met à l'état de repos "1" la sortie RTS (-10V) comport1.Connected:=false; close; end; procedure TForm1.Aide1Click(Sender: TObject); begin showmessage ('Enregistrement sur le ''E:CMR... '' et ''X: 2 - Chef MécanicienCMR... ''à chaque passage à 0h, mais il est possible d''effectuer un enregistrement immediat avec la touche enregistrement.'); end; procedure TForm1.RichEditReceptChange(Sender: TObject); begin SendMessage(RichEditRecept.Handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TForm1.RichEditLogChange(Sender: TObject); begin SendMessage(RichEditLog.Handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TForm1.RichEdit_OPRChange(Sender: TObject); begin SendMessage(RichEdit_OPR.Handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TForm1.RichEditIntChange(Sender: TObject); begin SendMessage(RichEditInt.Handle,WM_VSCROLL,SB_BOTTOM,0); end; procedure TForm1.Button1Click(Sender: TObject); begin {*** mis en place des caractères ***} richEdit_conv.Text := conversion(RicheditRecept.Text); end; end.