Classe TThread dans composant, liaison entre deux instances ?Résolu

Question

Bonjour !
Alors voilà un problème - j'essaye de faire un timer très précis : malheureusement celui-ci a besoin d'un thread pour fonctionner !
Je cherche donc à inclure mon TThread dans mon composant, mais sans succès - soit le thread ne démarre pas avec le composant, soit je me reçois une violation d'accès !

Voilà le code du composant :
________________________________________

unit MicroTimer;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms;

type
  TTimerThrd = class;

  TMicroTimer = class(TComponent)
  private
    { Déclarations privées }
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    FInterval: Cardinal;
    FThrd: TTimerThrd;
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Déclarations publiées }
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property Enabled: Boolean read FEnabled write FEnabled;
    property Interval: Cardinal read FInterval write FInterval;
    procedure Timer(Sender: TObject);
  end;

  TTimerThrd = class(TThread)
  private
    FTimer: TMicroTimer;
    procedure CentralControl;
  public
    constructor Create(CreateSuspended:boolean);
  protected
    procedure Execute; override;
  end;

procedure Register;

implementation

procedure DelayUS(MicroS:int64);
var Frq_Base, Time_memo, Time_now, dif: Int64;
begin
if QueryPerformanceFrequency(Frq_Base) then begin// Base fréquence systême
  QueryPerformanceCounter(Time_memo);     	// Repère temps
  repeat
   QueryPerformanceCounter(Time_now);// Comparer le Repère temps au temps qui
   dif := (Time_now - Time_memo) * 1000000 div Frq_Base;  // s'écoule
  until dif > MicroS;      // Si pause pas suffisante recommencer
end;
end;

procedure Register;
begin
  RegisterComponents('Bacterius', [TMicroTimer]);
end;

constructor TMicroTimer.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FInterval := 1000;
 FEnabled := True;
 FThrd := TTimerThrd.Create(True);
 FThrd.FTimer := self;
end;

destructor TMicroTimer.Destroy;
begin
 FEnabled := False;
 FThrd.Free;
 inherited Destroy;
end;

procedure TMicroTimer.Timer(Sender: TObject);
begin
 if Assigned(OnTimer) then OnTimer(self);
end;

constructor TTimerThrd.Create(CreateSuspended: Boolean); // Création du thread
begin
  inherited Create(CreateSuspended); // On crée le thread
  FreeOnTerminate := False; // On le libérera nous-même c'est plus sûr
  Priority := tpTimeCritical;
end;

procedure TTimerThrd.CentralControl; // Procédure principale
begin
 FTimer.Timer(self);
end;

procedure TTimerThrd.Execute; // Boucle principale
begin
  repeat  // On répète l'execution du thread ...
    DelayUs(FTimer.FInterval);
    Application.ProcessMessages;  // On laisse l'application traiter ses messages
    Synchronize(CentralControl); // On synchronise
  until Terminated; // ... jusqu'à ce que le thread soit terminé
end;

end.
__________________________________

Vous l'aurez sûrement vu, j'utilise la fonction DelayUs de Rylryl jusqu'à nouvel ordre ...

Merci de m'aider je ne comprends vraiment pas comment établir un lien entre deux instances thread et composant :)

Merci d'avance.

Cordialement, Bacterius !

Francky23012301 · Accepted Answer

Salut,

Qu'est ce code   ?

1)Première boulette :

TMicroTimer = class(TComponent)

  private

    { Déclarations privées }

    FOnTimer: TNotifyEvent;

    FEnabled: Boolean;

    FInterval: Cardinal;

    FThrd: TTimerThrd;

  protected

    { Déclarations protégées }

  public

    { Déclarations publiques }

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  published

    { Déclarations publiées }

    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;

    property Enabled: Boolean read FEnabled write FEnabled;

    property Interval: Cardinal read FInterval write FInterval;

    procedure Timer(Sender: TObject);

  end;

  TTimerThrd = class(TThread)

  private

    FTimer: TMicroTimer;

    procedure CentralControl;

  public

    constructor Create(CreateSuspended:boolean);

  protected

    procedure Execute; override;

  end;

