home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Vcl / Sprites_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-05  |  3.5 KB  |  135 lines
  1. unit MainUnit;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *
  26.  * ***** END LICENSE BLOCK ***** *)
  27.  
  28. interface
  29.  
  30. uses
  31.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  32.   GR32, GR32_Transforms, StdCtrls, AppEvnts, GR32_Image, GR32_Layers;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     Image32: TImage32;
  37.     Button1: TButton;
  38.     Edit1: TEdit;
  39.     Button2: TButton;
  40.     BitmapList: TBitmap32List;
  41.     Label1: TLabel;
  42.     procedure Button1Click(Sender: TObject);
  43.     procedure Button2Click(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.   public
  46.     Velocities: TArrayOfFloatPoint;
  47.     procedure IdleHandler(Sender: TObject; var Done: Boolean);
  48.   end;
  49.  
  50. var
  51.   Form1: TForm1;
  52.  
  53. implementation
  54.  
  55. {$R *.DFM}
  56.  
  57. procedure TForm1.Button1Click(Sender: TObject);
  58. var
  59.   X: Integer;
  60.   ALayer: TBitmapLayer;
  61.   L: TFloatRect;
  62.   I: Integer;
  63. begin
  64.   Image32.BeginUpdate;
  65.   for X := 0 to 49 do
  66.   begin
  67.     // create a new layer...
  68.     ALayer := TBitmapLayer.Create(Image32.Layers);
  69.     with ALayer do
  70.     begin
  71.       Bitmap := BitmapList.Bitmaps[Random(BitmapList.Bitmaps.Count)].Bitmap;
  72.       Bitmap.DrawMode := dmBlend;
  73.       Bitmap.MasterAlpha := Random(255);
  74.  
  75.       // put it somethere
  76.       L.Left := Random(Image32.Width);
  77.       L.Top := Random(Image32.Height);
  78.       L.Right := L.Left + Bitmap.Width;
  79.       L.Bottom := L.Top + Bitmap.Height;
  80.       ALayer.Location := L;
  81.  
  82.       I := Length(Velocities);
  83.       SetLength(Velocities, I + 1);
  84.       Velocities[I] := FloatPoint(Random - 0.5, Random - 0.5);
  85.     end;
  86.   end;
  87.   Image32.EndUpdate;
  88.   Image32.Changed;
  89.   Edit1.Text := IntToStr(Image32.Layers.Count) + ' layers';
  90. end;
  91.  
  92. procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
  93. var
  94.   I: Integer;
  95.   R: TFloatRect;
  96. begin
  97.   if Image32.Layers.Count = 0 then Exit;
  98.   Image32.BeginUpdate;
  99.   for I := 0 to Image32.Layers.Count - 1 do
  100.   begin
  101.     with TBitmapLayer(Image32.Layers[I]) do
  102.     begin
  103.       Bitmap.MasterAlpha := (Bitmap.MasterAlpha + 1) mod 256;
  104.       R := Location;
  105.       with Velocities[I] do
  106.       begin
  107.         OffsetRectF(R, X, Y);
  108.         X := X + (Random - 0.5) * 0.1;
  109.         Y := Y + (Random - 0.5) * 0.1;
  110.         if (R.Left < 0) and (X < 0) then X := 1;
  111.         if (R.Top < 0) and (Y < 0) then Y := 1;
  112.         if (R.Right > Image32.Width) and (X > 0) then X := -1;
  113.         if (R.Bottom > Image32.Height) and (Y > 0) then Y := -1;
  114.       end;
  115.       Location := R;
  116.     end;
  117.   end;
  118.   Image32.EndUpdate;
  119.   Image32.Invalidate;
  120. end;
  121.  
  122. procedure TForm1.Button2Click(Sender: TObject);
  123. begin
  124.   Image32.Layers.Clear;
  125.   Velocities := nil;
  126.   Edit1.Text := '0 layers';
  127. end;
  128.  
  129. procedure TForm1.FormCreate(Sender: TObject);
  130. begin
  131.   Application.OnIdle := IdleHandler;
  132. end;
  133.  
  134. end.
  135.