// 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;
|