TMicroTimer et  TTimerThrd a inverser =>   TTimerThrd = class devient alors inutile.

2)Attention à ce que tu écris :

procedure TMicroTimer.Timer(Sender: TObject);

begin

 if Assigned( FOnTimer) then FOnTimer(self);

end;

3)Test ton thread a vide

procedure TTimerThrd.Execute; // Boucle principale

begin

  repeat  // On répète l'execution du thread ...
    Application.ProcessMessages;  // On laisse l'application traiter ses messages

    Synchronize(CentralControl); // On synchronise

  until Terminated; // ... jusqu'à ce que le thread soit terminé

end;

Bacterius · Answer

Bon, j'ai abouti sur une solution affreuse en attendant mieux : elle fige totalement l'IDE et rame à mort - en revanche le thread répond bien :/ Voilà le code modifié : (je pense que le problème vient surtout de ma mauvaise connaissance des pointeurs, que je suis obligé d'utiliser ici ...) : ______________________________________ unit MicroTimer; interface uses Windows, Messages, SysUtils, Classes, Forms; type TTimerThrd = class; TMicroTimer = class(TComponent) private { Déclarations privées } FOnTimer: TNotifyEvent; FEnabled: Boolean; FInterval: Cardinal; FThrd: TTimerThrd; procedure SetOnTimer(Value: TNotifyEvent); procedure SetEnabled(Value: Boolean); procedure SetInterval(Value: Cardinal); protected { Déclarations protégées } public { Déclarations publiques } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Déclarations publiées } property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; property Enabled: Boolean read FEnabled write SetEnabled; property Interval: Cardinal read FInterval write SetInterval; procedure Timer(Sender: TObject); end; TTimerThrd = class(TThread) private FEnabled: Boolean; FInterval: Cardinal; FOnTimerPtr: procedure(Sender: TObject) of object; procedure CentralControl; public constructor Create(CreateSuspended:boolean); protected procedure Execute; override; end; procedure Register; implementation procedure DelayUS(MicroS:int64); var Frq_Base, Time_memo, Time_now, dif: Int64; begin if QueryPerformanceFrequency(Frq_Base) then begin// Base fréquence systême QueryPerformanceCounter(Time_memo); // Repère temps repeat QueryPerformanceCounter(Time_now);// Comparer le Repère temps au temps qui dif := (Time_now - Time_memo) * 1000000 div Frq_Base; // s'écoule until dif > MicroS; // Si pause pas suffisante recommencer end; end; procedure Register; begin RegisterComponents('Bacterius', [TMicroTimer]); end; constructor TMicroTimer.Create(AOwner: TComponent); begin inherited Create(AOwner); FInterval := 1000; FEnabled := True; FThrd := TTimerThrd.Create(True); FThrd.FEnabled := True; FThrd.FInterval := 1000; end; destructor TMicroTimer.Destroy; begin FEnabled := False; FThrd.Terminate; FThrd.Free; inherited Destroy; end; procedure TMicroTimer.Timer(Sender: TObject); begin if Assigned(OnTimer) then OnTimer(self); end; procedure TMicroTimer.SetOnTimer(Value: TNotifyEvent); begin FOnTimer := Value; FThrd.FOnTimerPtr := FOnTimer; end; procedure TMicroTimer.SetEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; FThrd.FEnabled := Value; end; end; procedure TMicroTimer.SetInterval(Value: Cardinal); begin if Value <> FInterval then begin FInterval := Value; FThrd.FInterval := Value; end; end; //////////////////////////////////////////////////////////////////////////////// constructor TTimerThrd.Create(CreateSuspended: Boolean); // Création du thread begin inherited Create(CreateSuspended); // On crée le thread FreeOnTerminate := False; // On le libérera nous-même c'est plus sûr Resume; Priority := tpTimeCritical; end; procedure TTimerThrd.CentralControl; // Procédure principale begin if (not FEnabled) or (csDesigning in Application.ComponentState) then Exit; FOnTimerPtr(self); end; procedure TTimerThrd.Execute; // Boucle principale begin repeat // On répète l'execution du thread ... DelayUs(FInterval); Application.ProcessMessages; // On laisse l'application traiter ses messages Synchronize(CentralControl); // On synchronise until Terminated; // ... jusqu'à ce que le thread soit terminé end; end. _______________________________ Cordialement, Bacterius !

Francky23012301 · Answer

Oh là là que de conneries : c'est quoi ce double procedure Register; 
?

Bacterius : va faire tes devoirs, c'est pas ta journée aujourd'hui

Bacterius · Answer

Francky toi aussi tu as fait une boulette dans ma première boulette ! Si tu inverses les deux types, alors le compilateur ne connaît pas encore le type TMicroTimer pour le thread ! Dans tous les cas il faut redéclarer un des deux types. Merci des remarques, je viens de trouver la solution, et je vais prendre en compte quelques unes de tes remarques. Voilà le code (qui fonctionne :p) : ________________________________________ unit MicroTimer; interface uses Windows, Messages, SysUtils, Classes, Forms; type TTimerThrd = class; TNotifyEvent = procedure(Sender: TObject) of object; TMicroTimer = class(TComponent) private { Déclarations privées } FEnabled: Boolean; FInterval: Cardinal; // Sont juste là pour permettre l'interaction utilisateur FThrd: TTimerThrd; FOnTimer: TNotifyEvent; procedure SetOnTimer(Value: TNotifyEvent); procedure SetEnabled(Value: Boolean); procedure SetInterval(Value: Cardinal); protected { Déclarations protégées } public { Déclarations publiques } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Déclarations publiées } property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; property Enabled: Boolean read FEnabled write SetEnabled; property Interval: Cardinal read FInterval write SetInterval; procedure Timer(Sender: TObject); dynamic; // Procédure dynamique qui appelle le gestionnaire de Timer end; TTimerThrd = class(TThread) private FEnabled: Boolean; FInterval: Cardinal; FTimer: TNotifyEvent; procedure CentralControl; public constructor Create(CreateSuspended:boolean); protected procedure Execute; override; end; procedure Register; implementation // Je vais modifier cette fonction pour la rendre plus lisible à moi // Je cite donc son auteur : Rylryl !! procedure Wait(MS: int64); var Frq_Base, T_Mem, T_Now, Dif: Int64; begin // On récupère l'indice fréquence du système if QueryPerformanceFrequency(Frq_Base) then begin // On récupère le repère temps origine QueryPerformanceCounter(T_Mem); repeat // On récupère le temps actuel QueryPerformanceCounter(T_Now); // On compare le temps actuel au temps d'origine Dif := (T_Now - T_Mem) * 1000000 div Frq_Base; until Dif > MS; // Jusqu'à ce qu'on ai atteint notre délai voulu end; end; procedure Register; begin RegisterComponents('Bacterius', [TMicroTimer]); end; constructor TMicroTimer.Create(AOwner: TComponent); begin inherited Create(AOwner); FInterval := 1000; FEnabled := True; FThrd := TTimerThrd.Create(True); FThrd.FEnabled := True; FThrd.FInterval := 1000; FOnTimer := nil; FThrd.FTimer := Timer; end; destructor TMicroTimer.Destroy; begin FEnabled := False; FThrd.Terminate; inherited Destroy; end; procedure TMicroTimer.Timer(Sender: TObject); begin if Assigned(FOnTimer) then FOnTimer(self); end; procedure TMicroTimer.SetOnTimer(Value: TNotifyEvent); begin FOnTimer := Value; end; procedure TMicroTimer.SetEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; FThrd.FEnabled := Value; end; end; procedure TMicroTimer.SetInterval(Value: Cardinal); begin if Value <> FInterval then begin FInterval := Value; FThrd.FInterval := Value; end; end; {------------------------------------------------------------------------------- ------------------ FONCTIONS RELATIVES AU THREAD PERIODIQUE -------------------- -------------------------------------------------------------------------------} constructor TTimerThrd.Create(CreateSuspended: Boolean); // Création du thread begin inherited Create(CreateSuspended); // On crée le thread FreeOnTerminate := False; // On le libérera nous-même c'est plus sûr Resume; Priority := tpLowest; // Pour éviter que le système ne plante // En effet, le système est tellement sollicité qu'il est capable de perdre le contrôle // donc, la plus basse priorité (et ce n'est pas encore assez !) // mais pas tpIdle, car sinon en cas d'activité intensive (jeu 3D, par exemple), le thread // n'aurait jamais la main (le système ne serait jamais en attente !) end; procedure TTimerThrd.CentralControl; // Procédure principale begin FTimer(self); end; procedure TTimerThrd.Execute; // Boucle principale begin repeat // On répète l'execution du thread ... if GetTickCount mod 1000 = 0 then Application.ProcessMessages; // On laisse l'application traiter ses messages if (not FEnabled) or (csDesigning in Application.ComponentState) then Continue; Wait(FInterval); Synchronize(CentralControl); // On synchronise until Terminated; // ... jusqu'à ce que le thread soit terminé end; end. __________________________________ Et voilà ! Par contre Francky - je n'ai pas fait de double procédure Register ? Cordialement, Bacterius !

Bacterius · Answer

Et : truc étrange, je soupconne ...

procedure Timer(Sender: TObject); dynamic;
                                    ||
                                    \/
             ...  le dynamic d'être la cause du fonctionnement

Même si je l'ai vraiment mis au hasard, le dynamic (je pensais que j'avais foiré tous mes pointeurs).

