// Es geht darum, das Aufprallen eines Objektes (z.B. das Bild eines Balles)
// programmtechnisch nachzubilden. Der Originalcode stammt nicht von mir,
// aber ich weiß nicht mehr, von wem ich ihn habe. Aufgrund einer EMail-
// anfrage habe ich das Ding wieder hervorgekramt und festgestellt, dass
// der Code bei bestimmten Objektmaßen oder Fallhöhen, sowie bei der höchsten
// Elastizitätsstufe nicht beendet wird. Deshalb habe ich ein paar wenige,
// marginale Änderungen vorgenommen. Im Beispiel wird ein TImage verwendet,
// es könnte aber auch ein TPanel oder TButton sein.
 


// Getestet mit RS 10.4 unter Win11
 

type 
  Elastizitaet = 0 .. 10; 
  Verzoegerung = 0 .. 30; 
 
var 
  stop: Boolean = false; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; 
end; 
 
procedure Hupf(Elastisch: Elastizitaet; Pause: Verzoegerung; Obj: TControl; 
  Unten: Integer); 
var 
  Elas, Schritt, Stelle: Single; 
  Zeit: Cardinal; 
  Merk: Integer; 
begin 
  Schritt := 0; 
  Merk := 0; 
  Elas := Sqrt(Elastisch / 11); 
  With Obj do 
    Repeat 
      Stelle := 1 + Schritt; 
      If Schritt >= 0 then 
      begin 
        if Round(Top + Stelle) >= Unten - Height then 
        begin 
          Merk := Top; 
          Top := Unten - Height; 
          Stelle := Stelle * -Elas; 
          if Stelle > -2 then 
          begin 
            if Top + Height > Unten - 2 then 
              break; 
          end; 
        end 
        else 
          Top := Round(Top + Stelle); 
      end 
      else 
      begin 
        If Round(Top + Stelle) < 0 then 
          Top := 0 
        else if Merk > 0 then 
        begin 
          Top := Merk; 
          Merk := 0; 
          Stelle := Stelle - 1; 
        end 
        else 
          Top := Round(Top + Stelle); 
      end; 
      Schritt := Stelle; 
      Zeit := GetTickCount + Pause; 
      Repeat 
        Application.ProcessMessages; 
      Until GetTickCount >= Zeit; 
    Until stop or Application.Terminated; 
end; 
 
 
// --- Beispielaufruf --- 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  von, bis: Integer; 
begin 
  von := 0; // z.B. 
  bis := ClientHeight; // z.B. 
  stop := false; 
  Image1.Top := von; 
  Hupf(6, 13, Image1, bis); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  stop := true; 
end; 

Zugriffe seit 6.9.2001 auf Delphi-Ecke