unit DXMisc;
// Contains miscellaneous code
interface
uses classes, controls;
type
// This obtains the co-ords for the mouse relative to a control
TMousePos = class(Tobject)
private
{ Private declarations }
// Data
fControl: TControl;
fMouseX: integer;
fMouseY: integer;
fXDelta: integer;
fYDelta: integer;
// used to scale the mouse input
fSensitivity: Single;
// Options
fClipToControl: boolean;
protected
{ Protected declarations }
procedure SetClipState(Value: boolean);
public
{ Public declarations }
constructor Create(Control: TControl);
destructor Destroy; override;
// Sets the control to use
procedure SetControl(AControl: TControl);
// Grabs the latest mouse co-ords
procedure Update;
// Relative to the parent control
property MouseX: integer read fMouseX;
property MouseY: integer read fMouseY;
property XDelta: integer read fXDelta;
property YDelta: integer read fYDelta;
// The sensitivity of the mouse
property Sensitivity: Single read fSensitivity write fSensitivity;
property ClipToControl: Boolean read fClipToControl write SetClipState;
property Control: TControl read fControl write SetControl;
published
{ Published declarations }
end;
// This is an example of how to cap the frame rate
// this has NOT been optimized and is just to hide the relatively
// mess code needed to properly calc the time delta for a frame
// and the time delta since the last render
TTiming = class(TObject)
protected
{ Protected declarations }
// Used to implement frame capping
fGraphicsTimeDelta: longword;
LastTimeFrame: longword;
// the number of ms each frame has in its budget
FrameRateBudget: longword; // this is just for the graphics system
// see the properties section
fTimeDelta: longword;
TimeFrame: longword;
fFrameRate: longword;
fFrameRateGoal: longword;
fNoGraphics: boolean;
// sets up various timing stuff
procedure InitTiming(FrameRate: longword);
public
{ Public declarations }
constructor Create(AFrameRateGoal: longword);
// Calculates the time delta from the last frame
procedure CalcNewTimeDelta;
// Checks if the designated time till the next render has passed
function TimeToRender: boolean;
// Prepares internal info for the next frame
procedure UpdateGraphicsTimeDelta;
procedure CalcFrameRate;
property GraphicsTimeDelta: longword read fGraphicsTimeDelta;
// used to determine how much time has elapsed from the last frame in ms
property TimeDelta: longword read fTimeDelta;
// The timestamp for the current frame
property FrameStamp: longword read TimeFrame;
// The frame rate that is being achieved
property FrameRate: longword read fFrameRate;
// The goal frame rate for the frame skipping mechanism
// This also Limits the frame rate to this to
property FrameRateGoal: longword read fFrameRateGoal write InitTiming;
// TimeTorender always returns false, used to disable graphics stuff
property NoGraphics: boolean read fNoGraphics write fNoGraphics;
end;
TStateMachine = class;
TState = class(TObject) // a state aware class
private
fStateIndex: integer;
fStateMachine: TStateMachine;
public
constructor Create; virtual;
procedure Execute; virtual; abstract;
property StateIndex: integer read fStateIndex;
property StateMachine: TStateMachine read fStateMachine;
end;
// This is a state machine which removes the need for large case statements when executing the current state
TStateMachine = class(TObject)
private
{ Private declarations }
protected
{ Protected declarations }
// Holds a list of the valid states
fStatesList: Tlist;
// the number of states
fStates: integer;
// The max number of allowed states
fMaxStates: integer;
// The current state
fCurrentState: TState;
// Function GetState(index :integer) : TState; virtual;
public
{ Public declarations }
constructor Create;
destructor Destroy; override;
// This registers a state, if the state exists then it is updated
// Dont pass < 0 as the state constant
procedure AddState(State: TState); virtual;
// This removes a registerd state
procedure RemoveState(State: TState); virtual;
// This clears all the states
procedure ClearStates; virtual;
// allows easy state changes
procedure ActivateNextState; virtual;
// The current state's id
property CurrentState: TState read fCurrentState write fCurrentState;
// The Number of valid states
property States: integer read fStates;
property MaxStates: integer read fMaxStates write fMaxStates;
{
// Allows direct access to the states of an object
Property StateList[index :integer] : TState read GetState;
}
property StateList: Tlist read fStatesList;
end;
const
// This is the default strating number of states the TStateMachine will allocate
StartStates = 16; // This is also what it allocates when it tries to add a new state
MaxNumStates = 255; // this is the max number of states allowed. Why would you want more :)
// Scans a Component and the components owned by the Component for a Component of the class type 'Classtype'
function FindComponentType(Aowner: TComponent; Classtype: TComponentClass): TComponent;
implementation
uses windows, Sysutils, mmsystem;
function FindComponentType(Aowner: TComponent; Classtype: TComponentClass): TComponent;
var
index: integer;
begin
if not assigned(AOwner) then
begin
result := nil;
exit;
end;
if AOwner is Classtype then
begin
result := AOwner;
end
else
begin
// For some reason, when in the designer AOwner.ComponentIndex = -1!
// thus this search algo would failed in designer mode
for index := 0 to AOwner.ComponentCount - 1 do
begin
if AOwner.Components[index] is Classtype then
begin
result := AOwner.Components[index];
exit;
end;
end;
result := nil;
end;
end;
// -----------------------------------------------------------------------------
// TTiming
// -----------------------------------------------------------------------------
constructor TTiming.Create(AFrameRateGoal: longword);
begin
inherited create;
FrameRateGoal := AFrameRateGoal;
InitTiming(FrameRateGoal);
end; {TTiming}
procedure TTiming.InitTiming(FrameRate: longword);
begin
fFrameRateGoal := FrameRate;
FrameRateBudget := 1000 div fFrameRateGoal;
fGraphicsTimeDelta := 0;
fTimeDelta := 0;
TimeFrame := timegettime;
LastTimeFrame := TimeFrame;
end; {InitTiming}
procedure TTiming.CalcNewTimeDelta;
var
NewTimeFrame: Longword;
begin
// update the time delta & time frame stamps
NewTimeFrame := TimeGetTime;
fTimeDelta := NewTimeFrame - TimeFrame;
TimeFrame := NewTimeFrame;
end; {CalcNewTimeDelta}
procedure TTiming.UpdateGraphicsTimeDelta;
begin
// get how long it took to render the frame
LastTimeFrame := timegettime;
fGraphicsTimeDelta := 0;
end;
procedure TTiming.CalcFrameRate;
begin
if GraphicsTimeDelta <> 0 then
fFrameRate := 1000 div GraphicsTimeDelta
else
fFrameRate := 0;
end; {CalcFrameRate}
function TTiming.TimeToRender: boolean;
begin
// Check to see if we can update the screen
fGraphicsTimeDelta := Timegettime - LastTimeFrame;
result := (GraphicsTimeDelta >= FrameRateBudget) and (not fNoGraphics);
end; {TimeToRender}
// -----------------------------------------------------------------------------
// TMousePos
// -----------------------------------------------------------------------------
constructor TMousePos.Create(Control: TControl);
begin
inherited Create;
if not assigned(Control) then
raise Exception.Create('Parent can''''t = nil');
fSensitivity := 1.0;
fClipToControl := true;
SetControl(Control);
end; {Create}
destructor TMousePos.Destroy;
begin
SetControl(nil);
inherited;
end; {Destroy}
procedure TMousePos.SetControl(AControl: TControl);
begin
assert(self <> nil);
if assigned(AControl) then
begin
fControl := AControl;
// This gets the intitial value
Update;
// This gets the correct mouse X,Y deltas
Update;
end
else
begin
fControl := nil;
end;
end; {SetControl}
procedure TMousePos.SetClipState(Value: boolean);
begin
if fClipToControl <> value then
begin
fClipToControl := Value;
// Re-obtain the co-ords with the correct option
Update;
end;
end; {SetClipState}
procedure TMousePos.Update;
var
pos: TPoint;
begin
// Get the latest mouse info
pos := mouse.CursorPos;
// Convert them to relative to the Control
pos := fControl.ScreenToClient(pos);
if fClipToControl then
begin
if pos.x >= fControl.width then
pos.x := fControl.width - 1
else if pos.x < 0 then
pos.x := 0;
if pos.Y >= fControl.Height then
pos.Y := fControl.Height - 1
else if pos.Y < 0 then
pos.Y := 0;
end;
// Update the mouse delta's
// fmouse? = old mouse pos
// pos.? = new mouse pos
fXDelta := pos.X - fMouseX;
fYDelta := pos.Y - fMouseY;
// Scale the mouse co-ords
if fSensitivity - 1.0 > 0.00001 then
begin
fMouseX := fMouseX + Trunc(fXDelta * fSensitivity);
fMouseY := fMouseY + Trunc(fYDelta * fSensitivity);
end
else
begin
fMouseX := pos.X;
fMouseY := pos.Y;
end;
end; {Update}
// -----------------------------------------------------------------------------
// TStateMachine
// -----------------------------------------------------------------------------
constructor TStateMachine.Create;
begin
inherited;
fMaxStates := MaxNumStates;
fStatesList := Tlist.create;
end; {Create}
destructor TStateMachine.Destroy;
begin
ClearStates;
fStatesList.free;
inherited;
end; {Destroy}
procedure TStateMachine.AddState(State: TState);
begin
if (fStatesList.IndexOf(State) = -1) and
(fStates < MaxStates) then
begin
State.fStateIndex := fStatesList.add(State);
State.fStateMachine := self;
if fCurrentState = nil then
fCurrentState := state;
inc(fStates);
end;
end; {AddState}
procedure TStateMachine.RemoveState(State: TState);
var
index: integer;
begin
index := fStatesList.IndexOf(State);
if (index <> -1) then
begin
if fCurrentState = state then
fCurrentState := nil;
fStatesList.Delete(index);
Dec(fStates);
end;
end; {RemoveState}
procedure TStateMachine.ClearStates;
var
state: Tstate;
begin
while fStatesList.count <> 0 do
begin
state := fStatesList.Items[fStatesList.count - 1];
state.free;
fStatesList.Delete(fStatesList.count - 1);
end;
end; {ClearStates}
procedure TStateMachine.ActivateNextState;
var
index: integer;
begin
if fStatesList.count = 0 then
exit;
if fCurrentState = nil then
fCurrentState := fStatesList[0];
index := fCurrentState.StateIndex;
inc(index);
if index >= fStatesList.count - 1 then
index := 0;
fCurrentState := Tstate(fStatesList[index]);
end; {ActivateNextState}
constructor Tstate.Create;
begin
inherited Create;
end; {Create}
end.