Cordialement, Bacterius !

Bacterius · Answer

Et voilà le composant terminé pour l'instant : ______________________________________________ {------------------------------- MICRO TIMER ----------------------------------} { Ce composant s'utilise exactement comme un Timer normal, sauf que l'intervalle est en microsecondes : donc, 1 => 1 microseconde, 1000 => 1 milliseconde, et 1000000 => 1 seconde. Code lourdement commenté. Auteur : Bacterius (thomas.beneteau@yahoo.fr, thomas777@live.fr). Pour tout Delphi inférieur à Delphi 4 : changez Int64 en Cardinal - pas trop de conséquences. --- AVERTISSEMENT --- Dans la création du thread, NE MODIFIEZ PAS LA PRIORITE DU THREAD : ELLE A ETE MUREMENT DECIDEE : SI VOUS LA METTEZ PLUS HAUT, ELLE PEUT CAUSER L'INTERRUPTION TOTALE DU SYSTEME, VOUS FORCANT A REDEMARRER. Zut, maintenant je vais voir mon composant dans des virus ... En passant, n'en mettez pas des tonnes dans une application : 4 MicroTimers, c'est un maximum ! -------------------------------------------------------------------------------} unit MicroTimer; // MicroTimer ! interface uses Windows, Messages, SysUtils, Classes, Forms; // Unités requises type TTimerThrd = class; // Classe non définie pour l'instant de TTimerThrd (pour des raisons de compilation) TNotifyEvent = procedure(Sender: TObject) of object; // Définition de TNotifyEvent TMicroTimer = class(TComponent) // Notre composant Timer !! private { Déclarations privées } FEnabled: Boolean; // Champ objet Enabled FInterval: Int64; // Champ objet Interval FThrd: TTimerThrd; // Variable du thread timer FOnTimer: TNotifyEvent; // Gestionnaire d'évènement OnTimer procedure SetOnTimer(Value: TNotifyEvent); // Setter OnTimer procedure SetEnabled(Value: Boolean); // Setter Enabled procedure SetInterval(Value: Int64); // Setter Interval protected { Déclarations protégées } public { Déclarations publiques } constructor Create(AOwner: TComponent); override; // Constructeur destructor Destroy; override; // Destructeur published { Déclarations publiées } property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; // Evènement OnTimer property Enabled: Boolean read FEnabled write SetEnabled; // Propriété Enabled property Interval: Int64 read FInterval write SetInterval; // Propriété Interval procedure Timer(Sender: TObject); dynamic; // Procédure dynamique qui appelle le gestionnaire de Timer end; TTimerThrd = class(TThread) private FEnabled: Boolean; // Champ objet Enabled (strictement identique à celui de TMicroTimer) FInterval: Cardinal; // Champ objet Interval (strictement identique à celui de TMicroTimer) FTimer: TNotifyEvent; // Pointeur de méthode vers la procédure Timer de TMicroTimer procedure CentralControl; // Procédure principale du thread public constructor Create(CreateSuspended: Boolean); // Constructeur du thread protected procedure Execute; override; // Boucle principale du thread end; procedure Register; // Déclaration du recensement du composant implementation // Je vais modifier cette fonction pour la rendre plus lisible à moi // Je cite donc son auteur : Rylryl !! procedure Wait(MS: int64); // On fait une pause en microsecondes !! var Frq_Base, T_Mem, T_Now, Dif: Int64; begin // On récupère l'indice fréquence du système if QueryPerformanceFrequency(Frq_Base) then begin // On récupère le repère temps origine QueryPerformanceCounter(T_Mem); repeat // On récupère le temps actuel QueryPerformanceCounter(T_Now); // On compare le temps actuel au temps d'origine Dif := (T_Now - T_Mem) * 1000000 div Frq_Base; until Dif > MS; // Jusqu'à ce qu'on ai atteint notre délai voulu end; end; procedure Register; // Recensement du composant begin RegisterComponents('Bacterius', [TMicroTimer]); // On enregistre le composant ! end; constructor TMicroTimer.Create(AOwner: TComponent); // Création du composant begin inherited Create(AOwner); // On crée le TComponent qui se cache derrière mon timer :) FInterval := 1000000; // 1 seconde d'intervalle (héhé oui c'est en microsecondes !!) FEnabled := True; // On l'active par défaut FThrd := TTimerThrd.Create(True); // On crée le thread FThrd.FEnabled := True; // On fait pareil qu'avec le timer dans le thread FThrd.FInterval := 1000000; // Pareil pour le thread - ultra-important FOnTimer := nil; // Même chose ... FThrd.FTimer := Timer; // Attention : ça devient interessant : // on établit un lien entre la procédure du thread et celle du timer ! end; destructor TMicroTimer.Destroy; // Destruction du composant begin FThrd.FEnabled := False; // On arrête le timer FThrd.Suspend; // On arrête le thread FThrd.Terminate; // On éteint le thread inherited Destroy; // On détruit notre composant ! end; procedure TMicroTimer.Timer(Sender: TObject); // Procédure qui appelle le gestionnaire d'évènement OnTimer begin if Assigned(FOnTimer) then FOnTimer(self); // Si le gestionnaire est assigné alors on l'execute, sinon on ne fait rien ! end; procedure TMicroTimer.SetOnTimer(Value: TNotifyEvent); // On définit le gestionnaire d'évènement begin FOnTimer := Value; // On remplace le gestionnaire d'évènement par Value end; procedure TMicroTimer.SetEnabled(Value: Boolean); // On définit l'état du timer begin if Value <> FEnabled then // Si l'état voulu est différent de celui d'avant begin FEnabled := Value; // On change FThrd.FEnabled := Value; // On change aussi dans le thread end; end; procedure TMicroTimer.SetInterval(Value: Int64); // On change l'intervalle du timer begin if Value <> FInterval then // Si l'ancien et le nouveau sont différents begin FInterval := Value; // On change FThrd.FInterval := Value; // On change aussi dans le thread end; end; {------------------------------------------------------------------------------- ------------------ FONCTIONS RELATIVES AU THREAD PERIODIQUE -------------------- -------------------------------------------------------------------------------} constructor TTimerThrd.Create(CreateSuspended: Boolean); // Création du thread begin inherited Create(CreateSuspended); // On crée le thread FreeOnTerminate := False; // On le libérera nous-même c'est plus sûr Resume; // On lance notre thread Priority := tpLowest; // Pour éviter que le système ne plante // En effet, le système est tellement sollicité qu'il est capable de perdre le contrôle // donc, la plus basse priorité (et ce n'est pas encore assez !) // mais pas tpIdle, car sinon en cas d'activité intensive (jeu 3D, par exemple), le thread // n'aurait jamais la main (le système ne serait jamais en attente !) end; procedure TTimerThrd.CentralControl; // Procédure principale begin FTimer(self); // On execute la procédure qui est censée lancer le gestionnaire d'évènement // En réalité on lance une procédure qui pointe vers celle citée plus haut ^^ end; procedure TTimerThrd.Execute; // Boucle principale begin repeat // On répète l'execution du thread ... if GetTickCount mod 1000 = 0 then Application.ProcessMessages; // On laisse l'application traiter ses messages // de temps en temps ... toutes les secondes en fait x) if (not FEnabled) or (csDesigning in Application.ComponentState) then Continue; Wait(FInterval); Synchronize(CentralControl); // On synchronise until Terminated; // ... jusqu'à ce que le thread soit terminé end; end. ______________________________________________ Bientôt sur vos écrans ! (je le posterai bientôt sur DelphiFr, avec une démo). Cordialement, Bacterius !

