⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 library.pas

📁 3D GameStudio 的Delphi开发包
💻 PAS
📖 第 1 页 / 共 2 页
字号:
//////////////////////////////////////////////////////////////////////
//
// Delphi Common Library routines for the A6_5x Engine (acknex.dll) and plugin dll's done by
// Michal Messerschmidt aka LazyDog of Lazy Dog Software
// (www.LazyDogSoftware.com)
// (c) Lazy Dog Software / Michael Messerschmidt 2006
//
// SDK Version 6.50.6
//
// tested on Delphi 5,6,7,2005 & 2006
//////////////////////////////////////////////////////////////////////

Interface

Uses Classes, Dialogs, {$IFDEF USEDLL} A6DLL {$ELSE} A6Engine {$ENDIF};


const ActionHandle       =  6 shl 24;      // ptr_first constants to get first object of each type
      StreamHandle       = 15 shl 24;
      
var   CursorClipped : Boolean = False;     // keep track of whether cursor is clipped

// use EntityGlobal_Ptr_First for single player also
function EntityGlobal_Ptr_First : Pointer; {$IFDEF USEDLL} cdecl; exports EntityGlobal_Ptr_First; {$ENDIF}
function EntityLocal_Ptr_First : Pointer;  {$IFDEF USEDLL} cdecl; exports EntityLocal_Ptr_First; {$ENDIF}
function Action_Ptr_First : Pointer;       {$IFDEF USEDLL} cdecl; exports Action_Ptr_First; {$ENDIF}
function EntityLayer_Ptr_First : Pointer;  {$IFDEF USEDLL} cdecl; exports EntityLayer_Ptr_First; {$ENDIF}
function String_Ptr_First : Pointer;       {$IFDEF USEDLL} cdecl; exports String_Ptr_First; {$ENDIF}
function Font_Ptr_First : Pointer;         {$IFDEF USEDLL} cdecl; exports Font_Ptr_First; {$ENDIF}
function Bmap_Ptr_First : Pointer;         {$IFDEF USEDLL} cdecl; exports Bmap_Ptr_First; {$ENDIF}
function Material_Ptr_First : Pointer;     {$IFDEF USEDLL} cdecl; exports Material_Ptr_First; {$ENDIF}
function Sound_Ptr_First : Pointer;        {$IFDEF USEDLL} cdecl; exports Sound_Ptr_First; {$ENDIF}
function Stream_Ptr_First : Pointer;       {$IFDEF USEDLL} cdecl; exports Stream_Ptr_First; {$ENDIF}
function Text_Ptr_First : Pointer;         {$IFDEF USEDLL} cdecl; exports Text_Ptr_First; {$ENDIF}
function Panel_Ptr_First : Pointer;        {$IFDEF USEDLL} cdecl; exports Panel_Ptr_First; {$ENDIF}
function View_Ptr_First : Pointer;         {$IFDEF USEDLL} cdecl; exports View_Ptr_First; {$ENDIF}

// functions that behave the same as ent_next
function String_Next(S : PString) : Pointer;     {$IFDEF USEDLL} cdecl; exports String_Next; {$ENDIF}
function Font_Next(F : PFont_) : Pointer;        {$IFDEF USEDLL} cdecl; exports Font_Next; {$ENDIF}
function Bmap_Next(B : PBMap) : Pointer;         {$IFDEF USEDLL} cdecl; exports Bmap_Next; {$ENDIF}
function Material_Next(M : PMaterial) : Pointer; {$IFDEF USEDLL} cdecl; exports Material_Next; {$ENDIF}
function Sound_Next(S : PSound) : Pointer;       {$IFDEF USEDLL} cdecl; exports Sound_Next; {$ENDIF}
function Text_Next(T : PText) : Pointer;         {$IFDEF USEDLL} cdecl; exports Text_Next; {$ENDIF}
function Panel_Next(P : PPanel) : Pointer;       {$IFDEF USEDLL} cdecl; exports Panel_Next; {$ENDIF}
function View_Next(V : PView) : Pointer;         {$IFDEF USEDLL} cdecl; exports View_Next; {$ENDIF}

function FlagIsOn(SourceFlag,Flag : LongInt) : Boolean;
procedure FlagOn(Var SourceFlag : LongInt; Flag : LongInt);
procedure FlagOff(Var SourceFlag : LongInt; Flag : LongInt);
procedure FlagToggle(Var SourceFlag : LongInt; Flag : LongInt);

