home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Samples / Graphic / DXImageList / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  3.5 KB  |  155 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Menus, DXInput, DXClass, DXDraws;
  8.  
  9. const
  10.   MaxSprite = 10;
  11.   MaxSpeed = 5;
  12.  
  13. type
  14.   TSprite = record
  15.     X, Y, IncX, IncY: Longint;
  16.   end;
  17.  
  18.   TMainForm = class(TDXForm)
  19.     DXDraw: TDXDraw;
  20.     ImageList: TDXImageList;
  21.     DXTimer: TDXTimer;
  22.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  23.       Shift: TShiftState);
  24.     procedure DXDrawFinalize(Sender: TObject);
  25.     procedure DXDrawInitialize(Sender: TObject);
  26.     procedure FormCreate(Sender: TObject);
  27.     procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
  28.     procedure DXTimerActivate(Sender: TObject);
  29.     procedure DXTimerDeactivate(Sender: TObject);
  30.   private
  31.     Sprite: array[0..MaxSprite] of TSprite;
  32.   end;
  33.  
  34. var
  35.   MainForm: TMainForm;
  36.  
  37. implementation
  38.  
  39. uses MMSystem;
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TMainForm.DXTimerActivate(Sender: TObject);
  44. begin
  45.   Caption := Application.Title;
  46. end;
  47.  
  48. procedure TMainForm.DXTimerDeactivate(Sender: TObject);
  49. begin
  50.   Caption := Application.Title + ' [Pause]';
  51. end;
  52.  
  53. procedure TMainForm.FormCreate(Sender: TObject);
  54. var
  55.   i: Integer;
  56. begin
  57.   ImageList.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'Sample.dxg');
  58.  
  59.   ImageList.Items.MakeColorTable;
  60.   DXDraw.ColorTable := ImageList.Items.ColorTable;
  61.   DXDraw.DefColorTable := ImageList.Items.ColorTable;
  62.  
  63.   for i:=0 to MaxSprite do
  64.     with Sprite[i] do
  65.     begin
  66.       X := Random(DXDraw.Width-ImageList.Items[0].Width);
  67.       Y := Random(DXDraw.Height-ImageList.Items[0].Height);
  68.       IncX := Random(MaxSpeed)+1;
  69.       IncY := Random(MaxSpeed)+1;
  70.     end;
  71. end;
  72.  
  73. procedure TMainForm.DXDrawInitialize(Sender: TObject);
  74. begin
  75.   DXTimer.Enabled := True;
  76. end;
  77.  
  78. procedure TMainForm.DXDrawFinalize(Sender: TObject);
  79. begin
  80.   DXTimer.Enabled := False;
  81. end;
  82.  
  83. procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
  84. var
  85.   i: Integer;
  86. begin
  87.   if not DXDraw.CanDraw then exit;
  88.  
  89.   DXDraw.Surface.Fill(0);
  90.  
  91.   {  Movement of sprite  }
  92.   for i := 0 to MaxSprite do
  93.   begin
  94.     with Sprite[i] do
  95.     begin
  96.       Inc(X, IncX); Inc(Y, IncY);
  97.  
  98.       if X<0 then IncX := Random(MaxSpeed)+1;
  99.       if X>DXDraw.Surface.Width-ImageList.Items[0].Width then IncX := -Random(MaxSpeed)-1;
  100.  
  101.       if Y<0 then IncY := Random(MaxSpeed)+1;
  102.       if Y>DXDraw.Surface.Height-ImageList.Items[0].Height then IncY := -Random(MaxSpeed)-1;
  103.  
  104.       {  Description  }
  105.       ImageList.Items[0].Draw(DXDraw.Surface, X, Y, 0);
  106.     end;
  107.   end;
  108.  
  109.   with DXDraw.Surface.Canvas do
  110.   begin
  111.     Brush.Style := bsClear;
  112.     Font.Color := clWhite;
  113.     Font.Size := 12;
  114.     Textout(0, 0, 'FPS: '+inttostr(DXTimer.FrameRate));
  115.  
  116.     Release; {  Indispensability  }
  117.   end;
  118.  
  119.   DXDraw.Flip;
  120. end;
  121.  
  122. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  123.   Shift: TShiftState);
  124. begin
  125.   {  Application end  }
  126.   if Key=VK_ESCAPE then
  127.     Close;
  128.  
  129.   {  Screen mode change  }
  130.   if (ssAlt in Shift) and (Key=VK_RETURN) then
  131.   begin
  132.     DXDraw.Finalize;
  133.  
  134.     if doFullScreen in DXDraw.Options then
  135.     begin
  136.       RestoreWindow;
  137.  
  138.       DXDraw.Cursor := crDefault;
  139.       BorderStyle := bsSizeable;
  140.       DXDraw.Options := DXDraw.Options - [doFullScreen];
  141.     end else
  142.     begin
  143.       StoreWindow;
  144.  
  145.       DXDraw.Cursor := crNone;
  146.       BorderStyle := bsNone;
  147.       DXDraw.Options := DXDraw.Options + [doFullScreen];
  148.     end;
  149.  
  150.     DXDraw.Initialize;
  151.   end;
  152. end;
  153.  
  154. end.
  155.