// Getestet mit D4 und D7 unter
XP
// Aus einem
(waagerechten
oder senkrechten)
Bild-Strip wird eine
// Animation erstellt.
//
Variante 1
// Eher ein "Klappen" als ein "Rollen". Der Effekt wird noch deutlicher,
// wenn die Variable "Clap"
auf "True"
gestellt wird.
 |
 |
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;
//--------------------------------------------------------------------
//
Variante 2
// Realistischer als Variante 1. Kann vorwärts und rückwärts laufen.
// Bedingung:
Breite und Höhe der Würfelflächen müssen gleich sein!
 |
 |
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;

|