hgegui.pas

完整的Delphi游戏开发控件

unit HGEGUI;
(*
** Haaf's Game Engine 1.7
** Copyright (C) 2003-2007, Relish Games
** hge.relishgames.com
**
** Delphi conversion by Erik van Bilsen
**
** NOTE: The Delphi version uses public GUI interfaces instead of
** classes (more conform the main IHGE interface).
*)

interface

uses
  HGE, HGESprite, HGERect;

(****************************************************************************
 * HGEGUI.h
 ****************************************************************************)

const
  HGEGUI_NONAVKEYS = 0;
  HGEGUI_LEFTRIGHT = 1;
  HGEGUI_UPDOWN    = 2;
  HGEGUI_CYCLED     = 4;

type
  IHGEGUI = interface;

  IHGEGUIObject = interface
  ['{892FB23E-F99E-4691-8D7C-2BBD4B4F1D40}']
    function GetId: Integer;
    function GetStatic: Boolean;
    procedure SetStatic(const Value: Boolean);
    function GetVisible: Boolean;
    procedure SetVisible(const Value: Boolean);
    function GetEnabled: Boolean;
    procedure SetEnabled(const Value: Boolean);
    function GetRect: THGERect;
    procedure SetRect(const Value: THGERect);
    function GetPRect: PHGERect;
    function GetColor: Longword;
    procedure SetColor(const Value: Longword);
    function GetNext: IHGEGUIObject;
    procedure SetNext(const Value: IHGEGUIObject);
    function GetPrev: IHGEGUIObject;
    procedure SetPrev(const Value: IHGEGUIObject);
    function GetGUI: IHGEGUI;
    procedure SetGUI(const Value: IHGEGUI);

    procedure Render;
    procedure Update(const DT: Single);

    procedure Enter;
    procedure Leave;
    procedure Reset;
    function IsDone: Boolean;
    procedure Focus(const Focused: Boolean);
    procedure MouseOver(const Over: Boolean);

    function MouseMove(const X, Y: Single): Boolean;
    function MouseLButton(const Down: Boolean): Boolean;
    function MouseRButton(const Down: Boolean): Boolean;
    function MouseWheel(const Notches: Integer): Boolean;
    function KeyClick(const Key, Chr: Integer): Boolean;

    property Id: Integer read GetId;
    property IsStatic: Boolean read GetStatic write SetStatic;
    property Visible: Boolean read GetVisible write SetVisible;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property Rect: THGERect read GetRect write SetRect;
    property PRect: PHGERect read GetPRect;
    property Color: Longword read GetColor write SetColor;
    property GUI: IHGEGUI read GetGUI write SetGUI;
    property Next: IHGEGUIObject read GetNext write SetNext;
    property Prev: IHGEGUIObject read GetPrev write SetPrev;
  end;

  IHGEGUI = interface
  ['{3C926B13-D5F0-4541-9B57-EB52361075CE}']
    procedure AddCtrl(const Ctrl: IHGEGUIObject);
    procedure DelCtrl(const Id: Integer);
    function GetCtrl(const Id: Integer): IHGEGUIObject;

    procedure MoveCtrl(const Id: Integer; const X, Y: Single);
    procedure ShowCtrl(const Id: Integer; const Visible: Boolean);
    procedure EnableCtrl(const Id: Integer; const Enabled: Boolean);

    procedure SetNavMode(const Mode: Integer);
    procedure SetCursor(const Spr: IHGESprite);
    procedure SetColor(const Color: Longword);
    procedure SetFocus(const Id: Integer);
    function GetFocus: Integer;

    procedure Enter;
    procedure Leave;
    procedure Reset;
    procedure Move(const DX, DY: Single);

    function Update(const DT: Single): Integer;
    procedure Render;
  end;

