type 
  TForm1 = class(TForm) 
    Timer1: TTimer; 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    function fy(w: integer): integer; 
    procedure build(b: TBitmap; dark: integer); 
    procedure Start(number: byte); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses jpeg; 
 
const 
  reference = 90; // wichtig; 
 
var 
  wideness, altitude, x, y, amount, step, midpoint, 
    phase, wich1, wich2, w3: integer; 
  horizontal, clap: boolean; 
  bm, pic1, pic2: TBitmap; 
  speed, delay: cardinal; 
  p2, p9, a2: double; 
  Target: TCanvas; 
  stop: byte; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  jp: TJpegImage; 
begin 
  Target := Canvas; 
  x := 100; // links auf Target 
  y := 125; // oben auf Taregt 
  Timer1.interval := 0; 
  jp := TJpegImage.create; 
  jp.loadfromfile('jpstrip.jpg'); 
  bm := TBitmap.create; 
  bm.assign(jp); 
  jp.free; 
  amount := 6; // Anzahl der Einzel-Bilder 
  horizontal := bm.width > bm.height; 
  if horizontal then begin 
    altitude := bm.height; 
    wideness := bm.width div amount; 
  end else begin 
    altitude := bm.height div amount; 
    wideness := bm.width; 
  end; 
  step := 15; // 2,3,5,6,9,10,15 
  midpoint := altitude div 2; 
  delay := 180; 
  speed := 78; 
  p2 := pi / 2; 
  p9 := pi / reference; 
  w3 := wideness * 3; 
  a2 := altitude / 2; 
  pic1 := TBitmap.create; 
  pic1.pixelformat := pf24bit; 
  pic1.width := wideness; 
  pic2 := TBitmap.create; 
  pic2.pixelformat := pf24bit; 
  pic2.width := wideness; 
  clap := false; 
  stop := amount + 1; // Dauerlauf 
  {stop := 4; // bleibt bei 4 stehen} 
end; 
 
function TForm1.fy(w: integer): integer; 
begin 
  result := trunc(sin(p9 * w - p2) * a2) + midpoint; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
  pic1.free; 
  pic2.free; 
end; 
 
procedure TForm1.build(b: TBitmap; dark: integer); 
var 
  i, j: Integer; 
  p: PBytearray; 
  function eclipse(a, d: integer): integer; 
  asm 
  sub eax, edx 
  cmp eax, 0 
  jge @fertig 
  xor eax, eax 
 @fertig: 
  end; 
begin 
  for j := 0 to b.height - 1 do begin 
    p := b.scanline[j]; 
    i := 0; 
    while i < w3 do begin 
      p[i] := eclipse(p[i], dark); 
      p[i + 1] := eclipse(p[i + 1], dark); 
      p[i + 2] := eclipse(p[i + 2], dark); 
      inc(i, 3); 
    end; 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  i, z, o, s: integer; 
  period: cardinal; 
begin 
  i := fy(phase); 
 
  pic1.height := i; 
  SetStretchBltMode(pic1.canvas.handle, STRETCH_HALFTONE); 
  if horizontal then pic1.canvas.copyrect(rect(0, 0, wideness, i), 
      bm.canvas, rect(wideness * wich1, 0, wideness * wich1 + wideness, altitude)) 
  else pic1.canvas.copyrect(rect(0, 0, wideness, i), 
      bm.canvas, rect(0, wich1 * altitude, wideness, wich1 * altitude + altitude)); 
  build(pic1, reference - phase); 
 
  o := ord(clap); 
  z := i * o; 
  s := step * o; 
  pic2.height := altitude - i; 
  SetStretchBltMode(pic2.canvas.handle, STRETCH_HALFTONE); 
  if horizontal then pic2.canvas.copyrect(rect(0, 0, wideness, pic2.height), 
      bm.canvas, rect(wideness * wich2, z, wideness * wich2 + wideness, altitude)) 
  else 
    pic2.canvas.copyrect(rect(0, 0, wideness, pic2.height), 
      bm.canvas, rect(0, wich2 * altitude + z, wideness, 
      wich2 * altitude + altitude)); 
  if phase > s then 
    build(pic2, phase - s); 
 
  Target.draw(x, y, pic1); 
  Target.draw(x, y + i, pic2); 
 
  if phase >= reference then begin 
    Timer1.interval := 0; 
    phase := step; 
    inc(wich1); 
    if (wich1 = stop) or (stop = 0) then exit; 
    if wich1 = amount then wich1 := 0; 
    wich2 := pred(wich1); 
    if wich2 < 0 then wich2 := pred(amount); 
    period := gettickcount + delay; 
    repeat 
      application.processmessages; 
      if application.terminated then exit; 
    until (gettickcount >= period); 
    Timer1.interval := speed; 
  end else 
    inc(phase, step); 
end; 
 
procedure TForm1.Start(number: byte); 
begin 
  if (number < 1) or (number > amount) 
    then showmessage('Error') else begin 
    wich2 := number - 1; 
    if number = amount then number := 0; 
    wich1 := number; 
    if (stop > 0) and (stop <> number) or (stop > amount) then begin 
      phase := 0; 
      Timer1Timer(Timer1); 
      application.processmessages; 
      sleep(delay); 
      timer1.interval := speed; 
    end; 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  // stop := amount + 1; 
  randomize; 
  start(random(amount) + 1); // mit irgendeiner Zahl beginnen 
end; 
 
// Bei nächster voll-sichtbaren Zahl anhalten 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  stop := 0; 
end; 
 
// Methode umschalten 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  clap := not clap; 
end; 

type 
  TForm1 = class(TForm) 
    Timer1: TTimer; 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Button4: TButton; 
    Button5: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
    procedure Button5Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    function fy(w: double): integer; 
    procedure build(b: TBitmap; dark: integer); 
    procedure Start(number: byte); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses jpeg; 
 
const 
  reference = 90; // wichtig; 
  step = 5; // wichtig; 
 
var 
  wideness, x, y, amount, midpoint, wich1, wich2, wich, diff, 
    phase, w3, outset: integer; 
  horizontal, direction, forwards, running: boolean; 
  diagonal, p9, p2, a2: double; 
  bm, pic1, pic2: TBitmap; 
  speed, delay: cardinal; 
  Target: TCanvas; 
  stop: byte; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  jp: TJpegImage; 
begin 
  running := false; 
  Target := Canvas; 
  x := 100; // links auf Target 
  y := 125; // oben auf Taregt 
  Timer1.interval := 0; 
  jp := TJpegImage.create; 
  bm := TBitmap.create; 
  try 
    jp.loadfromfile('jpstrip2.jpg'); 
    bm.assign(jp); 
  finally 
    jp.free; 
  end; 
  amount := 6; // Anzahl der Einzel-Bilder 
  horizontal := bm.width > bm.height; 
  if horizontal then 
    wideness := bm.height 
  else wideness := bm.width; 
  inc(wideness, ord(not odd(wideness))); 
  diagonal := sqrt(sqr(wideness) * 2); 
  midpoint := round(diagonal / 2); 
  diff := round((diagonal - wideness) / 2); 
  delay := 0; 
  speed := 60; 
  p2 := 2.21; 
  p9 := pi / reference; 
  w3 := wideness * 3; 
  a2 := diagonal / 2; 
  Target.Brush.color := color; // beachten 
  outset := -4; 
  pic1 := TBitmap.create; 
  pic1.pixelformat := pf24bit; 
  pic1.width := wideness; 
  pic2 := TBitmap.create; 
  pic2.pixelformat := pf24bit; 
  pic2.width := wideness; 
  wich := 1; 
  direction := true; // vorwärts rollen 
  forwards := true; // Zahlen laufen aufsteigend 
end; 
 
function TForm1.fy(w: double): integer; 
begin 
  result := trunc(sin(p9 * w - p2) * a2) + midpoint; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bm.free; 
  pic1.free; 
  pic2.free; 
end; 
 
procedure TForm1.build(b: TBitmap; dark: integer); 
var 
  i, j: Integer; 
  p: PBytearray; 
  function eclipse(a, d: integer): integer; 
  asm 
  sub eax, edx 
  cmp eax, 0 
  jge @fertig 
  xor eax, eax 
 @fertig: 
  end; 
begin 
  for j := 0 to b.height - 1 do begin 
    p := b.scanline[j]; 
    i := 0; 
    while i < w3 do begin 
      p[i] := eclipse(p[i], dark); 
      p[i + 1] := eclipse(p[i + 1], dark); 
      p[i + 2] := eclipse(p[i + 2], dark); 
      inc(i, 3); 
    end; 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  j000, j135, j270, j405, w1, w2: integer; 
  period: cardinal; 
begin 
  j000 := fy(phase); 
  j135 := fy(phase + 135); 
  j270 := fy(phase + 270); 
  j405 := fy(phase + 405); 
 
  pic1.height := j270 - j135; 
  pic2.height := j405 - j270; 
 
  if forwards then begin 
    w1 := wich1; 
    w2 := wich2; 
  end else begin 
    w1 := amount - wich1 - 1; 
    w2 := amount - wich2 - 1; 
  end; 
 
  SetStretchBltMode(pic1.canvas.handle, STRETCH_HALFTONE); 
  if horizontal then pic1.canvas.copyrect(rect(0, 0, pic1.width, pic1.height), 
      bm.canvas, rect(bm.height * w1, 0, bm.height * w1 + bm.height, 
      bm.height)) 
  else pic1.canvas.copyrect(rect(0, 0, pic1.width, pic1.height), 
      bm.canvas, rect(0, w1 * bm.width, bm.width, 
      w1 * bm.width + bm.width)); 
 
  SetStretchBltMode(pic2.canvas.handle, STRETCH_HALFTONE); 
  if horizontal then pic2.canvas.copyrect(rect(0, 0, pic2.width, pic2.height), 
      bm.canvas, rect(bm.height * w2, 0, bm.height * w2 + bm.height, 
      bm.height)) 
  else pic2.canvas.copyrect(rect(0, 0, pic2.width, pic2.height), 
      bm.canvas, rect(0, w2 * bm.width, bm.width, 
      w2 * bm.width + bm.width)); 
 
  build(pic1, reference - (phase - outset) * 2); 
  build(pic2, (phase - outset) * 2); 
 
  target.fillrect(rect(x, y, x + wideness, y + j000)); 
  target.fillrect(rect(x, y + j270, x + wideness, trunc(y + diagonal))); 
  if direction then begin 
    Target.draw(x, y + j000, pic1); 
    Target.draw(x, y + j405, pic2); 
  end else begin 
    Target.draw(x, y + j135, pic1); 
    Target.draw(x, y + j000, pic2); 
  end; 
 
  if phase - outset >= reference div 2 then begin 
    Timer1.interval := 0; 
    phase := outset + step; 
    inc(wich1); 
    if (wich1 = stop) and forwards 
      or not forwards and (wich1 = succ(amount - stop)) 
      or (stop = 0) then begin 
      wich := wich1; 
      running := false; 
      exit; 
    end; 
    if wich1 = amount then wich1 := 0; 
    wich2 := pred(wich1); 
    if wich2 < 0 then wich2 := pred(amount); 
    period := gettickcount + delay; 
    repeat 
      application.processmessages; 
      if application.terminated then exit; 
    until (gettickcount >= period); 
    Timer1.interval := speed; 
  end else 
    inc(phase, step); 
end; 
 
procedure TForm1.Start(number: byte); 
begin 
  if (number < 1) or (number > amount) 
    then begin 
    stop := 0; 
    showmessage('Error'); 
  end else begin 
    wich2 := number - 1; 
    if number = amount then number := 0; 
    wich1 := number; 
    phase := outset; 
    if (stop > 0) and (stop <> number) or (stop > amount) then begin 
      running := true; 
      Timer1Timer(Timer1); 
      application.processmessages; 
      sleep(delay); 
      Timer1.interval := speed; 
    end; 
  end; 
end; 
 
// --- Beispielaufrufe --- 
 
// Start mit einer bestimmten Zahl 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if not running then begin 
    stop := amount + 1; // Dauerlauf 
    start(3); // startet mit der Zahl 3 
  end; 
end; 
 
// Neustart nach einem Stopp 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if not running then begin 
    stop := amount + 1; 
    start(wich); // startet mit der Zahl, bei der angehalten wurde 
  end; 
end; 
 
// Bei nächster komplett sichtbaren Zahl anhalten 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  if running then stop := 0; 
end; 
 
// bei einer bestimmten Zahl anhalten 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  if running then stop := 5; // hält bei der Zahl 5 an 
end; 
 
// Richtungswechsel während des Laufes 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  if running then begin 
    stop := 0; 
    while running do begin 
      application.processmessages; 
      if application.terminated then exit; 
    end; 
    if wich1 > wich2 then 
      wich := succ(amount - wich1) 
    else wich := succ(wich2); 
    direction := not direction; 
    forwards := not forwards; 
    stop := succ(amount); 
    sleep(delay); 
    start(wich); 
  end; 
end;