hge.pas

完整的Delphi游戏开发控件

end;

function TEffect.Play: IChannel;
begin
  if (PHGE.FBass <> 0) then begin
    FChannel.SetHandle(BASS_SampleGetChannel(FHandle,False));
    BASS_ChannelPlay(FChannel.Handle,True);
    Result := FChannel;
  end else
    Result := nil;
end;

function TEffect.PlayEx(const Volume, Pan: Integer; const Pitch: Single;
  const Loop: Boolean): IChannel;
var
  Info: BASS_SAMPLE;
  HC: HChannel;
begin
  if (PHGE.FBass <> 0) then begin
    BASS_SampleGetInfo(FHandle,Info);
    HC := BASS_SampleGetChannel(FHandle,False);
    FChannel.SetHandle(HC);
    BASS_ChannelSetAttributes(HC,Trunc(Pitch * Info.freq),Volume,Pan);
    Info.flags := Info.flags and (not BASS_SAMPLE_LOOP);
    if (Loop) then
      Info.flags := Info.flags or BASS_SAMPLE_LOOP;
    BASS_ChannelSetFlags(HC,Info.Flags);
    BASS_ChannelPlay(HC,True);
    Result := FChannel;
  end else
    Result := nil;
end;

{ TMusic }

destructor TMusic.Destroy;
begin
  if (PHGE.FBass <> 0) then
    BASS_MusicFree(FHandle);
  inherited;
end;

function TMusic.GetAmplification: Integer;
begin
  if (PHGE.FBass <> 0) then
    Result := BASS_MusicGetAttribute(FHandle,BASS_MUSIC_ATTRIB_AMPLIFY)
  else
    Result := -1;
end;

function TMusic.GetChannelVolume(const Channel: Integer): Integer;
begin
  if (PHGE.FBass <> 0) then
    Result := BASS_MusicGetAttribute(FHandle,BASS_MUSIC_ATTRIB_VOL_CHAN + Channel)
  else
    Result := -1;
end;

function TMusic.GetInstrVolume(const Instr: Integer): Integer;
begin
  if (PHGE.FBass <> 0) then
    Result := BASS_MusicGetAttribute(FHandle,BASS_MUSIC_ATTRIB_VOL_INST + Instr)
  else
    Result := -1;
end;

function TMusic.MusicGetLength: Integer;
begin
  if (PHGE.FBass <> 0) then
    Result := BASS_MusicGetOrders(FHandle)
  else
    Result := -1;
end;

function TMusic.MusicGetPos(out Order, Row: Integer): Boolean;
var
  Pos: Integer;
begin
  Result := False;
  if (PHGE.FBass <> 0) then begin
    Pos := BASS_MusicGetOrderPosition(FHandle);
    if (Pos <> -1) then begin
      Order := LOWORD(Pos);
      Row := HIWORD(Pos);
      Result := True;
    end;
  end;
end;

procedure TMusic.MusicSetPos(const Order, Row: Integer);
begin
  if (PHGE.FBass <> 0) then
    BASS_ChannelSetPosition(FHandle,MAKEMUSICPOS(Order,Row));
end;

function TMusic.Play(const Loop: Boolean; const Volume: Integer = 100;
  const Order: Integer = -1; const Row: Integer = -1): IChannel;
var
  Info: BASS_CHANNELINFO;
  Pos, O, R: Integer;
begin
  if (PHGE.FBass <> 0) then begin
    Pos := BASS_MusicGetOrderPosition(FHandle);
    if (Order = -1) then
      O := LOWORD(Pos)
    else
      O := Order;
    if (Row = -1) then
      R := HIWORD(Pos)
    else
      R := Row;
    BASS_ChannelSetPosition(FHandle,MAKEMUSICPOS(O,R));

    BASS_ChannelGetInfo(FHandle,Info);
    BASS_ChannelSetAttributes(FHandle,Info.freq,Volume,0);

    Info.flags := Info.flags and (not BASS_SAMPLE_LOOP);
    if (Loop) then
      Info.flags := Info.flags or BASS_SAMPLE_LOOP;

    BASS_ChannelSetFlags(FHandle,Info.flags);
    BASS_ChannelPlay(FHandle,False);
    Result := Self;
  end else
    Result := nil;
end;