Bacterius · Answer

Bon j'ai juste modifié 2 - 3 trucs, je passe à l'exemple : mais vous ne le verrez probablement que le week-end prochain ...

Cordialement, Bacterius !

Francky23012301 · Answer

Ah oué désolé : j'ai lu trop vite ton code.

Par contre : FInterval: Cardinal;  par contre FInterval:Integer; 
Il y a rien de plus chiant avec les Timer que de se trimballer un interval définit comme un cardinal (Voir les alertes signés/non signés du compilo)

Bacterius · Answer

Ouaip Francky c'est ce que j'ai changé dans le code : j'ai mis Int64 comme type, et à chaque fois il renvoie la valeur absolue de l'intervalle ;)

@Cirec : oui ... mais est-ce que le MMTimer gère les ... microsecondes ???? Bon je sais que un intervalle de 1 µs c'est débile, mais ça peut être utile pour ceux qui veulent des intervalles à 1 seconde moins 100 µs par exemple ;)
Et puis ça nous fait toujours la main sur les threads et les composants, ainsi que les pointeurs, un peu ... Merci néanmoins pour le lien, je le cherchais justement, car je voulais ce timer dans ma palette, mais je ne me souvenais plus du nom du timer ...

Merci :)

Cordialement, Bacterius !

Cirec · Answer

