Капли

jpg.

В программе реализован алгоритм движения "капель" на языке программирования Delphi.

В процедуре FormCreate:
1. задаем размеры области прорисовки;
2. указываем используемые цвета.

В процедуре TForm1.Timer1Timer:
1. задам функцию движения для каждой "капли" отдельно :
blobs[0].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
blobs[0].y := 100 + round(90 * SIN((4 * frame) * 0.01745329252222));
2. в переменной I указываем количество движущихся "капель";
3. в переменной t указываем диаметр "капель";
4. прорисовываем полученный результат.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type co_ordinate = record
  x,y : integer;
end;
type scanline    = array[0..319] of byte;
var
  Form1      : TForm1;
  Threshold  : integer;
  blobimage  : tbitmap;
  blobs      : array[0..5] of co_ordinate;
  Frame      : Cardinal;
  drawing    : boolean;
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
var Temp : integer;
    pal  : PLogPalette;
    hpal : HPALETTE;
begin
//область прорисовки
  blobimage        := TBitmap.create;
  blobimage.width  := 320;                //размеры области рисования
  blobimage.height := 240;
  blobimage.PixelFormat:=pf8bit; // установка формата пикселей
    Image1.Picture.Bitmap := blobimage;
 
 
    pal := nil;
  try     //функция отвечающая за цвета
    GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);   // выделение памяти под цвета
    pal.palVersion := $300;
    pal.palNumEntries := 256;
    for temp := 0 to 255 do
    begin
      pal.palPalEntry[temp].peRed   := 255-temp;{(temp * 4)-1;}
      pal.palPalEntry[temp].peGreen := 0;
      pal.palPalEntry[temp].peBlue  := 128- temp;
    end;
 
    hpal := CreatePalette(pal^); // создание палитры цветов
          image1.Picture.Bitmap.Palette := hpal;
  finally
      FreeMem(pal);
  end;
  timer1.Enabled := true; // вход в процедуру timer1
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var X_Loop, Y_Loop, I : integer;
    Value, t          : integer;
    Scan              : ^scanline;  // указатель на массив байтов
begin
Frame := frame + 1; // инкремент при каждом вызове timer1
if drawing = false then
begin
//функция задает движение капли
//изменение местоположения капель с каждой итерацией
 
  blobs[0].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
  blobs[0].y := 100 + round(90 * SIN((4 * frame) * 0.01745329252222));
  blobs[1].x := 160 + round(150 * SIN((6 * frame) * 0.01745329252222));
  blobs[1].y := 100 + round(90 * SIN((3 * frame) * 0.01745329252222));
  blobs[2].x := 160 + round(150 * SIN((7 * frame) * 0.01745329252222));
  blobs[2].y := 100 + round(90 * SIN((5 * frame) * 0.01745329252222));
  blobs[3].x := 160 + round(150 * SIN((3 * frame) * 0.01745329252222));
  blobs[3].y := 100 + round(90 * SIN((2 * frame) * 0.01745329252222));
  blobs[4].x := 160 + round(150 * SIN((4 * frame) * 0.01745329252222));
  blobs[4].y := 100 + round(90 * SIN((2 * frame) * 0.01745329252222));
  blobs[5].x := 160 + round(150 * SIN((2 * frame) * 0.01745329252222));
  blobs[5].y := 100 + round(90 * SIN((3 * frame) * 0.01745329252222));
 
 
  drawing := true;
 
  // цикл по размеру формы
  For Y_Loop := 0 to 239 do
  begin
 
    scan := image1.Picture.Bitmap.ScanLine[y_loop]; // инициализация указателя scan
    for X_Loop := 0 to 319 do
    begin
      t := 0;
      For I := 0 to 5 do       //количество бегающих кружков       
begin
        // (x-x0)^2 + (y-y0)^2
        value := (Blobs[i].X-X_loop)*(Blobs[i].X-X_Loop);
        value := value + (Blobs[i].Y-Y_loop)*(Blobs[i].Y-Y_Loop);
        if value < 1 then value := 1;
        t := t+ (100000 div value);    //диаметр капли
      end;
      t := 255-t;
      if t < 0 then t := 0;
      Scan[x_loop] := t;
 
 
    end;
  end;
 
  Image1.Refresh;
  drawing := false;
 
  end;
end;
end.

Ключевые слова: 
капли, движение
ВложениеРазмер
kapli.rar206.76 кб