0,0 → 1,409 |
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. |