teste correctement ton timer .... tu n'arriveras pas à une telle précision !!!!

et je pense même que le tien sera moins précis que le MMTimer ... utilise le code Kenavo pour faire les testes 

Mais ATTENTION ne pas faire les testes dans l'IDE !!!! Delphi fausse les résultats 

 
@+
Cirec

<hr siz="" />

Francky23012301 · Answer

En meme temps le timer de Kenavo est gourmand en ressources si je me souviens bien. Je vais tester ton Timer Bacterius car le sujet me touche de près en ce moment ;).

Cirec · Answer

oui il l'est ... 
mais en y réfléchissant c'est normal c'est le prix à payer pour une précision quasi sans faille 
 
@+
Cirec

<hr siz="" />

Bacterius · Answer

On va bien voir, je poste mon TMicroTimer maintenant !

Cordialement, Bacterius !

Cirec · Answer

moi je testerai avant ... si j'étais toi 

 
@+
Cirec

<hr siz="" />

Bacterius · Answer

J'ai testé Delphi-Free, pour l'instant, pour 1 seconde de test à 1 µseconde d'intervalle, je reçois 52448 événements ;)
Soit un maigre 5,2448% de réussite ... Mais bon ! C'est toujours bien ^^

Cordialement, Bacterius !

Bacterius · Answer

Et puis mon processeur n'est pas top non plus ^^

Cordialement, Bacterius !

Classe TThread dans composant, liaison entre deux instances ?

16 réponses

Votre réponse

Discussions similaires