hge.pas

完整的Delphi游戏开发控件

    function Music_Load(const Filename: String): IMusic; overload;
    function Music_Load(const Data: Pointer; const Size: Longword): IMusic; overload;
    function Music_Play(const Mus: IMusic; const Loop: Boolean;
      const Volume: Integer = 100; const Order: Integer = -1;
      const Row: Integer = -1): IChannel;
    procedure Music_SetAmplification(const Music: IMusic; const Ampl: Integer);
    function Music_GetAmplification(const Music: IMusic): Integer;
    function Music_GetLength(const Music: IMusic): Integer;
    procedure Music_SetPos(const Music: IMusic; const Order, Row: Integer);
    function Music_GetPos(const Music: IMusic; out Order, Row: Integer): Boolean;
    procedure Music_SetInstrVolume(const Music: IMusic; const Instr,
      Volume: Integer);
    function Music_GetInstrVolume(const Music: IMusic;
      const Instr: Integer): Integer;
    procedure Music_SetChannelVolume(const Music: IMusic; const Channel,
      Volume: Integer);
    function Music_GetChannelVolume(const Music: IMusic;
      const Channel: Integer): Integer;

    function Stream_Load(const Filename: String): IStream; overload;
    function Stream_Load(const Data: Pointer; const Size: Longword): IStream; overload;
    function Stream_Play(const Stream: IStream; const Loop: Boolean;
      const Volume: Integer = 100): IChannel;

    procedure Channel_SetPanning(const Chn: IChannel; const Pan: Integer);
    procedure Channel_SetVolume(const Chn: IChannel; const Volume: Integer);
    procedure Channel_SetPitch(const Chn: IChannel; const Pitch: Single);
    procedure Channel_Pause(const Chn: IChannel);
    procedure Channel_Resume(const Chn: IChannel);
    procedure Channel_Stop(const Chn: IChannel);
    procedure Channel_PauseAll;
    procedure Channel_ResumeAll;
    procedure Channel_StopAll;
    function Channel_IsPlaying(const Chn: IChannel): Boolean;
    function Channel_GetLength(const Chn: IChannel): Single;
    function Channel_GetPos(const Chn: IChannel): Single;
    procedure Channel_SetPos(const Chn: IChannel; const Seconds: Single);
    procedure Channel_SlideTo(const Channel: IChannel; const Time: Single;
      const Volume: Integer; const Pan: Integer = -101; const Pitch: Single = -1);
    function Channel_IsSliding(const Channel: IChannel): Boolean;

    procedure Input_GetMousePos(out X, Y: Single);
    procedure Input_SetMousePos(const X, Y: Single);
    function Input_GetMouseWheel: Integer;
    function Input_IsMouseOver: Boolean;
    function Input_KeyDown(const Key: Integer): Boolean;
    function Input_KeyUp(const Key: Integer): Boolean;
    function Input_GetKeyState(const Key: Integer): Boolean;
    function Input_GetKeyName(const Key: Integer): String;
    function Input_GetKey: Integer;
    function Input_GetChar: Integer;
    function Input_GetEvent(out Event: THGEInputEvent): Boolean;

    function Gfx_BeginScene(const Target: ITarget = nil): Boolean;
    procedure Gfx_EndScene;
    procedure Gfx_Clear(const Color: Longword);
    procedure Gfx_RenderLine(const X1, Y1, X2, Y2: Single;
      const Color: Longword = $FFFFFFFF; const Z: Single = 0.5);
    procedure Gfx_RenderTriple(const Triple: THGETriple);
    procedure Gfx_RenderQuad(const Quad: THGEQuad);
    function Gfx_StartBatch(const PrimType: Integer; const Tex: ITexture;
      const Blend: Integer; out MaxPrim: Integer): PHGEVertexArray;
    procedure Gfx_FinishBatch(const NPrim: Integer);
    procedure Gfx_SetClipping(X: Integer = 0; Y: Integer = 0;
      W: Integer = 0; H: Integer = 0);
    procedure Gfx_SetTransform(const X: Single = 0; const Y: Single = 0;
      const DX: Single = 0; const DY: Single = 0; const Rot: Single = 0;
      const HScale: Single = 0; const VScale: Single = 0);

    function Target_Create(const Width, Height: Integer; const ZBuffer: Boolean): ITarget;
    function Target_GetTexture(const Target: ITarget): ITexture;

    function Texture_Create(const Width, Height: Integer): ITexture;
    function Texture_Load(const Data: Pointer; const Size: Longword;
      const Mipmap: Boolean = False): ITexture; overload;
    function Texture_Load(const Filename: String;
      const Mipmap: Boolean = False): ITexture; overload;
    function Texture_GetWidth(const Tex: ITexture; const Original: Boolean = False): Integer;
    function Texture_GetHeight(const Tex: ITexture; const Original: Boolean = False): Integer;
    function Texture_Lock(const Tex: ITexture; const ReadOnly: Boolean = True;
      const Left: Integer = 0; const Top: Integer = 0; const Width: Integer = 0;
      const Height: Integer = 0): PLongword;
    procedure Texture_Unlock(const Tex: ITexture);

    { Extensions }
    function Texture_Load(const ImageData: Pointer; const ImageSize: Longword;
      const AlphaData: Pointer; const AlphaSize: Longword;
      const Mipmap: Boolean = False): ITexture; overload;
    function Texture_Load(const ImageFilename, AlphaFilename: String;
      const Mipmap: Boolean = False): ITexture; overload;

    //2008 Nov additional
    procedure Point(X, Y: Single; Color: Cardinal; BlendMode: Integer=BLEND_DEFAULT);
    procedure Line2Color(X1, Y1, X2, Y2: Single; Color1, Color2: Cardinal; BlendMode: Integer);
    procedure SetGamma(Red, Green, Blue, Brightness, Contrast: Byte);
    procedure Circle(X, Y, Radius: Single; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT); overload;
    procedure Circle(X, Y, Radius: Single; Width: Integer; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT); overload;
    procedure Ellipse(X, Y, R1, R2: Single; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT);
    procedure Arc(X, Y, Radius, StartRadius, EndRadius: Single; Color: Cardinal; DrawStartEnd, Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT );overload;
    procedure Arc(X, Y, Radius, StartRadius, EndRadius: Single; Color: Cardinal; Width: Integer; DrawStartEnd, Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT );overload;
    procedure Triangle(X1, Y1, X2, Y2, X3, Y3: Single; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT);
    procedure Quadrangle4Color(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; Color1, Color2, Color3, Color4: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT );
    procedure Quadrangle(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT);
    procedure Rectangle(X, Y, Width, Height: Single; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT);
    procedure Polygon(Points: array of TPoint; NumPoints: Integer; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT); overload;
    procedure Polygon(Points: array of TPoint; Color: Cardinal; Filled: Boolean; BlendMode: Integer=BLEND_DEFAULT); overload;
  end;