function NullVec : PVector;

function GetVec(v : TView) : TVector; overload;
function GetVec(e : TEntity) : TVector; overload;
function GetAng(v : TView) : TAngle; overload;
function GetAng(e : TEntity) : TAngle; overload;
procedure SetVec(var v1 : TView; v2 : TVector); overload;
procedure SetVec(var e : TEntity; v : TVector); overload;
procedure SetAng(var v1 : Tview; a : TAngle); overload;
procedure SetAng(var e : TEntity; a : TAngle); overload;

function FPS : VAR_;   // return current Frames Per Second
procedure Txt_Fill(aText : PText; a : Array of String); overload;
procedure Txt_Fill(aText : PText; a : TStrings); overload;

{$IFDEF USEDLL}
function FindDirectX : Var_; cdecl; exports FindDirectX;
function OpenWebPage(URLStr : PString) : VAR_; cdecl; exports OpenWebPage;
{$ELSE}
function FindDirectX : Integer;  // return directX version 8 or 9
function OpenWebPage(URLStr : String) : Integer;
{$ENDIF}

function MinimizeGSWindow : Boolean; 
function RestoreGSWindow : Boolean;  
function SetWindowStayOnTop : Boolean;
function ClearWindowStayOnTop : Boolean;

{$IFDEF USEDLL}
function MinimizeGSWindow_Var : VAR_;     cdecl; exports MinimizeGSWindow;
function RestoreGSWindow_Var : VAR_;      cdecl; exports RestoreGSWindow; 
function SetWindowStayOnTop_Var : VAR_;   cdecl; exports SetWindowStayOnTop_Var;
function ClearWindowStayOnTop_Var : VAR_; cdecl; exports ClearWindowStayOnTop_Var;
{$ENDIF}

function Clip_Cursor(Left,Top,Right,Bottom : Integer) : Boolean;
function Clip_Cursor_Off : Boolean;
function ClipCursorToWindow : Boolean;
function CheckForLostFocus : Boolean;
function ManageClipCursor : Boolean;

{$IFDEF USEDLL}
function Clip_Cursor_Var(Left,Top,Right,Bottom : Var_) : Var_; cdecl; exports Clip_Cursor_Var;
function Clip_Cursor_Off_Var : Var_; cdecl; exports Clip_Cursor_Off_Var;
function ClipCursorToWindow_Var : VAR_;  cdecl; exports ClipCursorToWindow_Var;
function CheckForLostFocus_Var : VAR_;   cdecl; exports CheckForLostFocus_Var;
function ManageClipCursor_Var : VAR_;    cdecl; exports ManageClipCursor_Var;
{$ENDIF}

function ShowMsg(const Msg,TheCaption : String; DlgType : TMsgDlgType;
                 Buttons : TMsgDlgButtons) : Integer;
{$IFDEF USEDLL}
function ShowMsg_Var(const Msg,TheCaption : PString; DlgType,Buttons : VAR_) : VAR_; cdecl; exports ShowMsg_Var;
{$ENDIF}

var DirectX_Ver : Integer;
    DirectX_Str : String;

Implementation
uses Registry, SysUtils, Windows, ShellAPI, Controls, Forms,
     {$IFDEF USEDLL} DLL_DX9Library {$ELSE} Engine_DX9Library {$ENDIF} ;

var Temp : LongInt;

function EntityGlobal_Ptr_First : Pointer;
begin
  Temp   := HBYTE_ENTITY; // defined in aTypes.pas
  Result := ptr_first(@Temp);
end;

function EntityLocal_Ptr_First : Pointer;
begin
  Temp   := HBYTE_ENTITY_LOCAL; // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function Action_Ptr_First : Pointer;
begin
  Temp   := ActionHandle;
  Result := ptr_first(@Temp);
end;

function EntityLayer_Ptr_First : Pointer;
begin
  Temp   := HBYTE_ENTITY_LAYER; // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function String_Ptr_First : Pointer;
begin
  Temp   := HBYTE_STRING; // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function Font_Ptr_First : Pointer;
begin
  Temp   := HBYTE_FONT;  // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function Bmap_Ptr_First : Pointer;
begin
  Temp   := HBYTE_BMAP;  // defined in aTypes.pas  
  Result := ptr_first(@Temp);
