// Mehrmals wurde ich angefragt, wie man in sein Programm kleine Animationen // einbauen kann, ohne AVI's zu benutzen und ohne eine GIF-Komponente einbinden // zu müssen. // Das Problem ist recht einfach zu lösen. Man erstellt mit einem einfachen // Grafik-Programm (zB. PBrush.exe) mehrere Bitmaps mit den einzelnen Phasen des // Films. Die Bilder werden zu einem Strip aneinander gereiht (spart Speicher und // Programmieraufwand). Mit einem Timer wird jeweils eine Phase in ein Image // kopiert. Bei transparenten Bildern ist es wichtig, dass der Punkt in der linken // unteren Ecke in jedem Einzelbild die Farbe hat, welche transparent erscheinen // soll. // Getestet mit D4 unter WinME // Variante 1: Bild für Bild

var 
  bmp: TBitmap; 
  fase: byte; 
  bilder: byte = 4; // Anzahl der Bilder im Strip 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bmp := TBitmap.create; 
  bmp.loadfromfile('d:\FilmStrip.bmp'); // oder aus Ressource laden 
  image1.height := bmp.height; 
  image1.width := bmp.width div bilder; 
  fase := 0; 
  image1.transparent := true; // bei Bedarf 
  Timer1.interval := 155; 
  timer1timer(self); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bmp.free; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  image1.canvas.copyrect(rect(0, 0, image1.width, image1.height), bmp.canvas, 
    rect(fase, 0, fase + image1.width, bmp.height)); 
  inc(fase, image1.width); 
  if fase > (bilder - 1) * image1.width then fase := 0; 
end;

// Variante 2: Pixelzeile für Pixelzeile
//             Durch auflegen einer Maske kann man die Illusion einer Rolle
//             erzeugen (Spielautomat). Oberes und unteres Bild im Strip
//             müssen gleich sein. Die Maske hat Höhe und Breite eines der
//             Teilbilder des Strips.

 

Rolle.bmp	Maske.bmp	Wirkung

var 
  bmp, bmm: TBitmap; 
  fase: byte; 
  bilder: byte = 6; // Anzahl der Bilder im Strip 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bmp := TBitmap.create; 
  bmm := TBitmap.create; 
  bmp.loadfromfile('d:\Rolle.bmp'); // oder aus Ressource laden 
  bmm.loadfromfile('d:\Maske.bmp'); // oder aus Ressource laden 
  image1.height := bmp.height div bilder; 
  image1.width := bmp.width; 
  fase := 0; 
  Timer1.interval := 10; 
  Timer1timer(self); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bmp.free; 
  bmm.free; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  if fase > bmp.height - image1.height then fase := 1; 
  image1.canvas.copyrect(rect(0, 0, image1.width, image1.height), bmp.canvas, 
    rect(0, fase, image1.width, fase + image1.height)); 
  bitblt(image1.canvas.handle, 0, 0, image1.width, image1.height, 
    bmm.canvas.handle, 0, 0, SRCAND); 
  inc(fase); 
end;

// Variante 3: Zeile für Zeile mit Krümmung
//             Hier wird das Grundprinzip gezeigt, wie das Bild auch noch
               gebogen werden kann.
 

Rolle.bmp	Maske.bmp	Wirkung

var 
  b, zeile, maske: TBitmap; 
  oben, h: integer; 
  stop: boolean = true; 
  pause: word = 5; 
 
procedure DrawBobbin(x0, y0, Hoehe: integer; 
  src: TBitmap; cnv: TCanvas; bauchlinks: boolean); 
var 
  y, rx2, ry2, rx4, ry4, F, ddF_x, ddF_y, i, j, yy, z, 
    x0x, b3, Kruemmung, h2: integer; 
  m, xx: single; 
  aus: boolean; 
  procedure makezeile(k: integer); 
  var 
    ps, pd, pm: PBytearray; 
    x: integer; 
  begin 
    ps := src.scanline[k + oben]; 
    pd := zeile.scanline[0]; 
    pm := maske.scanline[trunc(m)]; 
    m := m + 0.5; 
    if m > Hoehe then m := 0; 
    x := 0; 
    while x < b3 do begin 
      pd[x] := (ps[x] and pm[x]); 
      pd[x + 1] := (ps[x + 1] and pm[x + 1]); 
      pd[x + 2] := (ps[x + 2] and pm[x + 2]); 
      inc(x, 3); 
    end; 
  end; 
begin 
  aus := false; 
  Kruemmung := round(Hoehe / 4.5); 
  inc(x0, Kruemmung); 
  h2 := Hoehe + Hoehe; 
  b3 := zeile.width * 3; 
  z := ord(bauchlinks) * 2 - 1; 
  rx2 := Kruemmung * Kruemmung; 
  ry2 := Hoehe * Hoehe; 
  rx4 := rx2 + rx2; 
  ry4 := ry2 + ry2; 
  repeat 
    ddF_x := 0; 
    ddF_y := rx4 * Hoehe; 
    i := 0; 
    j := Hoehe; 
    y := h2 - 1; 
    m := 0; 
    makezeile(y); 
    cnv.draw(x0, y0 + Hoehe, zeile); 
    xx := i + 0.5; 
    yy := pred(j); 
    F := Round(ry2 * xx * xx + rx2 * yy * yy - rx2 * ry2); 
    while j > 0 do begin 
      if F <= 0 then begin 
        inc(i, z); 
        inc(ddF_x, ry4); 
        inc(F, ddF_x); 
      end; 
      dec(j); 
      x0x := x0 - i; 
      dec(ddF_y, rx4); 
      inc(F, rx2 - ddF_y); 
      makezeile(y); 
      cnv.draw(x0x, y0 + j, zeile); 
      makezeile(h2 - y); 
      cnv.draw(x0x, y0 - j, zeile); 
      dec(y); 
      application.processmessages; 
      aus := (stop and (oben mod h2 = 0)) 
        or application.terminated; 
      if aus then break; 
    end; 
    makezeile(0); 
    cnv.draw(x0, y0 - Hoehe, zeile); 
    if aus then break; 
    sleep(pause); 
    inc(oben); 
    if oben = src.height - h2 then oben := 0; 
  until false; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; 
  b := TBitmap.create; 
  b.loadfromfile('c:\bilder\rolle.bmp'); 
  b.pixelformat := pf24bit; 
  h := b.height div 12; // 6 Bilder; zwei Quadranten 
  zeile := TBitmap.create; 
  zeile.pixelformat := pf24bit; 
  zeile.height := 1; 
  zeile.width := b.width; 
  maske := TBitmap.create; 
  maske.loadfromfile('c:\bilder\maske.bmp'); 
  maske.pixelformat := pf24bit; 
  oben := 0; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  b.free; 
  zeile.free; 
  maske.free; 
end; 
 
// Start - Stop 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  stop := not stop; 
  DrawBobbin(30, 50, h, b, canvas, true); 
end;