function HGECreate(const Ver: Integer): IHGE;

(*
** HGE Virtual-key codes
*)
const
  HGEK_LBUTTON    = $01;
  HGEK_RBUTTON    = $02;
  HGEK_MBUTTON    = $04;

  HGEK_ESCAPE      = $1B;
  HGEK_BACKSPACE  = $08;
  HGEK_TAB        = $09;
  HGEK_ENTER      = $0D;
  HGEK_SPACE      = $20;

  HGEK_SHIFT      = $10;
  HGEK_CTRL        = $11;
  HGEK_ALT        = $12;

  HGEK_LWIN        = $5B;
  HGEK_RWIN        = $5C;
  HGEK_APPS        = $5D;

  HGEK_PAUSE      = $13;
  HGEK_CAPSLOCK    = $14;
  HGEK_NUMLOCK    = $90;
  HGEK_SCROLLLOCK = $91;

  HGEK_PGUP        = $21;
  HGEK_PGDN        = $22;
  HGEK_HOME        = $24;
  HGEK_END        = $23;
  HGEK_INSERT      = $2D;
  HGEK_DELETE      = $2E;

  HGEK_LEFT        = $25;
  HGEK_UP          = $26;
  HGEK_RIGHT      = $27;
  HGEK_DOWN        = $28;

  HGEK_0          = $30;
  HGEK_1          = $31;
  HGEK_2          = $32;
  HGEK_3          = $33;
  HGEK_4          = $34;
  HGEK_5          = $35;
  HGEK_6          = $36;
  HGEK_7          = $37;
  HGEK_8          = $38;
  HGEK_9          = $39;

  HGEK_A          = $41;
  HGEK_B          = $42;
  HGEK_C          = $43;
  HGEK_D          = $44;
  HGEK_E          = $45;
  HGEK_F          = $46;
  HGEK_G          = $47;
  HGEK_H          = $48;
  HGEK_I          = $49;
  HGEK_J          = $4A;
  HGEK_K          = $4B;
  HGEK_L          = $4C;
  HGEK_M          = $4D;
  HGEK_N          = $4E;
  HGEK_O          = $4F;
  HGEK_P          = $50;
  HGEK_Q          = $51;
  HGEK_R          = $52;
  HGEK_S          = $53;
  HGEK_T          = $54;
  HGEK_U          = $55;
  HGEK_V          = $56;
  HGEK_W          = $57;
  HGEK_X          = $58;
  HGEK_Y          = $59;
  HGEK_Z          = $5A;

  HGEK_GRAVE      = $C0;
  HGEK_MINUS      = $BD;
  HGEK_EQUALS      = $BB;
  HGEK_BACKSLASH  = $DC;
  HGEK_LBRACKET    = $DB;
  HGEK_RBRACKET    = $DD;
  HGEK_SEMICOLON  = $BA;
  HGEK_APOSTROPHE = $DE;
  HGEK_COMMA      = $BC;
  HGEK_PERIOD      = $BE;
  HGEK_SLASH      = $BF;

  HGEK_NUMPAD0    = $60;
  HGEK_NUMPAD1    = $61;
  HGEK_NUMPAD2    = $62;
  HGEK_NUMPAD3    = $63;
  HGEK_NUMPAD4    = $64;
  HGEK_NUMPAD5    = $65;
  HGEK_NUMPAD6    = $66;
  HGEK_NUMPAD7    = $67;
  HGEK_NUMPAD8    = $68;
  HGEK_NUMPAD9    = $69;

  HGEK_MULTIPLY    = $6A;
  HGEK_DIVIDE      = $6F;
  HGEK_ADD        = $6B;
  HGEK_SUBTRACT    = $6D;
  HGEK_DECIMAL    = $6E;

  HGEK_F1          = $70;
  HGEK_F2          = $71;
  HGEK_F3          = $72;
  HGEK_F4          = $73;
  HGEK_F5          = $74;
  HGEK_F6          = $75;
  HGEK_F7          = $76;
  HGEK_F8          = $77;
  HGEK_F9          = $78;
  HGEK_F10        = $79;
  HGEK_F11        = $7A;
  HGEK_F12        = $7B;

