My code is here :
unit UnitTemperature;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, DBGrids,
DBCtrls, ComCtrls, Menus, Buttons, ExtCtrls, LResources, RTTICtrls, TAGraph,
TASeries, TADbSource, LR_Class, LR_PGrid, ZDataset, IdTCPClient, IdComponent,
IdTCPConnection, IdGlobal, IdIMAP4, db, dbf, UnitConfig, UnitDataModule,
Types, Grids,unitbin;
type
{ TFormTemperature }
TFormTemperature = class(TForm)
Button1: TButton;
FindDialog1: TFindDialog;
frReport1: TfrReport;
ImageList1: TImageList;
Panel1: TPanel;
MainMenu1: TMainMenu;
Fichier: TMenuItem;
A_propos: TMenuItem;
Administration: TMenuItem;
ProgressBar_Execution: TProgressBar;
Quitter: TMenuItem;
DBGridTemperature: TDBGrid;
StatusBar1: TStatusBar;
Timer_ProgressBar: TTimer;
Timer_Execution: TTimer;
Timer_Date: TTimer;
ToolBar1: TToolBar;
btn_quit: TToolButton;
ToolButton2: TToolButton;
btn_print: TToolButton;
btn_connect: TToolButton;
btn_disconnect: TToolButton;
btn_run: TToolButton;
procedure DBGridTemperatureDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure btn_disconnectClick(Sender: TObject);
procedure AdministrationClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure QuitterClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
procedure Timer_DateTimer(Sender: TObject);
procedure Timer_ExecutionTimer(Sender: TObject);
procedure btn_quitClick(Sender: TObject);
procedure btn_printClick(Sender: TObject);
procedure btn_connectClick(Sender: TObject);
procedure btn_runClick(Sender: TObject);
procedure Timer_ProgressBarStartTimer(Sender: TObject);
procedure Timer_ProgressBarTimer(Sender: TObject);
procedure ToolBar1Click(Sender: TObject);
procedure ZTableDBGridAfterInsert(DataSet: TDataSet);
private
public
end;
var
FormTemperature: TFormTemperature;
nbLigneDBF : integer;
TCPArray : array of TidTCPClient;
TrancheArray : array of String;
LocalArray : array of String;
implementation
{$R *.lfm}
{ TFormTemperature }
//******************
// Procedure executée sur la creation du formulaire
//*****************
procedure TFormTemperature.FormCreate(Sender: TObject);
begin
ProgressBar_Execution.Parent := StatusBar1;
StatusBar1.Panels.Items[3].Text:='Hors service';
StatusBar1.Panels.Items[2].Text:='Relevé toutes les '+IntToStr(Timer_Execution.Interval div 60000)+' minutes';
btn_disconnect.Enabled:= False;
btn_run.Enabled:= False;
end;
procedure TFormTemperature.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
if (Timer_Execution.Enabled) then
begin
StatusBar.Canvas.Font.Color:=clGreen;
StatusBar.Canvas.TextOut(Rect.Left,Rect.Top,Panel.Text);
end
else
begin
Statusbar.Canvas.Font.Color:=clSilver;
StatusBar.Canvas.TextOut(Rect.Left,Rect.Top,Panel.Text);
end;
end;
procedure TFormTemperature.btn_disconnectClick(Sender: TObject);
var
i:integer;
begin
for i:=0 to Length(TCPArray)-1 do
TCPArray.Disconnect;
btn_disconnect.Enabled := False;
btn_run.Enabled := False;
FormTemperature.Close;
end;
// Met en couleur les lignes de la grille en fonction de la tranche
procedure TFormTemperature.DBGridTemperatureDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
with DBGridTemperature do
begin
if DataSource.DataSet.FieldByName('tranche').AsString='1' then
begin
Canvas.Brush.Color:=clYellow;
Canvas.Font.Color:=clYellow;
Canvas.FrameRect(Rect);
DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
if DataSource.DataSet.FieldByName('tranche').AsString='2' then
begin
Canvas.Brush.Color:=clBlue;
Canvas.Font.Color:=clBlue;
Canvas.FrameRect(Rect);
DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
if DataSource.DataSet.FieldByName('tranche').AsString='0' then
begin
Canvas.Brush.Color:=clRed;
Canvas.Font.Color:=clRed;
Canvas.FrameRect(Rect);
DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
end;
end;
procedure TFormTemperature.AdministrationClick(Sender: TObject);
begin
FormConfig.Show;
end;
procedure TFormTemperature.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
CanClose := MessageDlg('Question','Souhaitez-vous arrêter le programme ?',mtConfirmation,[mbYes,mbNo],0)= mrYes;
end;
procedure TFormTemperature.QuitterClick(Sender: TObject);
begin
FormTemperature.Close;
end;
procedure TFormTemperature.Timer_DateTimer(Sender: TObject);
begin
StatusBar1.Panels.Items[0].Text:=getNow;
end;
// Procédure permettant de faire l'envoi et la récupération de trames
procedure TFormTemperature.Timer_ExecutionTimer(Sender: TObject);
var
Buffer : TIdBytes;
Hex : String;
Mesure : String;
MesureDec : Integer;
Temp : Double;
i:integer;
begin
ProgressBar_Execution.Position:=0; //On initialise la progressbar à 0
for i:=0 to Length(TCPArray)-1 do // On parcours le tableau contenant les ClientTCP
begin
// SetLength(Buffer,0); // On vide le buffer à chaque itération
// Hex :='';
// TCPArray.IOHandler.Write(ToBytes('0x10 0x06 0x01 0x07 0x20')); // On envoie la trame de requête
// TCPArray.IOHandler.ReadBytes(Buffer,5,true); // On recupere la trame de donnees dans le buffer
// Hex := TextToHex(BytesToString(Buffer,IndyTextEncoding_8bit)); // On transforme la trame en hexa
// Mesure := copy(Hex,3,4); // On recupere les donnes de mesure dans la trame
// MesureDec := HexToDec(Mesure); // On converti en decimal la mesure
// Temp := ((MesureDec * 2500 / ( 4096 * 13.04 )) / 100 - 1 ) / 0.00358; // On applique la formule
// on arrondi 2 chiffres apres la virgule
// Mesure := FloatToStrF(Temp,TFloatFormat(ffFixed),10,2);
// if(Temp>30.0) then
// FormConfig.SpinEditTimer.Value:=30; // Si la temperature > 30 on fait des relevé toutes les 30 mins
// if(Temp<30.0) then
// FormConfig.SpinEditTimer.Value:=FormConfig.SpinEditTimer.Tag; // Si la temperature < 30 on fait des relevé toutes les heures
try
DataModuleBDD.ZConnection1.StartTransaction; // On commence l'insertion de la mesure dans la base de données
// DataModuleBDD.insertTemperature(DataModuleBDD.ZQueryInsert,DateToStr(Date),TimeToStr(Time),Mesure,LocalArray,TrancheArray); // On fait l'insertion avec la procedure qui se trouve dans datamoduleBDD
DataModuleBDD.insertTemperature(DataModuleBDD.ZQueryInsert,DateToStr(Date),TimeToStr(Time),'test','test','test'); // On fait l'insertion avec la procedure qui se trouve dans datamoduleBDD
DataModuleBDD.ZConnection1.Commit; // On commit l'inertion
DBGridTemperature.DataSource.DataSet.Active:=true; // On rafraichit la grille pour voir l'insertion sur l'application
ShowMessage(DBGridTemperature.DataSource.DataSet.IsEmpty.ToString());
DBGridTemperature.DataSource.DataSet.Refresh;
DBGridTemperature.Columns.BeginUpdate;
except
DataModuleBDD.ZConnection1.Rollback; // Rollback si erreur dans l'insertion
end;
end;
end;
procedure TFormTemperature.btn_quitClick(Sender: TObject);
begin
FormTemperature.Close;
end;
procedure TFormTemperature.btn_printClick(Sender: TObject);
begin
frReport1.LoadFromFile('rep1.lrf'); // Charge le fichier dans lequel sera le rapport
frReport1.ShowReport; // Affiche le rapport
end;
procedure TFormTemperature.btn_connectClick(Sender: TObject);
var
i:integer;
begin
DataModuleBDD.ZConnection1.Connect; // On se connecte à la base
DataModuleBDD.ZTableDBGrid.Active:=True; // On active la table
DataModuleBDD.TableModule.Open; // on ouvre le dbf pour recuperer les données
nbLigneDBF:= DataModuleBDD.TableModule.ExactRecordCount; // on recupere le nb d'enregistrement dans le dbf
SetLength(TCPArray,nbLigneDBF); // on alloue dynamiquement le tableau avec la taille necessaire
SetLength(TrancheArray,nbLigneDBF); // pareil pour le tableau contenant les tranches
SetLength(LocalArray,nbLigneDBF);
DataModuleBDD.TableModule.First; // on se place sur le premier element
for i:=0 to Length(TCPArray)-1 do
begin
TCPArray := TIdTCPClient.Create; // Creation de TCPClients et ajout dans le tableau
TCPArray.Host:=DataModuleBDD.TableModule.FieldByName('IP').AsString; // Configuration du Host des TCPCLient
TCPArray.Port:=10001; // Configuration du Port des TCPClient
TrancheArray:=DataModuleBDD.TableModule.FieldByName('TRANCHE').AsString; // Remplissage du tableau des tranches
LocalArray:=DataModuleBDD.TableModule.FieldByName('LOCAL').AsString; // Remplissage du tableau des locaux
DataModuleBDD.TableModule.Next;
end;
DataModuleBDD.TableModule.Close;
// Connexion des TCPClient avec parcours du tableau
// for i:=0 to Length(TCPArray)-1 do
// try
// TCPArray.Connect;
// Except
// MessageDlg('Erreur lors de la connexion aux module de températures',mtError,[mbOk],0);
// end;
btn_connect.Enabled:= False;
btn_run.Enabled:= True;
btn_disconnect.Enabled:= True;
end;
// Procedure qui lance le callback OnTimer du TimerExecution
procedure TFormTemperature.btn_runClick(Sender: TObject);
begin
Timer_Execution.Enabled := not Timer_Execution.Enabled;
Timer_ProgressBar.Enabled:= not Timer_ProgressBar.Enabled;
if Timer_Execution.Enabled then
begin
btn_run.ImageIndex := 5;
StatusBar1.Panels.Items[3].Text:='En service';
end
else
begin
btn_run.ImageIndex := 4;
StatusBar1.Panels.Items[3].Text:='Hors service';
end;
end;
// Callback OnStart du Timer ProgressBar
procedure TFormTemperature.Timer_ProgressBarStartTimer(Sender: TObject);
begin
Timer_ProgressBar.Interval:= Timer_Execution.Interval div 100;
end;
// Callback OnTimer du TimerProgressBar
procedure TFormTemperature.Timer_ProgressBarTimer(Sender: TObject);
begin
ProgressBar_Execution.Position:=ProgressBar_Execution.Position+1;
end;
procedure TFormTemperature.ToolBar1Click(Sender: TObject);
begin
end;
procedure TFormTemperature.ZTableDBGridAfterInsert(DataSet: TDataSet);
begin
end;
end.
Recent
