Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Eigene Timer Komponente (https://www.delphipraxis.net/65848-eigene-timer-komponente.html)

Surrounder 21. Mär 2006 13:25


Eigene Timer Komponente
 
Hallo Forum,

da ich in vielen Projekten einen eigenen Timer verwende dachte ich, ich könnte aus der Unit schnell mal eine eigene Komponente machen. Ich weiss es gibt schon einen Timer, aber ich hab eine Kommunikation mit einer Hardware die ich selber Triggern muss und ich sollte das ca. alle 10ms tun, und der Standard Timer schafft das nicht.

Leider komm ich irgendwie nicht weiter, hab schon so ziemlich alle Tutorials gelesen die ich ergoogelt habe nur hab ich immer noch Probleme mit einem selber erzeugten Event.

Ich poste mal den Code:

Delphi-Quellcode:
unti MTimer101

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, ExtCtrls, mmsystem;

const
   Time_Elapsed_Msg = WM_User + 12;

type
   TOnMTimer = procedure of object;

   TMTimer      = class( TCustomControl )
   private
      FTime      : Integer;
      FEnabled : Boolean;
      Zeit      : Int64;
      Timerid   : Integer;
      FOnTimer : TOnMTimer;
   protected
      //
   public
      constructor Create( AOwner : TComponent ); override;
      destructor   Destroy; override;
      procedure   Enable( State : Boolean );
      procedure   WndProc(var Msg: TMessage); override;
      procedure   OnMyMessage( var Msg : TMessage ) ; message Time_Elapsed_Msg;
   published
      property      Time       : Integer         read FTime       write FTime;
      property      Enabled   : Boolean         read FEnabled   write FEnabled;
      property      OnTimer   : TOnMTimer       read FOnTimer   write FOnTimer;
   end;

procedure Register;

implementation

procedure Register;
begin
   RegisterComponents('Standard', [TMTimer]);
end;

{ TmtsppTimer }

procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD); stdcall; pascal;
begin
//   Sendmessage( HWnd( dwUser ), Time_Elapsed_Msg, 0, 0 );//eine Message wird verschickt
   Sendmessage( HWnd( HWND_BROADCAST ), Time_Elapsed_Msg, 0, 0 );//eine Message wird verschickt
end;

constructor TMTimer.Create( AOwner : TComponent );
begin
   inherited Create( AOwner );
end;

destructor TMTimer.Destroy;
begin
   if FEnabled then
      timeKillEvent( Timerid ); //Timer freigeben
   inherited Destroy;
end;

procedure TMTimer.Enable( State : Boolean );
begin
   FEnabled := State;
   if FEnabled then begin
         Timerid := TimeSetEvent( 1, 0, @TimeCallBack, 0, TIME_PERIODIC );
         Zeit := Timegettime ; //Die Startzeit wird ermittelt
   end
   else begin
      timeKillEvent( Timerid ); //Timer freigeben
   end;
end;

procedure TMTimer.OnMyMessage(var Msg: TMessage);
begin
   if Msg.Msg = Time_Elapsed_Msg then begin
      OnTimer; //Timercode ausführen
   end;
end;

procedure TMTimer.WndProc(var Msg: TMessage);
begin
   if Msg.Msg = Time_Elapsed_Msg then begin
      OnTimer; //Timercode ausführen
   end;
   inherited;
end;
Und hier mein Testprogramm das den Timer einbindet:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MTimer101, Menus, cxLookAndFeelPainters, StdCtrls, cxButtons;

type
  TForm1 = class(TForm)
    cxButton1: TcxButton;
    procedure cxButton1Click(Sender: TObject);
    procedure OnTimer();
  private
    { Private-Deklarationen }
  public
      Test : TMTimer;
      Count : Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.cxButton1Click(Sender: TObject);
begin
   Count := 0;
   Test := TMTimer.Create( nil );
   Test.OnTimer := OnTimer;
   Test.Enable( True );
end;

procedure TForm1.OnTimer;
begin
   INC( Count );
end;
Problem ist dass wie gesagt das Event das ich dachte so einfach mal selber zu erzeugen ( OnTimer ) entweder nicht ausgeführt wird, oder aber eine Exception kommt.

Danke für jeden Tip und Hinweis.


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:38 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz