sample6.dpr

3D GameStudio 的Delphi开发包

program sample6;

//////////////////////////////////////////////////////////////////////
//
// 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, KeyInput, SysUtils, Dialogs;

var TheText,
    ClickButtonText,
    ClickPanelText,
    ClickPanelText2,
    PauseText,
    SliderPosText,
    ScrollWideText,
    EditClickText,
    InKeyText : PText;

    Panel1,
    Panel2,
    Panel3,
    Panel4 : PPanel;

    ThumbNail1,
    ThumbNail2,
    Target1,
    Target2,
    BlueArrow,
    RedArrow : PBmap;

    PauseScroll : Boolean;
    ScrollUp    : Boolean = True;
    OrigBtn     : Boolean = True;
    OrigWin     : Boolean = True;

    MoveX : Integer = 1;
    MoveY : Integer = 0;

    ThePos,               // pointers to variables in c-script file
    BtnClicked,
    MouseLeaveBtn,
    MouseOnBtn,
    WinX,
    WinY : PVar_;

    TicksPassed : Var_;

procedure PanelClickEvent(aPanel : PPanel); cdecl;  // cdecl is REQUIRED
begin                                               // when using a parameter
  if aPanel = Nil then Exit;

  // change the button bitmap for bmapoff
  if aPanel = Panel2 then
  begin
    if OrigBtn then
      pan_setbmap(aPanel,_VAR(3),_VAR(0.1),ThumbNail2)
    else
      pan_setbmap(aPanel,_VAR(3),_VAR(0.1),ThumbNail1);

    OrigBtn := not OrigBtn;
  end
  else
  if aPanel = Panel3 then
  begin
    if OrigWin then
      pan_setbmap(aPanel,_VAR(5),0,Target2)
    else
      pan_setbmap(aPanel,_VAR(5),0,Target1);

    OrigWin := not OrigWin;
  end
  else
  if aPanel = Panel4 then                  // ok to call InKey even if it is
    InKey(InKeyText.Astring^,InKeyText);   // already running, it will detect
end;                                       // this and not try to start again

procedure MakePanels;
begin
  //create a vslider
  //don't forget the ";" at the end of the command string !!!!
  Panel1 := pan_create('bmap = VScrollBox3.pcx;pos_x = 550;pos_y = 230;vslider=1,1,230,ThumbNail3.pcx,1,100,SliderPos;',_VAR(1));
  FlagOn(Panel1.flags,_VISIBLE or OVERLAY);

  Panel2 := pan_create('bmap = levelcode3.pcx;pos_x = 325;pos_y = 105;flags=visible;button=15,20,ThumbNail3.pcx,ThumbNail3.pcx,ThumbNail3.pcx,ClickOnButton,LeaveButton,OverButton;',_VAR(1));
  FlagOn(panel2.flags,_VISIBLE or OVERLAY);
  Panel2.event := @PanelClickEvent;

  Panel3 := pan_create('bmap = levelcode3.pcx;pos_x=325;pos_y=180;window=0,0,50,50,targ1.pcx,WinBmpX,WinBmpY;',_VAR(1));
  FlagOn(panel3.flags,_VISIBLE);
  Panel3.event := @PanelClickEvent;

  Panel4 := pan_create('bmap = levelcode3.pcx;pos_x=100;pos_y=400;',_VAR(1));
  FlagOn(panel4.flags,_VISIBLE);
  Panel4.event := @PanelClickEvent;
end;

procedure FillSliderPosString;

var Temp : String;
begin
  Temp := 'The value of the slider is: '+ IntToStr(_INT(ThePos^));
  str_cpy(SliderPosText.Astring^,PChar(Temp));
end;

procedure ScrollText;
begin
  if PauseScroll then Exit;

  // scroll the text vertically
  if ScrollUp then
  begin
    if TheText.offset_y < _VAR(385) then
      Inc(TheText.offset_y,_VAR(0.002 * ev.time_step^))  // increase the first line of text
    else
      ScrollUp := False;
  end
  else
  begin
    if TheText.offset_y > _VAR(1) then
      Dec(TheText.offset_y,_VAR(0.002 * ev.time_step^))  // decrease the first line of text
    else
      ScrollUp := True;
  end;
end;

procedure ScrollTextWide;

var S : String;
    I : Integer;
begin
  if ScrollWideText = Nil then Exit;

  // only update every 4 Ticks -- this approach should be fps independent
  if _INT(ev.total_ticks^) < TicksPassed + 4 then Exit;

  TicksPassed := _INT(ev.total_ticks^);  // save # of frames

  for I := 1 to _INT(ScrollWideText.strings) do
  begin
    S := Copy(String(ScrollWideText.Astring^.char),2,ScrollWideText.Astring^.length-1) + ScrollWideText.Astring^.char[0];
    str_cpy(ScrollWideText.Astring^,PChar(s));

    Inc(ScrollWideText.Astring);                      //increment the pointer
  end;

  Dec(ScrollWideText.Astring,_INT(ScrollWideText.strings));  //reset the pointer to the beginning
end;

procedure UpdateEditText;
begin
  if ev.inkey_active^ = ON then
    str_cpy(EditClickText.Astring^,'ESC-cancels, ENTER-saves')
  else
    str_cpy(EditClickText.Astring^,'Click Panel to Edit string');
end;


procedure MoveCutOutWindow;
begin
  if MoveX <> 0 then         // if we are moving in "x" direction
    Inc(WinX^,_VAR(MoveX));  // change the cutout x or horizontal position

  if MoveY <> 0 then         // if we are moving in "y" direction
    Inc(WinY^,_VAR(MoveY));  // change the cutout y or vertical position

  if _INT(WinX^) > 80 then   // reached right side
  begin
    MoveX := 0;              // stop moving horizontally
    MoveY := 1;              // start moving vertically (down)
  end;

  if _INT(WinY^) > 80 then   // reached the bottom
  begin
    MoveX := -1;             // start moving horizontally (left)
    MoveY := 0;              // stop moving vertically
  end;

  if (_INT(WinX^) < 10) and (_INT(WinY^) > 80) then
  begin
    MoveX := 0;              // stop moving horizontally
    MoveY := -1;             // start moving vertically (up)
  end;

  if (_INT(WinX^) < 10) and (_INT(WinY^) < 10) then
  begin
    MoveX := 1;              // start moving horizontally (right)
    MoveY := 0;              // stop moving vertically
  end;
end;

procedure CheckForBtnActions;
begin
  if _INT(BtnClicked^) = 1 then
  begin
    BtnClicked^ := 0;                // turn off indicator for clicked button
    PauseScroll := not PauseScroll;  // toggle indicator
    FlagToggle(PauseText.flags,_VISIBLE);
  end;

  if _INT(MouseLeaveBtn^) = 1 then
  begin
    MouseLeaveBtn^ := 0;
    ev.mouse_map := BlueArrow;      // set to the original arrow
  end;

  if _INT(MouseOnBtn^) = 1 then
  begin
    MouseOnBtn^ := 0;
    ev.mouse_map := RedArrow;       // change the arrow
  end;
end;

procedure CreateText;

const TheStrings : Array[0..24] of string = ('The',
                                             'Quick',
                                             'Brown',
                                             'Fox',
                                             'Jumps',
                                             'Over',
                                             'The',
                                             'Lazy',
                                             'Dog.',
                                             'How',
                                             'Fast',
                                             'Did',
                                             'He',
                                             'Jump',
                                             'You',
                                             'Asked?',
                                             'I',
                                             'Don''t',
                                             'Know',
                                             'Said',
                                             'The',
                                             'Dog',
                                             'I',
                                             'Was',
                                             'Sleeping!');


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

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

  TheText.size_y := _VAR(30);              // set height of displayed text

  TheText.font := TheFont;                 // assign the font
  TheText.pos_x := _VAR(400);              // set the x position
  TheText.pos_y := _VAR(127);              // 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

  SliderPosText := txt_create(_VAR(1),_VAR(1));
  SliderPosText.font := TheFont;
  SliderPosText.pos_x := _VAR(350);
  SliderPosText.pos_y := _VAR(270);
  SliderPosText.flags := _VISIBLE or CENTER_X;

  FillSliderPosString;

  PauseText := txt_create(_VAR(1),_VAR(1));
  PauseText.font := TheFont;
  PauseText.pos_x := _VAR(400);
  PauseText.pos_y := _VAR(80);
  PauseText.flags := CENTER_X;

  str_cpy(PauseText.Astring^,'Scrolling Paused!');

  ClickButtonText := txt_create(_VAR(1),_VAR(1));
  ClickButtonText.font := TheFont;
  ClickButtonText.pos_x := _VAR(100);
  ClickButtonText.pos_y := _VAR(120);
  ClickButtonText.flags := _VISIBLE;

  // Chr(40) is used to get the arrow character from this font
  str_cpy(ClickButtonText.Astring^,'Click the Button-'+Chr(40));

  ClickPanelText := txt_create(_VAR(1),_VAR(1));
  ClickPanelText.font := TheFont;
  ClickPanelText.pos_x := _VAR(500);
  ClickPanelText.pos_y := _VAR(120);
  ClickPanelText.flags := _VISIBLE;

  str_cpy(ClickPanelText.Astring^,'Click the Panel');

  ClickPanelText2 := txt_create(_VAR(1),_VAR(1));
  ClickPanelText2.font := TheFont;
  ClickPanelText2.pos_x := _VAR(100);
  ClickPanelText2.pos_y := _VAR(180);
  ClickPanelText2.flags := _VISIBLE;

  // Chr(40) is used to get the arrow character from this font
  str_cpy(ClickPanelText2.Astring^,'Click the Panel-'+Chr(40));

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

  str_cpy(ScrollWideText.Astring^,'This Text is scrolling horizontally! ');

  EditClickText := txt_create(_VAR(1),_VAR(1));

  EditClickText.font := TheFont;
  EditClickText.pos_x := _VAR(50);
  EditClickText.pos_y := _VAR(380);
  EditClickText.flags := _VISIBLE;

  InKeyText := txt_create(_VAR(1),_VAR(1));
  InKeyText.font := font_create('ackfont.pcx'); //font_create('ventfont.pcx');
  InKeyText.pos_x := _VAR(120);
  InKeyText.pos_y := _VAR(420);
  InKeyText.flags := _VISIBLE;

  str_cpy(InKeyText.Astring^,'Change Me');
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 GetObjectsFromScript;
begin
  // get pointer to objects that have to be defined in c-script
  ThePos        := PVar_(engine_getobj('SliderPos'));
  BtnClicked    := PVar_(engine_getobj('ButtonClicked'));
  MouseLeaveBtn := PVar_(engine_getobj('MouseOffButton'));
  MouseOnBtn    := PVar_(engine_getobj('MouseOnButton'));
  WinX          := PVar_(engine_getobj('WinBmpX'));
  WinY          := PVar_(engine_getobj('WinBmpY'));
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('sample6.wdl -diag'); // commands like -diag can be used here

  if ev = Nil then Exit;

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

  BlueArrow := bmap_create('arrow_blue.pcx');  //needed for clicking on entities
  RedArrow  := bmap_create('arrow_red.pcx');

  ThumbNail1 := bmap_create('thumbnail3.pcx');
  ThumbNail2 := bmap_create('thumbnail3red.pcx');
  Target1 := bmap_create('targ1.pcx');
  Target2 := bmap_create('targ2.pcx');

  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.mouse_map      := BlueArrow;

  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.fps_min^ := _VAR(16);
  ev.fps_max^ := _VAR(60);

  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

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

  TicksPassed := _INT(ev.total_ticks^);   // save # of Ticks

  // here is the engine main loop
  while engine_frame <> 0 do
  begin
    MoveMouse;
    FillSliderPosString;
    ScrollText;
    ScrollTextWide;
    MoveCutOutWindow;
    CheckForBtnActions;
    UpdateEditText;
    ProcessInKey;                // NEEDED to process InKey, defined in KeyInput unit
  end;

  engine_close();
end;

begin
  Main;
end.