procedure TMusic.SetChannelVolume(const Channel, Volume: Integer);
begin
  if (PHGE.FBass <> 0) then
    BASS_MusicSetAttribute(FHandle,BASS_MUSIC_ATTRIB_VOL_CHAN + Channel,Volume);
end;

procedure TMusic.SetInstrVolume(const Instr, Volume: Integer);
begin
  if (PHGE.FBass <> 0) then
    BASS_MusicSetAttribute(FHandle,BASS_MUSIC_ATTRIB_VOL_INST + Instr,Volume);
end;

{ TTarget }

constructor TTarget.Create(const AWidth, AHeight: Integer; const ATex: ITexture;
  const ADepth: IDirect3DSurface8);
begin
  inherited Create;
  FWidth := AWidth;
  FHeight := AHeight;
  FTex := ATex;
  FDepth := ADepth;
  PHGE.FTargets.Add(Self);
end;

destructor TTarget.Destroy;
begin
  PHGE.FTargets.Remove(Self);
  inherited;
end;

function TTarget.GetDepth: IDirect3DSurface8;
begin
  Result := FDepth;
end;

function TTarget.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TTarget.GetTex: ITexture;
begin
  Result := FTex;
end;

function TTarget.GetTexture: ITexture;
begin
  Result := FTex;
end;

function TTarget.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TTarget.Lost;
var
  DXTexture: IDirect3DTexture8;
begin
  if Assigned(FTex) then begin
    D3DXCreateTexture(PHGE.FD3DDevice,FWidth,FHeight,1,
      D3DUSAGE_RENDERTARGET,PHGE.FD3DPP.BackBufferFormat,D3DPOOL_DEFAULT,
      DXTexture);
    FTex.Handle := DXTexture;
  end;
  if Assigned(FDepth) then
    PHGE.FD3DDevice.CreateDepthStencilSurface(FWidth,FHeight,
      D3DFMT_D16,D3DMULTISAMPLE_NONE,FDepth);
end;

procedure TTarget.Restore;
begin
  FTex := nil;
  FDepth := nil;
end;

{ TStream }

constructor TStream.Create(const AHandle: HStream; const AData: IResource);
begin
  inherited Create(AHandle);
  FData := AData;
end;

destructor TStream.Destroy;
begin
  if (PHGE.FBass <> 0) then
    BASS_StreamFree(FHandle);
  inherited;
end;

function TStream.GetData: IResource;
begin
  Result := FData;
end;

function TStream.Play(const Loop: Boolean; const Volume: Integer): IChannel;
var
  Info: BASS_CHANNELINFO;
begin
  if (PHGE.FBass <> 0) then begin
    BASS_ChannelGetInfo(FHandle,Info);
    BASS_ChannelSetAttributes(FHandle,Info.freq,Volume,0);
    Info.flags := Info.flags and (not BASS_SAMPLE_LOOP);
    if (Loop) then
      Info.flags := Info.flags or BASS_SAMPLE_LOOP;
    BASS_ChannelSetFlags(FHandle,Info.Flags);
    BASS_ChannelPlay(FHandle,True);
    Result := Self;
  end else
    Result := nil;
end;

{ TResource }

constructor TResource.Create(const AHandle: Pointer; const ASize: Longword);
begin
  inherited Create;
  FHandle := AHandle;
  FSize := ASize;
end;

destructor TResource.Destroy;
begin
  FreeMem(FHandle);
  inherited;
end;

function TResource.GetHandle: Pointer;
begin
  Result := FHandle;
end;

function TResource.GetSize: Longword;
begin
  Result := FSize;
end;

(****************************************************************************
 * System.cpp, Graphics.cpp, Random.cpp, Sound.cpp, Timer.cpp, Input.cpp,
 * Resource.cpp
 ****************************************************************************)

const
  KeyNames: array [0..255] of String = (
    '?',
    'Left Mouse Button', 'Right Mouse Button', '?', 'Middle Mouse Button',
    '?', '?', '?', 'Backspace', 'Tab', '?', '?', '?', 'Enter', '?', '?',
    'Shift', 'Ctrl', 'Alt', 'Pause', 'Caps Lock', '?', '?', '?', '?', '?', '?',
    'Escape', '?', '?', '?', '?',
    'Space', 'Page Up', 'Page Down', 'End', 'Home',
    'Left Arrow', 'Up Arrow', 'Right Arrow', 'Down Arrow',
    '?', '?', '?', '?', 'Insert', 'Delete', '?',
    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
    '?', '?', '?', '?', '?', '?', '?',
    'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
    'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
    'Left Win', 'Right Win', 'Application', '?', '?',
    'NumPad 0', 'NumPad 1', 'NumPad 2', 'NumPad 3', 'NumPad 4',
    'NumPad 5', 'NumPad 6', 'NumPad 7', 'NumPad 8', 'NumPad 9',
    'Multiply', 'Add', '?', 'Subtract', 'Decimal', 'Divide',
    'F1', 'F2', 'F3', 'F4', 'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    'Num Lock', 'Scroll Lock',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    'Semicolon', 'Equals', 'Comma', 'Minus', 'Period', 'Slash', 'Grave',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?',
    'Left bracket', 'Backslash', 'Right bracket', 'Apostrophe',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?', '?', '?', '?', '?', '?', '?', '?',
    '?', '?', '?');

var
  GSeed: Longword = 0;

function LoWordInt(const N: Longword): Integer; inline;
begin
  Result := Smallint(LoWord(N));
end;

function HiWordInt(const N: Longword): Integer; inline;
begin
  Result := Smallint(HiWord(N));
end;

const
  WINDOW_CLASS_NAME = 'HGE__WNDCLASS';

function WindowProc(HWindow: HWnd; Msg, WParam, LParam: Longint): Longint; stdcall;
begin
  case Msg of
    WM_CREATE:
      begin
        Result := 0;
        Exit;
      end;
    WM_PAINT:
      begin
        if Assigned(PHGE.FProcRenderFunc) then
          PHGE.FProcFrameFunc;
      end;
    WM_DESTROY:
      begin
        PostQuitMessage(0);
        Result := 0;
        Exit;
      end;
    WM_ACTIVATEAPP:
      begin
        if Assigned(PHGE.FD3D) and (PHGE.FActive <> (WParam = 1)) then
          PHGE.FocusChange(WParam = 1);
        Result := 0;
        Exit;
      end;
    WM_SETCURSOR:
      begin
        if (PHGE.FActive or (PHGE.FWndParent <> 0)) and (LoWord(LParam) = HTCLIENT) and (PHGE.FHideMouse) then
          SetCursor(0)
        else
          SetCursor(LoadCursor(0,IDC_ARROW));
        Result := 0;
        Exit;
      end;
    WM_SYSKEYDOWN:
      begin
        if (WParam = VK_F4) then begin
          if Assigned(PHGE.FProcExitFunc) then begin
            if (PHGE.FProcExitFunc) then
              Result := DefWindowProc(HWindow,Msg,WParam,LParam)
            else
              Result := 0;
          end else
            Result :=DefWindowProc(HWindow,Msg,WParam,LParam);
        end else if (WParam = VK_RETURN) then begin
          PHGE.System_SetState(HGE_WINDOWED,
            not PHGE.System_GetState(HGE_WINDOWED));
          Result := 0;
        end else begin
          if ((LParam and $4000000) <> 0) then
            PHGE.BuildEvent(INPUT_KEYDOWN,WParam,HiWord(LParam) and $FF,HGEINP_REPEAT,-1,-1)
          else
            PHGE.BuildEvent(INPUT_KEYDOWN,WParam,HiWord(LParam) and $FF,0,-1,-1);
          Result := 0;
        end;
        Exit;
      end;
    WM_KEYDOWN:
      begin
        if ((LParam and $4000000) <> 0) then
          PHGE.BuildEvent(INPUT_KEYDOWN,WParam,HiWord(LParam) and $FF,HGEINP_REPEAT,-1,-1)
        else
          PHGE.BuildEvent(INPUT_KEYDOWN,WParam,HiWord(LParam) and $FF,0,-1,-1);
        Result := 0;
        Exit;
      end;
    WM_SYSKEYUP:
      begin
        PHGE.BuildEvent(INPUT_KEYUP,WParam,HiWord(LParam) and $FF,0,-1,-1);
        Result := 0;
        Exit;
      end;
    WM_KEYUP:
      begin
        PHGE.BuildEvent(INPUT_KEYUP,WParam,HiWord(LParam) and $FF,0,-1,-1);
        Result := 0;
        Exit;
      end;
    WM_LBUTTONDOWN:
      begin
        SetFocus(HWindow);
        PHGE.BuildEvent(INPUT_MBUTTONDOWN,HGEK_LBUTTON,0,