type
  THGEGUIObject = class(TInterfacedObject,IHGEGUIObject)
  protected
    { IHGEGUIObject }
    function GetId: Integer;
    function GetStatic: Boolean;
    procedure SetStatic(const Value: Boolean);
    function GetVisible: Boolean;
    procedure SetVisible(const Value: Boolean);
    function GetEnabled: Boolean;
    procedure SetEnabled(const Value: Boolean);
    function GetRect: THGERect;
    procedure SetRect(const Value: THGERect);
    function GetPRect: PHGERect;
    function GetColor: Longword;
    procedure SetColor(const Value: Longword);
    function GetNext: IHGEGUIObject;
    procedure SetNext(const Value: IHGEGUIObject);
    function GetPrev: IHGEGUIObject;
    procedure SetPrev(const Value: IHGEGUIObject);
    function GetGUI: IHGEGUI;
    procedure SetGUI(const Value: IHGEGUI);

    procedure Render; virtual; abstract;
    procedure Update(const DT: Single); virtual;

    procedure Enter; virtual;
    procedure Leave; virtual;
    procedure Reset; virtual;
    function IsDone: Boolean; virtual;
    procedure Focus(const Focused: Boolean); virtual;
    procedure MouseOver(const Over: Boolean); virtual;

    function MouseMove(const X, Y: Single): Boolean; virtual;
    function MouseLButton(const Down: Boolean): Boolean; virtual;
    function MouseRButton(const Down: Boolean): Boolean; virtual;
    function MouseWheel(const Notches: Integer): Boolean; virtual;
    function KeyClick(const Key, Chr: Integer): Boolean; virtual;
  private
    class var
      FHGE: IHGE;
  private
    FId: Integer;
    FStatic: Boolean;
    FVisible: Boolean;
    FEnabled: Boolean;
    FRect: THGERect;
    FColor: Longword;
    FGUI: Pointer; // Must typecast to IHGEGUI (see GUI property). Is pointer to avoid circular reference
    FNext, FPrev: IHGEGUIObject; // Must typecast to IHGEGUIObject (see Next/Prev properties)
  protected
    property Id: Integer read FId write FId;
    property IsStatic: Boolean read FStatic write FStatic;
    property Visible: Boolean read FVisible write FVisible;
    property Enabled: Boolean read FEnabled write FEnabled;
    property Rect: THGERect read FRect write FRect;
    property PRect: PHGERect read GetPRect;
    property Color: Longword read GetColor write SetColor;
    property GUI: IHGEGUI read GetGUI write SetGUI;
    property Next: IHGEGUIObject read GetNext write SetNext;
    property Prev: IHGEGUIObject read GetPrev write SetPrev;
  public
    constructor Create;
    destructor Destroy; override;
  end;

type
  THGEGUI = class(TInterfacedObject,IHGEGUI)
  protected
    { IHGEGUI }
    procedure AddCtrl(const Ctrl: IHGEGUIObject);
    procedure DelCtrl(const Id: Integer);
    function GetCtrl(const Id: Integer): IHGEGUIObject;

    procedure MoveCtrl(const Id: Integer; const X, Y: Single);
    procedure ShowCtrl(const Id: Integer; const Visible: Boolean);
    procedure EnableCtrl(const Id: Integer; const Enabled: Boolean);

    procedure SetNavMode(const Mode: Integer);
    procedure SetCursor(const Spr: IHGESprite);
    procedure SetColor(const Color: Longword);
    procedure SetFocus(const Id: Integer);
    function GetFocus: Integer;

    procedure Enter;
    procedure Leave;
    procedure Reset;
    procedure Move(const DX, DY: Single);

    function Update(const DT: Single): Integer;
    procedure Render;
  private
    class var
      FHGE: IHGE;
  private
    FCtrls: IHGEGUIObject;
    FCtrlLock: IHGEGUIObject;
    FCtrlFocus: IHGEGUIObject;
    FCtrlOver: IHGEGUIObject;
    FNavMode: Integer;
    FEnterLeave: Integer;
    FCursor: IHGESprite;
    FMX, FMY: Single;
    FWheel: Integer;
    FLPressed, FLLastPressed: Boolean;
    FRPressed, FRLastPressed: Boolean;
  private
    function ProcessCtrl(const Ctrl: IHGEGUIObject): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  Windows;

