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