library.pas

3D GameStudio 的Delphi开发包

  for I := 0 to Stop do
  begin
    str_cpy(aText.Astring^,PChar(a[I]));//store string
    Inc(aText.Astring);                 //increment the pointer
  end;

  Dec(aText.Astring,Stop+1);            //reset the pointer to the beginning
end;

procedure Txt_Fill(aText : PText; a : TStrings); 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 > a.Count-1 then
    Stop := a.Count-1;

  for I := 0 to Stop do
  begin
    str_cpy(aText.Astring^,PChar(a.Strings[I]));//store string
    Inc(aText.Astring);                 //increment the pointer
  end;

  Dec(aText.Astring,Stop+1);            //reset the pointer to the beginning
end;

{$IFDEF USEDLL}
function FindDirectX : VAR_;
{$ELSE}
function FindDirectX : Integer;
{$ENDIF}

var Reg : TRegistry;
    Work,
    Ver : String;
    Sub : Integer;
begin
  Ver := '';

  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.Access  := KEY_READ;

    if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\DirectX') then
    begin
      Ver := Reg.ReadString('Version');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;

  if Ver = '' then
    DirectX_Ver := 0
  else
  begin
    Work := Copy(Ver,3,2);                 // 4.09.00.0904
    DirectX_Ver := StrToIntDef(Work,0);
    Work := Copy(Ver,Length(Ver)-3,4);     // grab last 4 digits
    Sub := StrToIntDef(Work,0);

    case DirectX_Ver of
      8 : case sub of
            400 : DirectX_Str := '8.0a';
            810 : DirectX_Str := '8.1';
          end;

      9 : case sub of
            900 : DirectX_Str := '9.0';
            901 : DirectX_Str := '9.0a';
            902 : DirectX_Str := '9.0b';
            904 : DirectX_Str := '9.0c';
          end;
    end;
  end;

  {$IFDEF USEDLL}
  Result := _VAR(DirectX_Ver);
  {$ELSE}
  Result := DirectX_Ver;
  {$ENDIF}
end;

{$IFDEF USEDLL}
function OpenWebPage(URLStr : PString) : VAR_;
begin
  // Result <= 32 means error
  Result := _VAR(Windows.error_file_not_found);

  if URLStr.length > 0 then
    Result := _VAR(ShellExecute(0,'Open',URLStr.char,Nil,Nil,SW_SHOWNORMAL)); //1
end;
{$ELSE}
function OpenWebPage(URLStr : String) : Integer;
begin
  // Result <= 32 means error
  Result := Windows.error_file_not_found;

  if URLStr <> '' then
    Result := ShellExecute(0,'Open',PChar(URLStr),Nil,Nil,SW_SHOWNORMAL); //1
end;
{$ENDIF}

function MinimizeGSWindow_Var : VAR_;
begin
  Result := 0;

  if ev.hWndMain <> 0 then
    Result := _VAR(LongInt(ShowWindow(ev.hWndMain,SW_MINIMIZE)));
end;

function RestoreGSWindow_Var : VAR_;
begin
  Result := 0;

  if ev.hWndMain <> 0 then
    Result := _VAR(LongInt(ShowWindow(ev.hWndMain,SW_RESTORE)));
end;

function MinimizeGSWindow : Boolean;
begin
  Result := MinimizeGSWindow_Var <> 0;
end;

function RestoreGSWindow : Boolean;
begin
  Result := RestoreGSWindow_Var <> 0;
end;

function SetWindowStayOnTop : Boolean;

// when using this function...
// if you need to set a breakpoint and debug your program,
// YOU WILL CRASH unless you call ClearWindowStayOnTop before
// your breakpoint.

var Style : LongInt;
begin
  Result := False;                                   // default to fail

  if ev.video_screen^ = _VAR(1) then Exit;           // not window mode

  Style := GetWindowLong(ev.hWndMain, GWL_EXSTYLE);  // get windows style

  if Style and WS_EX_TOPMOST = 0 then                // not already set
    Result := SetWindowPos(ev.hWndMain, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
end;

function ClearWindowStayOnTop : Boolean;

var Style : LongInt;
begin
  Result := False;                                   // default to fail

  if ev.video_screen^ = _VAR(1) then Exit;           // not window mode

  Style := GetWindowLong(ev.hWndMain, GWL_EXSTYLE);  // get windows style

  if Style and WS_EX_TOPMOST <> 0 then               // stay on top set
    Result := SetWindowPos(ev.hWndMain, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
end;

{$IFDEF USEDLL}
function SetWindowStayOnTop_Var : Var_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(SetWindowStayOnTop));
end;

function ClearWindowStayOnTop_Var : Var_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(ClearWindowStayOnTop));
end;
{$ENDIF}

