Subversion Repositories spacemission

Rev

Blame | Last modification | View Log | RSS feed

  1. {
  2.  SXMedia  Components - Beta 1
  3.  --------------------------------
  4.  Copyright 1999 Dean Ellis
  5.  http://www.sillex.freeserve.co.uk
  6.  
  7.  This unit is part of the SXMedia Component Set. This code is
  8.  supplied as is with no guarantees and must be used at your own
  9.  risk.
  10.  
  11.  No modifications to this code must be made without the express
  12.  permission of the author. Please report any problems to
  13.  support@sillex.freeserve.co.uk
  14.  
  15.  You may use these components to create any freeware/shareware
  16.  applications that you wish. If the components are to be used in
  17.  a commercail product then credit for developement of these components
  18.  should be given.
  19.  
  20.  Credits :
  21.  
  22.  Developer : Dean Ellis
  23.  Testers   : Dominique Louis
  24.              Ivan Blecic
  25. }
  26. unit SXEngine;
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, MMSystem;
  32.  
  33. type
  34.   TFramesPerSecond = 1..100;
  35.   TFreeCyclesEvent = procedure (Sender: TObject; Count:Integer) of object;
  36.  
  37.   TSXEngine = class(TComponent)
  38.      private
  39.        { Private Data Members }
  40.        FFramesPerSecond:TFramesPerSecond;
  41.        FEnabled:Boolean;
  42.        FThreadPriority:TThreadPriority;
  43.        FFPS:Integer;
  44.        FActivate:TNotifyEvent;
  45.        FDeActivate:TNotifyEvent;
  46.        FRender:TNotifyEvent;
  47.        FFreeCycles:TFreeCyclesEvent;
  48.      protected
  49.        { Property Accessors }
  50.        procedure SetTargetFPS(Value:TFramesPerSecond);
  51.        function GetTargetFPS:TFramesPerSecond;
  52.        procedure SetEnabled(Value:Boolean);
  53.        procedure SetThreadPriority(Value:TThreadPriority);
  54.        { Notification methods }
  55.        procedure DoRender;
  56.        procedure DoActivate;
  57.        procedure DoDeActivate;
  58.        procedure DoFreeCycles(Count: Integer);
  59.        { Class Helper methods }
  60.      public
  61.        { Public methods }
  62.        constructor Create(AOwner:TComponent);override;
  63.        destructor Destroy; override;
  64.        {Public Properties}
  65.        property FramesPerSecond : Integer read FFPS write FFPS;
  66.      published
  67.        { Published properties }
  68.        property TargetFPS : TFramesPerSecond read GetTargetFPS write SetTargetFPS default 30;
  69.        property Enabled : Boolean read FEnabled write SetEnabled default False;
  70.        property ThreadPriority : TThreadPriority read FThreadPriority write SetThreadPriority;
  71.        { Published Events}
  72.        property OnActivate : TNotifyEvent read FActivate write FActivate;
  73.        property OnDeActivate : TNotifyEvent read FDeActivate write FDeActivate;
  74.        property OnRender : TNotifyEvent read FRender write FRender;
  75.        property OnFreeCycles : TFreeCyclesEvent read FFreeCycles write FFreeCycles;
  76.   end;
  77.  
  78. implementation
  79. {$J+}
  80. const
  81.    FPS : Single = 33.3;
  82.    SECOND : Single = 1000.0;
  83.  
  84. type
  85.   TGameThread = class(TThread)
  86.      private
  87.        { Private declarations }
  88.        FThreadCallback:TThreadMethod;
  89.      protected
  90.        procedure Execute; override;
  91.        property ThreadCallback: TThreadMethod read FThreadCallback write FThreadCallback;
  92.      public
  93.        constructor Create(CreateSupsended:Boolean;Callback:TThreadMethod);
  94.   end;
  95.  
  96. var Thread:TGameThread;
  97. { Important: Methods and properties of objects in VCL can only be used in a
  98.   method called using Synchronize, for example,
  99.  
  100.       Synchronize(UpdateCaption);
  101.  
  102.   and UpdateCaption could look like,
  103.  
  104.     procedure TGameThread.UpdateCaption;
  105.     begin
  106.       Form1.Caption := 'Updated in a thread';
  107.     end; }
  108.  
  109. { TGameThread }
  110.  
  111. procedure TGameThread.Execute;
  112. begin
  113.   { Place thread code here }
  114.   while not Terminated do
  115.   begin
  116.      try
  117.      if Assigned(ThreadCallback) then Synchronize(ThreadCallback);
  118.      except
  119.        Terminate;
  120.      end;
  121.   end;
  122. end;
  123. constructor TGameThread.Create(CreateSupsended:Boolean;Callback:TThreadMethod);
  124. begin
  125.    inherited Create(CreateSupsended);
  126.    ThreadCallback := Callback;
  127. end;
  128.  
  129. { TSXEngine }
  130. constructor TSXEngine.Create(AOwner:TComponent);
  131. begin
  132.   inherited Create(AOwner);
  133.   if not (csDesigning in ComponentState) then
  134.   begin
  135.      if not Assigned(Thread) then
  136.      begin
  137.        Thread := TGameThread.Create(True,DoRender);
  138.        Thread.FreeOnTerminate := False;
  139.        Thread.Priority := ThreadPriority;
  140.        Thread.Suspended := not Enabled;
  141.      end;
  142.      DoActivate;
  143.   end;
  144.   Enabled := False;
  145.   TargetFPS := 30;
  146. end;
  147. destructor TSXEngine.Destroy;
  148. begin
  149.   if not (csDesigning in ComponentState) then
  150.   begin
  151.      if Assigned(Thread) then
  152.      begin
  153.         Thread.Terminate;
  154.         Thread.Free;
  155.      end;
  156.      DoDeActivate;
  157.   end;
  158.   inherited Destroy;
  159. end;
  160. procedure TSXEngine.SetTargetFPS(Value:TFramesPerSecond);
  161. begin
  162.    FFramesPerSecond := Value;
  163.    FPS := SECOND / Value;
  164. end;
  165. function TSXEngine.GetTargetFPS:TFramesPerSecond;
  166. begin
  167.    Result := FFramesPerSecond;
  168. end;
  169. procedure TSXEngine.SetEnabled(Value:Boolean);
  170. begin
  171.   FEnabled := Value;
  172.   if Thread <> nil then
  173.      Thread.Suspended := not Value;
  174. end;
  175. procedure TSXEngine.SetThreadPriority(Value:TThreadPriority);
  176. begin
  177.    FThreadPriority := Value;
  178.    if Thread <> nil then
  179.       Thread.Priority := Value;
  180. end;
  181. procedure TSXEngine.DoRender;
  182. const Start:DWord = 0;
  183.       OldStart:DWord = 0;
  184.       Count:Integer =0;
  185. var FreeCycleCount:integer;
  186. begin
  187.   try
  188.      Start := TimeGetTime;
  189.      FreeCycleCount := 0;
  190.      if Assigned(FRender) then FRender(Self);
  191.      if (Start - OldStart) < SECOND then
  192.         Inc(Count)
  193.      else
  194.      begin
  195.         FramesPerSecond := Count;
  196.         OldStart := Start;
  197.         Count := 0;
  198.      end;
  199.      repeat
  200.         DoFreeCycles(FreeCycleCount);
  201.         inc(FreeCycleCount);
  202.      until (TimeGetTime - Start) >= FPS;
  203.   except
  204.     Enabled := False;
  205.     Thread.Terminate;
  206.   end;
  207. end;
  208. procedure TSXEngine.DoActivate;
  209. begin
  210.   if Assigned(FActivate) then FActivate(Self);
  211. end;
  212. procedure TSXEngine.DoDeActivate;
  213. begin
  214.   if Assigned(FDeActivate) then FDeActivate(Self);
  215. end;
  216. procedure TSXEngine.DoFreeCycles(Count: Integer);
  217. begin
  218.   if Assigned(FFreeCycles) then FFreeCycles(Self,Count);
  219. end;
  220.  
  221. end.
  222.