Thema: Delphi Metaballs (opengl) !?

Einzelnen Beitrag anzeigen

Blup

Registriert seit: 7. Aug 2008
Ort: Brandenburg
1.477 Beiträge
 
Delphi 12 Athens
 
#5

Re: Metaballs (opengl) !?

  Alt 23. Apr 2010, 16:37
Warum so unfreundlich, ich hab auch nicht ganz verstanden was du eigentlich erreichen willst.
Es gilt doch erst mal nur simpel die Formel umzusetzen.

Also hier ein extrem einfache Variante ohne Optimierung:
Delphi-Quellcode:
type
  TMetaball = record
    x: Double;
    y: Double;
    vx: Double;
    vy: Double;
  end;

var
  FMetaball: array of TMetaball;

procedure TForm1.BtnMetaballClick(Sender: TObject);
var
  xMax, yMax, i, n: Integer;
begin
  xMax := ImgMetaball.Width - 1;
  yMax := ImgMetaball.Height - 1;
  n := 5;
  SetLength(FMetaball, n);
  for i := 0 to n - 1 do
  begin
    FMetaball[i].x := Random(xMax + 1);
    FMetaball[i].y := Random(yMax + 1);
    {Richtung * Geschwindigkeit}
    FMetaball[i].vx := (Random(2) * 2 - 1) + (Random * 0.5 + 0.5);
    FMetaball[i].vy := (Random(2) * 2 - 1) + (Random * 0.5 + 0.5);
  end;
  {Rendern}
  RenderMetaball;
  TimerMetaball.Enabled := True;
end;

procedure TForm1.RenderMetaball;
var
  xMax, yMax,
  i, x, y: Integer;
  m, d: Double;
begin
  xMax := ImgMetaball.Width - 1;
  yMax := ImgMetaball.Height - 1;
  ImgMetaball.Picture := nil;
  ImgMetaball.Picture.Bitmap.SetSize(xMax + 1, yMax + 1);
  for y := 0 to yMax do
  begin
    for x := 0 to xMax do
    begin
      m := 0;
      for i := 0 to High(FMetaball) do
      begin
        d := sqr(x - FMetaball[i].x) + sqr(y - FMetaball[i].y);
        if d = 0 then
          m := m + 1
        else
          m := m + (1 / d);
      end;
      if m > 0.001 then
        ImgMetaball.Picture.Bitmap.Canvas.Pixels[x, y] := clBlack;
    end;
  end;
end;

procedure TForm1.TimerMetaballTimer(Sender: TObject);
var
  xMax, yMax,
  i: Integer;
begin
  {Metaball bewegen}
  xMax := ImgMetaball.Width - 1;
  yMax := ImgMetaball.Height - 1;
  for i := 0 to High(FMetaball) do
  begin
    with FMetaball[i] do
    begin
      x := x + vx;
      if x < 0 then
      begin
        x := 0;
        vx := Abs(vx);
      end
      else if x > xMax then
      begin
        x := xMax;
        vx := -Abs(vx);
      end;
      y := y + vy;
      if y < 0 then
      begin
        y := 0;
        vy := Abs(vy);
      end
      else if y > yMax then
      begin
        y := yMax;
        vy := -Abs(vy);
      end;
    end;
  end;
  {Rendern}
  RenderMetaball;
end;
  Mit Zitat antworten Zitat