dxwstatobj.pas

Delphi Engine for games.

//UnTitledRTS for UnDelphiX

unit DXWStatObj;

interface
uses
  Windows, SysUtils, Classes, Controls, Contnrs, Graphics ,Dialogs,
  DXClass, DXDraws ;

Type
/////////////////////////////////////////////////////////////////////////

  TDXButton = class
  private
    FSelected    : Boolean;
    FHighLighted : Boolean;
    FCaption     : String;
    FX: Integer;
    FY: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FVisible    : Boolean;
  protected
    function GetBoundsRect: TRect;
  public
    procedure DoDraw; virtual;
    constructor Create; virtual;
    destructor Destroy; override;
    property BoundsRect: TRect read GetBoundsRect;
    property Selected: Boolean read FSelected write FSelected;
    property HighLighted : Boolean read FHighLighted write FHighLighted;

    property X: Integer read FX write FX;
    property Y: Integer read FY write FY;
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeight;
    property Visible: Boolean read FVisible write FVisible;
  end;


 TDXImageButton = class (TDXButton)
  private
    FImage: TPictureCollectionItem;
    FSurface: TDirectDrawSurface;
    procedure SetSurface(Value: TDirectDrawSurface);
  protected
   function GetDrawImageIndex: Integer;
  public
   constructor Create; override;
   procedure DoDraw; override;
   //procedure DrawSelf;
   property Image: TPictureCollectionItem read FImage write FImage;
   property Surface: TDirectDrawSurface read FSurface write SetSurface;
   property Caption    : String read FCaption write FCaption ;
  end;

/////////////////////////////////////////////////////////////////////////

  TDXWObject = class
  private
    FMouseInControl: Boolean;
    FText          : String;
    FFocused       : Boolean;
    FAllowAllUp    : Boolean;
    FGroupIndex    : Integer;
    FDown          : Boolean;
    FCanHighLighted: Boolean;

    FLeft          : Integer;
    FTop           : Integer;
    FWidth         : Integer;
    FHeight        : Integer;
    FVisible       : Boolean;
    FEnabled       : Boolean;
    FMouseCaptured : boolean;
    FdClickedPoint  : TPoint;

    FOnMouseUp     : TMouseEvent;
    FOnMouseDown   : TMouseEvent;
    FOnMouseMove   : TMouseMoveEvent;

    FOnKeyDown     : TKeyEvent;
    FOnKeyUp       : TKeyEvent;
    FOnKeyPress    : TKeyPressEvent;

    FName          : String;
    FFont          : TFont;
    FTag           : Integer;
    FOwner         : TObject;
    FBoundsRect    : TRect;

    procedure SetHeight(const Value: Integer);
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
    procedure SetWidth(const Value: Integer);
    procedure SetBoundsRect(const Value: TRect);
  protected
    function  GetBoundsRect: TRect;
    procedure DoDraw;virtual;abstract;
    procedure SetMouseInControl(const Value: Boolean);virtual;

    Procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    Procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    Procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;

    Procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
    Procedure KeyUp(var Key: Word; Shift: TShiftState);virtual;
    Procedure KeyPress(var Key : char); virtual;
    Procedure FontChenged(Sender: TObject); virtual;abstract;
    Procedure SetBounds; virtual;

  public
    constructor Create(AOwner:TObject); virtual;
    destructor Destroy; override;

    property Owner       : TObject read FOwner write FOwner;
    property MouseInControl : Boolean read FMouseInControl write SetMouseInControl;
    property Focused     : Boolean read FFocused write FFocused;
    property AllowAllUp  : Boolean read FAllowAllUp write FAllowAllUp default False;
    property Down        : Boolean read FDown write FDown default False;
    property Visible     : Boolean read FVisible write FVisible;
    property Enabled     : Boolean read FEnabled write FEnabled;
    property CanHighLighted : Boolean read FCanHighLighted write FCanHighLighted;
    property MouseCaptured  : Boolean read FMouseCaptured write FMouseCaptured default False;
    property dClickedPoint  : TPoint read FdClickedPoint;

    property Tag        : Integer read FTag write FTag default 0;
    property GroupIndex : Integer read FGroupIndex write FGroupIndex default 0;
    property Name       : String read FName write FName;
    property Font       : TFont read FFont write FFont;
    property BoundsRect : TRect  read FBoundsRect write SetBoundsRect;

    property Left    : Integer read FLeft write SetLeft;
    property Top     : Integer read FTop write SetTop;
    property Width   : Integer read FWidth write SetWidth;
    property Height  : Integer read FHeight write SetHeight;

    property OnMouseUp   : TMouseEvent read FOnMouseUp   write FOnMouseUp;
    property OnMouseDown : TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove : TMouseMoveEvent read FOnMouseMove write FOnMouseMove;

    property OnKeyDown   : TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp     : TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnKeyPress  : TKeyPressEvent read FOnKeyPress write FOnKeyPress;

  end;

TDXWObjectList = class(TObjectList)
protected
   function GetItems(Index   : Integer): TDXWObject;
   procedure SetItems(Index : Integer; ADXWObject: TDXWObject);
public
   CapturedObjectID : integer;

   constructor Create; overload;

   function Add(aDXWObject : TDXWObject): Integer;
   function Remove(aDXWObject : TDXWObject): Integer;
   function IndexOf(aDXWObject: TDXWObject): Integer;
   procedure Insert(Index  : Integer; aDXWObject: TDXWObject);
   procedure DoDraw;

   Procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   Procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   Procedure MouseMove(Shift: TShiftState; X, Y: Integer);
   Procedure KeyDown(var Key: Word; Shift: TShiftState);
   Procedure KeyUp(var Key: Word; Shift: TShiftState);
   Procedure KeyPress(var Key : char);

   property Items[Index : Integer]: TDXWObject read GetItems write SetItems; default;