end;

function Material_Ptr_First : Pointer;
begin
  Temp   := HBYTE_MATERIAL; // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function Sound_Ptr_First : Pointer;
begin
  Temp   := HBYTE_SOUND; // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function Stream_Ptr_First : Pointer;
begin
  Temp   := StreamHandle;
  Result := ptr_first(@Temp);
end;

function Text_Ptr_First : Pointer;
begin
  Temp   := HBYTE_TEXT;  // defined in aTypes.pas
  Result := ptr_first(@Temp);
end;

function Panel_Ptr_First : Pointer;
begin
  Temp   := HBYTE_PANEL; // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function View_Ptr_First : Pointer;
begin
  Temp   := HBYTE_VIEW;  // defined in aTypes.pas 
  Result := ptr_first(@Temp);
end;

function String_Next(S : PString) : Pointer;
begin
  Result := PString(S.C_Link.next);
end;

function Font_Next(F : PFont_) : Pointer;
begin
  Result := PFont_(F.C_Link.next);
end;

function Bmap_Next(B : PBMap) : Pointer;
begin
  Result := PBMap(B.C_Link.next);
end;

function Material_Next(M : PMaterial) : Pointer;
begin
  Result := PMaterial(M.C_Link.next);
end;

function Sound_Next(S : PSound) : Pointer;
begin
  Result := PSound(S.C_Link.next);
end;

function Text_Next(T : PText) : Pointer;
begin
  Result := PString(T.C_Link.next);
end;

function Panel_Next(P : PPanel) : Pointer;
begin
  Result := PPanel(P.C_Link.next);
end;

function View_Next(V : PView) : Pointer;
begin
  Result := PView(V.C_Link.next);
end;

function FlagIsOn(SourceFlag,Flag : LongInt) : Boolean;
begin
  Result := (SourceFlag and Flag) = Flag;
end;

procedure FlagOn(Var SourceFlag : LongInt; Flag : LongInt);
begin
  SourceFlag := SourceFlag or Flag;
end;

procedure FlagOff(Var SourceFlag : LongInt; Flag : LongInt);
begin
  SourceFlag := SourceFlag and not Flag;
end;

procedure FlagToggle(Var SourceFlag : LongInt; Flag : LongInt);
begin
  SourceFlag := SourceFlag xor Flag;
end;

function NullVec : PVector;
begin
  // temporary VECTOR*, for passing a null vector constant to functions only
  Result := _vec(0,0,0);
end;

function GetVec(v : TView) : TVector; overload;
begin
  Result.x := v.x;
  Result.y := v.y;
  Result.z := v.z;
end;

function GetVec(e : TEntity) : TVector; overload;
begin
  Result.x := e.x;
  Result.y := e.y;
  Result.z := e.z;
end;

function GetAng(v : TView) : TAngle; overload;
begin
  Result.pan  := v.pan;
  Result.tilt := v.tilt;
  Result.roll := v.roll;
end;

function GetAng(e : TEntity) : TAngle; overload;
begin
  Result.pan  := e.pan;
  Result.tilt := e.tilt;
  Result.roll := e.roll;
end;

procedure SetVec(var v1 : TView; v2 : TVector); overload;
begin
  v1.x := v2.x;
  v1.y := v2.y;
  v1.z := v2.z;
end;

procedure SetVec(var e : TEntity; v : TVector); overload;
begin
  e.x := v.x;
  e.y := v.y;
  e.z := v.z;
end;

procedure SetAng(var v1 : Tview; a : TAngle); overload;
begin
  v1.pan  := a.pan;
  v1.tilt := a.tilt;
  v1.roll := a.roll;
end;

procedure SetAng(var e : TEntity; a : TAngle); overload;
begin
  e.pan  := a.pan;
  e.tilt := a.tilt;
  e.roll := a.roll;
end;

function FPS : VAR_;
begin
  Result := powv(ev.time_step^,_VAR(-1)) * 16;  // return current Frames Per Second
end;

procedure Txt_Fill(aText : PText; a : Array of String); overload;

var I,Stop : Integer;
begin
  if aText = Nil then Exit;

  Stop := _INT(aText.strings) - 1;      //get the max defined # of strings in aText
                                        //the string array "a" is zero based so we subtract 1

  if Stop > High(a) then
    Stop := High(a);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -