// Ein Bild wird
auf die verschiedensten Arten pixelweise auf
type
Punktsatz = (vonLinks, RechtsobenLinksunten, vondenSeiten, Raute, vonOben,
Aufzug, vonLinksoben, Klappe, Zufall, hHalb, ausdenEcken, vHalb, Kreis,
Jalousie);
var
lauf: boolean = false;
links: Integer = 16; // z.B.
oben: Integer = 70; // z.B.
procedure punktweise(dest: TCanvas; x, y: Integer; src: TGraphic;
pause: Integer; wie: Punktsatz);
var
w, h, i, j, k, z, ww, hh, sh2, sw2, m1, m2, m3, xx, ep, Radius: Integer;
a: array of array of boolean;
hlp: TBitmap;
procedure kreispix(x1, y1, x2, y2: Integer);
begin
if (y1 + y2 < hlp.height) then
begin
if (x1 + x2 < hlp.width) then
setpixel(dest.handle, x + x1 + x2, y + y1 + y2,
getpixel(hlp.canvas.handle, x1 + x2, y1 + y2));
if (x1 - x2 >= 0) then
setpixel(dest.handle, x + x1 - x2, y + y1 + y2,
getpixel(hlp.canvas.handle, x1 - x2, y1 + y2));
end;
if (y1 - y2 >= 0) then
begin
if (x1 + x2 < hlp.width) then
setpixel(dest.handle, x + x1 + x2, y + y1 - y2,
getpixel(hlp.canvas.handle, x1 + x2, y1 - y2));
if (x1 - x2 >= 0) then
setpixel(dest.handle, x + x1 - x2, y + y1 - y2,
getpixel(hlp.canvas.handle, x1 - x2, y1 - y2));
end;
if (y1 + x2 < hlp.height) then
begin
if (x1 + y2 < hlp.width) then
setpixel(dest.handle, x + x1 + y2, y + y1 + x2,
getpixel(hlp.canvas.handle, x1 + y2, y1 + x2));
if (x1 - y2 >= 0) then
setpixel(dest.handle, x + x1 - y2, y + y1 + x2,
getpixel(hlp.canvas.handle, x1 - y2, y1 + x2));
end;
if (y1 - x2 >= 0) then
begin
if (x1 + y2 < hlp.width) then
setpixel(dest.handle, x + x1 + y2, y + y1 - x2,
getpixel(hlp.canvas.handle, x1 + y2, y1 - x2));
if (x1 - y2 >= 0) then
setpixel(dest.handle, x + x1 - y2, y + y1 - x2,
getpixel(hlp.canvas.handle, x1 - y2, y1 - x2));
end;
end;
begin
if lauf or (src.width < 4) or (src.height < 4) then
exit;
lauf := true;
hlp := TBitmap.create;
hlp.width := src.width;
hlp.height := src.height;
hlp.canvas.draw(0, 0, src);
setlength(a, hlp.width, hlp.height);
zeromemory(@a[0, 0], sizeof(a));
sh2 := round(hlp.height / 2);
sw2 := round(hlp.width / 2);
case wie of
RechtsobenLinksunten:
begin
ww := sh2 + sw2;
hh := 0;
end;
Aufzug, Klappe, vHalb:
begin
hh := sh2 - ord(odd(hlp.height));
ww := hlp.width - 1;
end;
vonLinks:
begin
hh := hlp.width - 1;
ww := hlp.height - 1;
end;
vonLinksoben:
begin
ww := hlp.width + hlp.height;
hh := 0;
end;
vondenSeiten, hHalb:
begin
ww := hlp.height - 1;
hh := sw2 - ord(odd(hlp.width)) + 1;
end;
Jalousie:
begin
ww := hlp.height - 1;
hh := round(hlp.width / 4);
end;
Kreis:
begin
ww := round(sqrt(sqr(sh2) + sqr(sw2))) + 1;
hh := 0;
end;
Raute, ausdenEcken:
begin
if hlp.width > hlp.height then
ww := hlp.width
else
ww := hlp.height;
hh := 0;
end;
else
begin
ww := hlp.width - 1;
hh := hlp.height - 1;
end;
end;
for h := 0 to hh do
for w := 0 to ww do
begin
case wie of
Kreis:
begin
Radius := w;
xx := 0;
ep := 3 - Radius shl 1;
while (xx <= Radius) do
begin
kreispix(sw2, sh2, xx, Radius);
kreispix(sw2, sh2 + 1, xx, Radius);
if (ep < 0) then
ep := 6 + ep + xx shl 2
else
begin
ep := 10 + ep + (xx - Radius) shl 2;
dec(Radius);
end;
inc(xx);
end;
end;
RechtsobenLinksunten:
begin
for k := 0 to w do
begin
m1 := w - k;
m2 := hlp.width - k - 1;
m3 := hlp.height - k - 1;
if (k < hlp.width) and (m1 < hlp.height) then
setpixel(dest.handle, m2 + x, m1 + y,
getpixel(hlp.canvas.handle, m2, m1));
if (m3 >= 0) and (m1 < hlp.width) then
setpixel(dest.handle, m1 + x, m3 + y,
getpixel(hlp.canvas.handle, m1, m3));
end;
end;
Raute:
begin
for k := 0 to w do
begin
m1 := sh2 - k;
m2 := sw2 - k + w;
m3 := sw2 + k - w;
if m1 >= 0 then
begin
if (m2 < hlp.width) then
setpixel(dest.handle, x + m2, y + m1,
getpixel(hlp.canvas.handle, m2, m1));
if (m3 >= 0) then
setpixel(dest.handle, x + m3, y + m1,
getpixel(hlp.canvas.handle, m3, m1));
end;
m1 := sh2 + k;
if m1 < hlp.height then
begin
if m3 >= 0 then
setpixel(dest.handle, x + m3, y + m1,
getpixel(hlp.canvas.handle, m3, m1));
if m2 < hlp.width then
setpixel(dest.handle, x + m2, y + m1,
getpixel(hlp.canvas.handle, m2, m1));
end;
end;
end;
ausdenEcken:
begin
for k := 0 to w do
begin
m1 := w - k;
m2 := hlp.width - w + k - 1;
m3 := hlp.height - k - 1;
if (k <= sh2) then
begin
if (m1 <= sw2) then
begin
setpixel(dest.handle, x + m1, y + k,
getpixel(hlp.canvas.handle, m1, k));
setpixel(dest.handle, x + m1, y + m3,
getpixel(hlp.canvas.handle, m1, m3));
end;
if m2 >= 0 then
begin
setpixel(dest.handle, x + m2, y + k,
getpixel(hlp.canvas.handle, m2, k));
setpixel(dest.handle, x + m2, y + m3,
getpixel(hlp.canvas.handle, m2, m3));
end;
end;
end;
end;
Jalousie:
begin
setpixel(dest.handle, h + x, w + y,
getpixel(hlp.canvas.handle, h, w));
setpixel(dest.handle, hh + h + x - 1, w + y,
getpixel(hlp.canvas.handle, hh + h - 1, w));
setpixel(dest.handle, sw2 + h + x - 1, w + y,
getpixel(hlp.canvas.handle, sw2 + h - 1, w));
setpixel(dest.handle, hlp.width - hh + h + x - 1, w + y,
getpixel(hlp.canvas.handle, hlp.width - hh + h - 1, w));
end;
hHalb:
begin
setpixel(dest.handle, h + x, w + y,
getpixel(hlp.canvas.handle, h, w));
setpixel(dest.handle, sw2 + h + x - 1, w + y,
getpixel(hlp.canvas.handle, sw2 + h - 1, w));
end;
vHalb:
begin
setpixel(dest.handle, w + x, h + y,
getpixel(hlp.canvas.handle, w, h));
setpixel(dest.handle, w + x, sh2 + h + y - 1,
getpixel(hlp.canvas.handle, w, sh2 + h - 1));
end;
Klappe:
begin
setpixel(dest.handle, w + x, h + y,
getpixel(hlp.canvas.handle, w, h));
setpixel(dest.handle, w + x, src.height - 1 - h + y,
getpixel(hlp.canvas.handle, w, src.height - 1 - h));
end;
Aufzug:
begin
setpixel(dest.handle, w + x, h + y + sh2 - 1,
getpixel(hlp.canvas.handle, w, h + sh2 - 1));
setpixel(dest.handle, w + x, sh2 - h + y,
getpixel(hlp.canvas.handle, w, sh2 - h));
end;
vondenSeiten:
begin
setpixel(dest.handle, h + x, w + y,
getpixel(hlp.canvas.handle, h, w));
setpixel(dest.handle, hlp.width - h - 1 + x, w + y,
getpixel(hlp.canvas.handle, hlp.width - h - 1, w));
end;
vonLinksoben:
for k := 0 to w do
begin
if (k < hlp.width) and (w - k < hlp.height) then
setpixel(dest.handle, k + x, w - k + y,
getpixel(hlp.canvas.handle, k, w - k));
end;
vonOben:
setpixel(dest.handle, w + x, h + y,
getpixel(hlp.canvas.handle, w, h));
vonLinks:
setpixel(dest.handle, h + x, w + y,
getpixel(hlp.canvas.handle, h, w));
Zufall:
begin
repeat
i := random(hlp.width);
j := random(hlp.height);
until a[i, j] = false;
setpixel(dest.handle, i + x, j + y,
getpixel(hlp.canvas.handle, i, j));
a[i, j] := true;
end;
end;
for z := 0 to pause do
application.processmessages;
if application.terminated or not lauf then
break;
end;
a := nil;
hlp.free;
lauf := false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.visible := false;
// z.B.:
// Image1.Picture.Bitmap.Loadfromfile('D:\Bilder\dt.bmp');
end;
// --- Beispiele ---
procedure TForm1.Button10Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, Kreis);
end;
procedure TForm1.Button11Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, ausdenEcken);
end;
procedure TForm1.Button12Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, vondenSeiten);
end;
procedure TForm1.Button13Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, vonOben);
end;
procedure TForm1.Button14Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, vonLinks);
end;
procedure TForm1.Button15Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 25, vonLinksoben);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, Zufall);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
lauf := false;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 25, Raute);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 25,
RechtsobenLinksunten);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 15, Aufzug);
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 0, Klappe);
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, vHalb);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, Jalousie);
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
lauf := false;
refresh;
punktweise(canvas, links, oben, Image1.Picture.graphic, 10, hHalb);
end;
|