type
  TSysFont=class
  private
    FFont: ID3DXFont;
    FName: string;
    FSize: integer;
    FStyle: TFontStyles;
    FRed: Byte;
    FBlue: Byte;
    FGreen: Byte;
    FAlpha: Byte;
    FColor: Cardinal;
    FCanvas: TCanvas;
    FTheFont: TFont;
    procedure SetColor(const Value: Cardinal);
  public
    destructor Destroy; override;
    function CreateFont(FontName: string; Size: Integer; Style: TFontStyles): Boolean; overload;
    function CreateFont(const Font: TFont): Boolean; overload;
    function TextHeight(const Text: string): Integer;
    function TextWidth(const Text: string): integer;
    procedure BeginFont;
    procedure EndFont;
    procedure Init;
    procedure UnInit;
    procedure PrintInvert(XPos, YPos: Integer; sString: string);
    procedure Print(XPos, YPos: Integer; sString: string; R, G, B, A: Byte); overload;
    procedure Print(XPos, YPos: Integer; sString: string); overload;
    procedure Print(Pos: TPoint; sString: string); overload;
    property Color: Cardinal read FColor write SetColor;
    property Red: Byte read FRed write FRed;
    property Blue: Byte read FBlue write FBlue;
    property Green: Byte read FGreen write FGreen;
    property Alpha: Byte read FAlpha write FAlpha;
  end;

implementation

uses
  Messages, Math, MMSystem, ShellAPI, SysUtils, Types, ZLib,  ZipUtils,
  UnZip;

const
  CRLF = #13#10;

(****************************************************************************
 * HGE.h - Macro implementations
 ****************************************************************************)

function ARGB(const A, R, G, B: Byte): Longword; inline;
begin
  Result := (A shl 24) or (R shl 16) or (G shl 8) or B;
end;

function GetA(const Color: Longword): Byte; inline;
begin
  Result := Color shr 24;
end;

function GetR(const Color: Longword): Byte; inline;
begin
  Result := (Color shr 16) and $FF;
end;

