From: Carl Caulkett <carlca@dircon.co.uk>
Subject: Re: stumped on multimedia timers
Date: 16 Mar 1999 00:00:00 GMT
Message-ID: <36EEC3DB.D94EB3FD@dircon.co.uk>
Content-Transfer-Encoding: 7bit
References: <36EE9548.A29E1E01@jacobs.com>
X-Accept-Language: en
Content-Type: text/plain; charset=us-ascii
Organization: Another Netscape Collabra Server User
Mime-Version: 1.0
Reply-To: carlca@dircon.co.uk
Newsgroups: borland.public.delphi.winapi

Hi Jim,

Here is a thread based timer component that I use for driving midi apps
...

Hope it helps,
Carl

====== CODE BEGINS =======
unit caTimer;

interface

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

type
  TcaTimer = class;


//---------------------------------------------------------------------------
  // TcaTimerThread

//---------------------------------------------------------------------------
  TcaTimerThread = class(TThread)
  private
    FTimer: TcaTimer;
  protected
    procedure DoExecute;
  public
    constructor CreateTimerThread(Timer: TcaTimer);
    procedure Execute; override;
  end;


//---------------------------------------------------------------------------
  // TcaTimer

//---------------------------------------------------------------------------
  TcaTimer = class(TComponent)
  private
    FInterval: Integer;
    FPriority: TThreadPriority;
    FOnTimer: TNotifyEvent;
    FContinue: Boolean;
    FRunning: Boolean;
    FEnabled: Boolean;
    procedure SetEnabled(Value: Boolean );
  protected
    procedure StartTimer;
    procedure StopTimer;
    property Continue: Boolean read FContinue write FContinue;
  public
    constructor Create(Owner: TComponent); override;
    procedure On;
    procedure Off;
  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Interval: Integer read FInterval write FInterval;
    property ThreadPriority: TThreadPriority read FPriority write
FPriority default tpNormal;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TcaTimer]);
end;

//-----------------------------------------------------------------------------
// TcaTimerThread
//-----------------------------------------------------------------------------
constructor TcaTimerThread.CreateTimerThread(Timer: TcaTimer);
begin
  inherited Create(True);
  FTimer := Timer;
  FreeOnTerminate := True;
end;

procedure TcaTimerThread.Execute;
var
  SleepTime, Last: Integer;
begin
  while FTimer.Continue do
    begin
      Last := timeGetTime;
      Synchronize(DoExecute);
      SleepTime := FTimer.FInterval - (timeGetTime - Last);
      if SleepTime < 10 then SleepTime := 10;
      Sleep(SleepTime);
    end;
end;

procedure TcaTimerThread.DoExecute;
begin
  if Assigned(FTimer.OnTimer) then FTimer.OnTimer(FTimer);
end;

//-----------------------------------------------------------------------------
// TcaTimer
//-----------------------------------------------------------------------------
constructor TcaTimer.Create(Owner: TComponent);
begin
  inherited;
  FPriority := tpNormal;
end;

procedure TcaTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
    begin
      FEnabled := Value;
      if FEnabled then
        StartTimer
      else
        StopTimer;
    end;
end;

procedure TcaTimer.StartTimer;
begin
  if FRunning then Exit;
  FContinue := True;
  if not (csDesigning in ComponentState) then
    begin
      with TcaTimerThread.CreateTimerThread(Self) do
        begin
          Priority := FPriority;
          Resume;
        end;
    end;
  FRunning := True;
end;

procedure TcaTimer.StopTimer;
begin
  FContinue := False;
  FRunning := False;
end;

procedure TcaTimer.On;
begin
  StartTimer;
end;

procedure TcaTimer.Off;
begin
  StopTimer;
end;

end.

====== CODE ENDS ======


"jim.stanley" wrote:
>
> Hello all,
>
> I've been trying to use the multimedia timer functions in MMSYSTEM.DLL
> to output MIDI Note on and note off messages and have run into some
> serious, system-locking problems.
>
---8<---
>
> I'd be grateful for any advice offered.  Right now, I've got a small
> success by using the regular TTimer, but it's not very reliable at all.
> (Would it be in a separate thread?)
>
> Jim Stanley
> Jacobs Engineering