(****************************************************************************
 * HGEGUI.h, HGEGUI.cpp
 ****************************************************************************)

{ THGEGUIObject }

constructor THGEGUIObject.Create;
begin
  inherited Create;
  FHGE := HGECreate(HGE_VERSION);
  FColor := $FFFFFFFF;
end;

destructor THGEGUIObject.Destroy;
begin
  inherited;
end;

procedure THGEGUIObject.Enter;
begin
  { No default implementation }
end;

procedure THGEGUIObject.Focus(const Focused: Boolean);
begin
  { No default implementation }
end;

function THGEGUIObject.GetColor: Longword;
begin
  Result := FColor;
end;

function THGEGUIObject.GetEnabled: Boolean;
begin
  Result := FEnabled;
end;

function THGEGUIObject.GetGUI: IHGEGUI;
begin
  Result := IHGEGUI(FGUI);
end;

function THGEGUIObject.GetId: Integer;
begin
  Result := FId;
end;

function THGEGUIObject.GetNext: IHGEGUIObject;
begin
  Result := FNext;
end;

function THGEGUIObject.GetPRect: PHGERect;
begin
  Result := @FRect;
end;

function THGEGUIObject.GetPrev: IHGEGUIObject;
begin
  Result := FPrev;
end;

function THGEGUIObject.GetRect: THGERect;
begin
  Result := FRect;
end;

function THGEGUIObject.GetStatic: Boolean;
begin
  Result := FStatic;
end;

function THGEGUIObject.GetVisible: Boolean;
begin
  Result := FVisible;
end;

function THGEGUIObject.IsDone: Boolean;
begin
  Result := True;
end;

function THGEGUIObject.KeyClick(const Key, Chr: Integer): Boolean;
begin
  Result := False;
end;

procedure THGEGUIObject.Leave;
begin
  { No default implementation }
end;

function THGEGUIObject.MouseLButton(const Down: Boolean): Boolean;
begin
  Result := False;
end;

function THGEGUIObject.MouseMove(const X, Y: Single): Boolean;
begin
  Result := False;
end;

procedure THGEGUIObject.MouseOver(const Over: Boolean);
begin
  { No default implementation }
end;

function THGEGUIObject.MouseRButton(const Down: Boolean): Boolean;
begin
  Result := False;
end;

function THGEGUIObject.MouseWheel(const Notches: Integer): Boolean;
begin
  Result := False;
end;

procedure THGEGUIObject.Reset;
begin
  { No default implementation }
end;

procedure THGEGUIObject.SetColor(const Value: Longword);
begin
  FColor := Value;
end;

procedure THGEGUIObject.SetEnabled(const Value: Boolean);
begin
  FEnabled := Value;
end;

procedure THGEGUIObject.SetGUI(const Value: IHGEGUI);
begin
  FGUI := Pointer(Value);
end;

procedure THGEGUIObject.SetNext(const Value: IHGEGUIObject);
begin
  FNext := Value;
end;

procedure THGEGUIObject.SetPrev(const Value: IHGEGUIObject);
begin
  FPrev := Value;
end;

procedure THGEGUIObject.SetRect(const Value: THGERect);
begin
  FRect := Value;
end;

procedure THGEGUIObject.SetStatic(const Value: Boolean);
begin
  FStatic := Value;
end;

procedure THGEGUIObject.SetVisible(const Value: Boolean);
begin
  FVisible := Value;
end;

procedure THGEGUIObject.Update(const DT: Single);
begin
  { No default implementation }
end;

{ THGEGUI }

procedure THGEGUI.AddCtrl(const Ctrl: IHGEGUIObject);
var
  Last: IHGEGUIObject;
begin
  Last := FCtrls;
  Ctrl.GUI := Self;
  if (FCtrls = nil) then begin