sample4.dpr

3D GameStudio 的Delphi开发包

program sample4;

//////////////////////////////////////////////////////////////////////
//
// Delphi sample for using the A6_5x Engine (acknex.dll) done by
// Michal Messerschmidt aka LazyDog of Lazy Dog Software
// (www.LazyDogSoftware.com)
//
// SDK Version 6.50.6
//
// tested on Delphi 5,6,7 & 2005
//////////////////////////////////////////////////////////////////////

{$R 'icon.res' 'icon.rc'}  // this allows defining your own .ico file
                           // without the overhead of using the forms unit
                           // to get to the application.icon.  simply change
                           // the icon.rc file to point to your icon

uses A6Engine, Engine_Library, SysUtils, Classes, Dialogs;

var FPSText : PText;
    Panel1, Panel2, Panel3 : PPanel;
    Falling : Boolean = True;
    Fading : Boolean = True;
    Scaled : Boolean = False;

procedure MakePanels;
begin
  //don't forget the ";" at the end of the command string !!!!
  Panel1 := pan_create('bmap = targ1.pcx;pos_x = 0;pos_y = 0;flags=visible;digits=0,0,"fps",*,0,null;digits = 20,0,3,*,16,time_fac;',_VAR(1));
  Panel2 := pan_create('bmap = targ1.pcx;pos_x = 150;pos_y = 70;flags=visible;digits=10,50,"y POS",*,0,null;digits = 50,50,4,*,16,time_fac;',_VAR(2));
  Panel3 := pan_create('bmap = targ1.pcx;pos_x = 150;pos_y =270;flags=visible;',_VAR(2));

  // this will replace the digit in our create string with our variable
  // defined in our program
  digits_set(Panel2,_VAR(2),@Panel2.pos_y);

  // allow panel2 to be transparent and have it's black areas invisible
  Panel2.flags := _VISIBLE or OVERLAY OR TRANSLUCENT;
  Panel2.alpha := _VAR(100);

  // set the x,y position of the rotation
  Panel3.center_x := _VAR(10);
  Panel3.center_y := _VAR(10);
end;

procedure MovePanels;
begin
  if Panel2 = Nil then Exit;

  // move Panel2 up and down.  this movement does not take into account
  // differences in frame rate, so a fast computer would have a different
  // experience.

  if Falling then
  begin
    if Panel2.pos_y < _VAR(110) then
      Inc(Panel2.pos_y,_VAR(2))
    else
    begin
      Inc(ev.fps_max^,_VAR(5));
      Falling := False;
    end;
  end
  else
  if Panel2.pos_y > _VAR(10) then
    Dec(Panel2.pos_y,_VAR(2))
  else
  begin
    Inc(ev.fps_max^,_VAR(5));
    Falling := True;
  end;

  if Fading then
  begin
    if Panel2.alpha > _VAR(25) then
      Dec(Panel2.alpha,_VAR(1))
    else
      Fading := False;
  end
  else
    if Panel2.alpha < _VAR(100) then
      Inc(Panel2.alpha,_VAR(1))
    else
      Fading := True;


  // rotate panel3, this rotation keeps a steady speed no matter the
  // FPS rate so a slow or fast computer would see the same rate
  Inc(Panel3.angle,_VAR(0.005 * ev.time_step^));
end;

procedure TogglePanel;
begin
  if not Scaled then
  begin
    // Scale the panel by the screen to bmap size ratio
    // in order to fit the screen
    Panel1.scale_x := _VAR((ev.screen_size.x) / bmap_width(Panel1.bmap));
    Panel1.scale_y := _VAR((ev.screen_size.y) / bmap_height(Panel1.bmap));
  end
  else
  begin
    // reset back to default size
    Panel1.scale_x := _VAR(1);
    Panel1.scale_y := _VAR(1);
  end;

  Scaled := not Scaled;
end;

procedure FillFPSString;

var Temp : String;
begin
  Temp := 'Current FPS: '+ IntToStr(_INT(fps));
  str_cpy(FPSText.Astring^,PChar(Temp));
end;

procedure CreateText;

var TheText : PText;
    TheFont : PFont_;
    TheStrings : TStringList;
begin
  TheStrings := TStringList.Create;
  TheStrings.Add('Hit Esc to Quit the Program');
  TheStrings.Add('Hit Enter to Toggle Panel from');
  TheStrings.Add('NORMAL to FULL Window Size');

  TheFont := font_create('font1_red.pcx'); // create a font

  TheText := txt_create(_VAR(3),_VAR(1));  // create a text with 3 strings
                                           // setting the layer = 1


  TheText.font := TheFont;                 // assign the font
  TheText.pos_x := _VAR(400);              // set the x position
  TheText.pos_y := _VAR(147);              // set the y position
  TheText.flags := _VISIBLE or CENTER_X;   // set it visible, centered on x

  Txt_Fill(TheText,TheStrings);            // fill the text object from array
                                           // txt_fill defined in Engine_Library


  FPSText := txt_create(_VAR(1),_VAR(1));
  FPSText.font := TheFont;
  FPSText.pos_x := _VAR(400);
  FPSText.pos_y := _VAR(200);
  FPSText.flags := _VISIBLE or CENTER_X;

  FillFPSString;

  TheStrings.Clear;
  TheStrings.Free;
end;

procedure MoveMouse;
begin
  if ev.mouse_map = Nil then Exit;

  if _INT(ev.freeze_mode^) > 1 then Exit;  // all functions suspended

  if ev.mouse_valid^ = 0 then              // makes cursor disappear when
    ev.mouse_mode^ := 0                    // no longer over the engine window
  else
    ev.mouse_mode^ := _VAR(1);

  if ev.mouse_mode^ > 0 then               // move it over the screen
  begin
    ev.mouse_pos.x := ev.mouse_cursor.x;
    ev.mouse_pos.y := ev.mouse_cursor.y;
  end;
end;

procedure Quit;
begin
  sys_exit('');     // quit running and shut down the engine
end;

procedure Main;
begin
  if FindDirectX < 9 then
  begin
    ShowMessage('DirectX 9 is required to run this program');
    Exit;
  end;

  ev := engine_open('');         // commands like -diag can be used here

  if ev = Nil then Exit;

  add_folder('files');           // point to subdirectory that holds level files

  ev.on_close^ := @Quit;         // [X] close icon clicked quits program
  ev.on_esc^   := @Quit;         // ESC key quits program

  ev.mouse_mode^    := _VAR(1);  // windows cursor is visible
  ev.mouse_pointer^ := _VAR(1);  // default cursor is hand

  ev.video_screen^ := _VAR(2);   // default to window mode
  ev.video_mode^   := _VAR(7);   // default to 800x600
  ev.video_depth^  := _VAR(32);  // default to 32 bit depth

  ev.on_enter^ := @TogglePanel;

  ev.fps_min^ := _VAR(16);
  ev.fps_max^ := _VAR(20);

  level_load('paths.wmb');       // this is loaded from the files subdirectory

  engine_frame;                  // need to wait 2 frames after a level_load
  engine_frame;                  // before creating entities

  CreateText;                    // don't call until engine is running
  MakePanels;

  // here is the engine main loop
  while engine_frame <> 0 do
  begin
    MoveMouse;
    MovePanels;
    FillFPSString;
  end;

  engine_close();
end;

begin
  Main;
end.