function Clip_Cursor(Left,Top,Right,Bottom : Integer) : Boolean;

var ARect : TRect;
begin
  ARect := Classes.Rect(Left,Top,Right,Bottom);
  CursorClipped := ClipCursor(@ARect);
  Result := CursorClipped;
end;

function Clip_Cursor_Off : Boolean;
begin
  CursorClipped := not ClipCursor(Nil);
  Result := CursorClipped;
end;

function ClipCursorToWindow : Boolean;

var Style : LongInt;
    AddToRight,
    AddToBot : Integer;
begin
  Result := False;
  if ev.video_screen^ = _VAR(1) then Exit;     // not window mode

  Style := GetWindowLong(ev.hWndMain, GWL_STYLE);  // get windows style

  if Style and WS_BORDER = 0 then              // no border?
  begin
    AddToRight := 0;
    AddToBot   := 0;
  end
  else
  begin
    AddToRight := 2 * _INT(sys_metrics(_VAR(5))); //SM_CXBORDER
    AddToBot   := 2 * _INT(sys_metrics(_VAR(6))); //SM_CYBORDER
  end;

  if Style and WS_CAPTION <> 0 then
    Inc(AddToBot,_INT(sys_metrics(_VAR(4)))); //SM_CYCAPTION

  Result := Clip_Cursor(_INT(ev.window_pos.x),_INT(ev.window_pos.y),
                        _INT(ev.window_pos.x)+_INT(ev.screen_size.x)+AddToRight,
                        _INT(ev.window_pos.y)+_INT(ev.screen_size.y)+AddToBot);
end;

function CheckForLostFocus : Boolean;
begin
  Result := False;

  if ev.window_focus^ = 0 then         // game window is not in foreground
    Result := Clip_Cursor_Off;
end;

function ManageClipCursor : Boolean;
begin
  Result := False;

  if (ev.window_focus^ = _VAR(1)) and not CursorClipped then
    Result := ClipCursorToWindow
  else
  if (ev.window_focus^ = 0) and CursorClipped then
    Result := Clip_Cursor_Off;
end;

{$IFDEF USEDLL}
function Clip_Cursor_Var(Left,Top,Right,Bottom : Var_) : Var_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(Clip_Cursor(_INT(Left),_INT(Top),_INT(Right),_INT(Bottom))));
end;

function Clip_Cursor_Off_Var : Var_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(Clip_Cursor_Off));
end;

function ClipCursorToWindow_Var : Var_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(ClipCursorToWindow));
end;

function CheckForLostFocus_Var : VAR_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(CheckForLostFocus));
end;

function ManageClipCursor_Var : VAR_;
begin
  // this function is for plugin dll use
  Result := _VAR(Ord(ManageClipCursor));
end;
{$ENDIF}

function ShowMsg(const Msg,TheCaption : String; DlgType : TMsgDlgType;
                 Buttons : TMsgDlgButtons) : Integer;
begin
  Result := mrNone;

  if not DirectDeviceReset then Exit;  // Full Screen Mode needs reset

  with CreateMessageDialog(Msg,DlgType,Buttons) do
  try
    Position := poScreenCenter;
    Caption := TheCaption;
    Parent := Nil;
    ParentWindow := ev.hWndMain;       // allow form to be seen

    Windows.SetFocus(Handle);          // allow keyboard access
    SetCapture(Handle);                // allow mouse access
    Result := ShowModal;
  finally
    ReleaseCapture;                    // free mouse capture
    Free;
  end;
end;

{$IFDEF USEDLL}
function ShowMsg_Var(const Msg,TheCaption : PString; DlgType,Buttons : VAR_) : VAR_;

var TheDlgType : TMsgDlgType;
    TheButtons : TMsgDlgButtons;
    Btn,
    Btns : Integer;
    I : TMsgDlgBtn;
begin
  // convert from VAR_ to TMsgDlgType Enumeration Type
  TheDlgType := TMsgDlgType(_Int(DlgType));

  TheButtons := [];       // default to no buttons

  Btns := _Int(Buttons);  // convert VAR_ to Integer

  if Btns >= 1024 then    // don't allow "HELP" key
    Btns := 1024 - Btns;

  // loop through all of the possible buttons
  for I := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
  begin
    Btn := 1 shl Ord(I);

    if Btn and Btns = Btn then
      Include(TheButtons,I);
  end;

  Result := _Var(ShowMsg(String(Msg.char),String(TheCaption.char),TheDlgType,TheButtons));
end;
{$ENDIF}