end;


 TDXWImageObject = class (TDXWObject)
  private
   FImage  : TPictureCollectionItem;
   FSurface: TDirectDrawSurface;
   procedure SetSurface(Value: TDirectDrawSurface);
  protected
   procedure SetImage(const Value: TPictureCollectionItem);virtual;
   function GetDrawImageIndex: Integer;virtual;
  public
   procedure DoDraw; override;
   property Image : TPictureCollectionItem read FImage write SetImage;
   property Surface : TDirectDrawSurface read FSurface write SetSurface;
  end;

 TDXWLabel = class (TDXWObject)
  private
   FAutoSize : Boolean;
   FSurface  : TDirectDrawSurface;
   procedure SetSurface(Value: TDirectDrawSurface);
  public
   constructor Create(AOwner:TObject); override;
   procedure DoDraw; override;
   property Surface  : TDirectDrawSurface read FSurface write SetSurface;
   property Caption  : String read FText write FText ;
   property AutoSize : Boolean read FAutoSize write FAutoSize;
  end;


 TDXWEdit = class (TDXWImageObject)
  private
   FCaretPos : integer;
   FOnChange : TNotifyEvent;
   procedure SetText(const Value: String);
   procedure Change;
  public
   constructor Create(AOwner:TObject); override;
   procedure DoDraw; override;

   function GetDrawImageIndex: Integer;override;

   Procedure KeyDown(var Key: Word; Shift: TShiftState);override;
   Procedure KeyUp(var Key: Word; Shift: TShiftState);override;
   Procedure KeyPress(var Key : char);override;

   property Text    : String read FText write SetText ;
   property OnChange : TNotifyEvent read FOnChange write FOnChange;
  end;

 TDXWButton = class (TDXWImageObject)
  public
   constructor Create(AOwner:TObject); override;
   property Caption : String read FText write FText ;
  end;

 TDXWPanel = class (TDXWImageObject)
  public
   function GetDrawImageIndex: Integer;override;
  end;

/////////////////////////////////////////////////////////////////////////


implementation
/////////////////////////////////////////////////////////////////////////

function Shorten(S: string; Cut: Integer): string;
begin
  SetLength(S, Length(S) - Cut);
  Result:=S;
end;

constructor TDXButton.Create;
begin
  inherited Create;
  FVisible:=true;
end;

destructor TDXButton.Destroy;
begin
  inherited Destroy;
end;

procedure TDXButton.DoDraw;
begin
end;

function TDXButton.GetBoundsRect: TRect;
begin
  Result := Bounds(FX,FY,FWidth,FHeight);
end;



constructor TDXWObject.Create(AOwner:TObject);
begin
  inherited Create;
  FFont:=TFont.Create;
  FFont.Color:=clBlack;
  //FFont.OnChange:=FontChenged;
  FVisible:=true;
  FEnabled:=true;
  FText:='';
  FOwner:=AOwner;
end;


destructor TDXWObject.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

function TDXWObject.GetBoundsRect: TRect;
begin
  Result := Bounds(FLeft,FTop,FWidth,FHeight);
end;

procedure TDXWObject.SetMouseInControl(const Value: Boolean);
begin
 if FMouseInControl=Value then Exit;

 if FMouseInControl and (not Value)then
  begin
   FDown:=false;
  end;

 FMouseInControl:=Value;
end;

procedure TDXWObject.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Assigned(FOnKeyDown) then FOnKeyDown(self,Key,Shift);
end;

procedure TDXWObject.KeyPress(var Key: char);
begin
if Assigned(FOnKeyPress) then FOnKeyPress(self,Key);
end;

procedure TDXWObject.KeyUp(var Key: Word; Shift: TShiftState);
begin
if Assigned(FOnKeyUp) then FOnKeyUp(self,Key,Shift);
end;

procedure TDXWObject.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
FDown:=true;
FFocused:=true;
FdClickedPoint:=Point(X-Left,Y-Top);

if Assigned(FOnMouseDown) then FOnMouseDown(Self,Button,Shift,X,Y);
end;

procedure TDXWObject.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
MouseInControl:=true;
if Assigned(FOnMouseMove) then FOnMouseMove(Self,Shift,X,Y);
end;

procedure TDXWObject.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
FDown:=false;
if ( PtInRect(BoundsRect,Point(X,Y)) ) and
   ( Assigned(FOnMouseUp) )
   then FOnMouseUp(Self,Button,Shift,X,Y);
end;

/////////////////////////////////////////////////////////////////////////

function TDXWObjectList.Add(ADXWObject: TDXWObject): Integer;
begin
  Result := inherited Add(ADXWObject);
end;

constructor TDXWObjectList.Create;
begin
 inherited Create;
 CapturedObjectID:=-1;
end;

procedure TDXWObjectList.DoDraw;
Var
 i : integer;
begin
 For i:=0 to Count-1 do Items[i].DoDraw;
end;

function TDXWObjectList.GetItems(Index: Integer): TDXWObject;
begin
  Result := TDXWObject(inherited Items[Index]);
end;

function TDXWObjectList.IndexOf(ADXWObject: TDXWObject):
  Integer;
begin
  Result := inherited IndexOf(ADXWObject);
end;

procedure TDXWObjectList.Insert(Index: Integer;
  ADXWObject: TDXWObject);
begin
   inherited Insert(Index, ADXWObject);
end;

procedure TDXWObjectList.KeyDown(var Key: Word; Shift: TShiftState);
Var
 i         : integer;