function GetG(const Color: Longword): Byte; inline;
begin
  Result := (Color shr 8) and $FF;
end;

function GetB(const Color: Longword): Byte; inline;
begin
  Result := Color and $FF;
end;

function SetA(const Color: Longword; const A: Byte): Longword; inline;
begin
  Result := (Color and $00FFFFFF) or (A shl 24);
end;

function SetR(const Color: Longword; const A: Byte): Longword; inline;
begin
  Result := (Color and $FF00FFFF) or (A shl 16);
end;

function SetG(const Color: Longword; const A: Byte): Longword; inline;
begin
  Result := (Color and $FFFF00FF) or (A shl 8);
end;

function SetB(const Color: Longword; const A: Byte): Longword; inline;
begin
  Result := (Color and $FFFFFF00) or A;
end;

(****************************************************************************
 * HGE_Impl.h
 ****************************************************************************)

{.$DEFINE DEMO}

const
  D3DFVF_HGEVERTEX   = D3DFVF_XYZ or D3DFVF_DIFFUSE or D3DFVF_TEX1;
  VERTEX_BUFFER_SIZE = 4000;

type
  PResourceList = ^TResourceList;
  TResourceList = record
    Filename: String;
    // Password: String; // NOTE: ZIP passwords are not supported in Delphi version
    Next: PResourceList;
  end;

type
  PInputEventList = ^TInputEventList;
  TInputEventList = record
    Event: THGEInputEvent;
    Next: PInputEventList;
  end;

{$IFDEF DEMO}
procedure DInit; forward;
procedure DDone; forward;
function DFrame: Boolean; forward;
{$ENDIF}

(*
** HGE Interface implementation
*)
type
  THGEImpl = class(TInterfacedObject,IHGE)
  protected
    { IHGE }
    function System_Initiate: Boolean;
    procedure System_Shutdown;
    function System_Start: Boolean;
    function System_GetErrorMessage: String;
    procedure System_Log(const S: String); overload;
    procedure System_Log(const Format: String; const Args: array of Const); overload;
    function System_Launch(const Url: String): Boolean;
    procedure System_Snapshot(const Filename: String);
    procedure System_SetState(const State: THGEBoolState; const Value: Boolean); overload;
    procedure System_SetState(const State: THGEFuncState; const Value: THGECallback); overload;
    procedure System_SetState(const State: THGEHWndState; const Value: HWnd); overload;
    procedure System_SetState(const State: THGEIntState; const Value: Integer); overload;
    procedure System_SetState(const State: THGEStringState; const Value: String); overload;
    function System_GetState(const State: THGEBoolState): Boolean; overload;
    function System_GetState(const State: THGEFuncState): THGECallback; overload;
    function System_GetState(const State: THGEHWndState): HWnd; overload;
    function System_GetState(const State: THGEIntState): Integer; overload;
    function System_GetState(const State: THGEStringState): String; overload;

    function Resource_Load(const Filename: String; const Size: PLongword = nil): IResource;
    function Resource_AttachPack(const Filename: String): Boolean;
    procedure Resource_RemovePack(const Filename: String);
    procedure Resource_RemoveAllPacks;
    function Resource_MakePath(const Filename: String = ''): String;
    function Resource_EnumFiles(const Wildcard: String = ''): String;
    function Resource_EnumFolders(const Wildcard: String = ''): String;

    procedure Ini_SetInt(const Section, Name: String; const Value: Integer);
    function Ini_GetInt(const Section, Name: String; const DefVal: Integer = 0): Integer;
    procedure Ini_SetFloat(const Section, Name: String; const Value: Single);
    function Ini_GetFloat(const Section, Name: String; const DefVal: Single): Single;
    procedure Ini_SetString(const Section, Name, Value: String);
    function Ini_GetString(const Section, Name, DefVal: String): String;

    procedure Random_Seed(const Seed: Integer = 0);
    function Random_Int(const Min, Max: Integer): Integer;
    function Random_Float(const Min, Max: Single): Single;

    function Timer_GetTime: Single;
    function Timer_GetDelta: Single;
    function Timer_GetFPS: Integer;

    function Effect_Load(const Data: Pointer; const Size: Longword): IEffect; overload;
    function Effect_Load(const Filename: String): IEffect; overload;
    function Effect_Play(const Eff: IEffect): IChannel;
    function Effect_PlayEx(const Eff: IEffect; const Volume: Integer = 100;