Simular el movimiento de burbujas

Para los aficionados a la física aquí tienen una aplicación que simula muy realísticamente el movimiento de burbujas.

Para cambiar la velocidad de su movimiento sólamente hay que modificar la propiedad "interval" del componente Timer1.

Realizada por daniel.davies@blueyonder.co.uk

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);
    PROCEDURE QuitClick(Sender: TObject);
    PROCEDURE Image1Click(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
  Frame := 0;

  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^);
    IF hpal <> 0 THEN

      Image1.Picture.Bitmap.Palette := hpal;
  FINALLY
    FreeMem(pal);
  END;
  application.ProcessMessages;
  Timer1.Enabled := true;
END;

PROCEDURE TForm1.Timer1Timer(Sender: TObject);
VAR
  X_Loop, Y_Loop, I: integer;
  Value, t: integer;
  Scan: ^scanline;
BEGIN
  Frame := Frame + 1;
  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];
      FOR X_Loop := 0 TO 319 DO
      BEGIN
        t := 0;
        FOR I := 0 TO 5 DO
        BEGIN
          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;
        { if t >= 200 then scan[x_loop] := 0 else scan[x_loop] := 10; }

      END;
    END;

    Image1.Refresh;
    application.ProcessMessages;
    drawing := false;
  END;
END;

PROCEDURE TForm1.QuitClick(Sender: TObject);
BEGIN
  Timer1.Enabled := false;
  application.Terminate;
END;

PROCEDURE TForm1.Image1Click(Sender: TObject);
BEGIN
  Timer1.Enabled := false;
  application.Terminate;
END;

END.

Descargar aplicación