// Ein Bild wird pixelweise auf einer Zeichenfläche (TCanvas) abgebildet.
// Dabei dürfte der Typ "
Zufall" am interessantesten sein.


// Getestet mit D4 unter XP

type 
  Punktsatz = (vonLinks, RechtsobenLinksunten, vondenSeiten, Raute, vonOben, 
    Aufzug, vonLinksoben, Klappe, Zufall, hHalb, ausdenEcken, vHalb, 
    Kreis, Jalousie); 
 
var 
  lauf: boolean = false; 
 
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)); 
  pause := abs(pause * 150000) div (hlp.width * hlp.height * 2); 
  sh2 := round(hlp.height / 2); 
  sw2 := round(hlp.width / 2); 
  case wie of 
    RechtsobenLinksunten: 
      begin 
        ww := sh2 + sw2; 
        hh := 0; 
        pause := pause * ww; 
      end; 
    Aufzug, Klappe, vHalb: 
      begin 
        hh := sh2 - ord(odd(hlp.height)) + 1; 
        ww := hlp.width - 1; 
        inc(pause, pause); 
      end; 
    vonLinks: 
      begin 
        hh := hlp.width - 1; 
        ww := hlp.height - 1; 
      end; 
    vonLinksoben: 
      begin 
        ww := hlp.width + hlp.height; 
        hh := 0; 
        pause := pause * ww div 3; 
      end; 
    vondenSeiten, hHalb: 
      begin 
        ww := hlp.height - 1; 
        hh := sw2 - ord(odd(hlp.width)) + 1; 
        inc(pause, pause); 
      end; 
    Jalousie: 
      begin 
        ww := hlp.height - 1; 
        hh := round(hlp.width / 4); 
        pause := pause * 4 
      end; 
    Kreis: 
      begin 
        ww := round(sqrt(sqr(sh2) + sqr(sw2))) + 1; 
        hh := 0; 
        pause := pause * 35000 div ww; 
      end; 
    Raute, ausdenEcken: 
      begin 
        if hlp.width > hlp.height then ww := hlp.width 
        else ww := hlp.height; 
        hh := 0; 
        pause := pause * ww; 
      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; 
 
// Bildaufbau unterbrechen 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  lauf := false; 
end; 
 
// --- Beispielaufrufe --- 
 
// Beispiel 1 
 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  Image1.visible := false; 
  Image1.Picture.loadfromfile('c:\test8.bmp'); 
  punktweise(Canvas, 150, 50, Image1.picture.graphic, 200, Zufall); 
end; 
 
// Beispiel 2 
 
procedure TForm1.Button6Click(Sender: TObject); 
var 
  x, y: integer; 
  zeit: cardinal; 
begin 
  Button6.enabled := false; 
  Image1.visible := false; 
  randomize; 
  Image1.left := 150; 
  Image1.top := 50; 
  for x := 0 to 7 do begin 
    y := x * 2; 
    if y > 13 then y := y - 13; 
    Image1.Picture.loadfromfile('c:\haus.bmp'); 
    punktweise(Canvas, Image1.left, Image1.top, Image1.picture.graphic, 
      450, punktsatz(y)); 
    zeit := gettickcount + 1000; 
    repeat 
      application.processmessages; 
      if application.terminated then exit; 
    until gettickcount >= zeit; 
    y := x * 2 + 1; 
    if y > 13 then y := y - 13; 
    Image1.Picture.loadfromfile('c:\Frau.bmp'); 
    punktweise(Canvas, Image1.left, Image1.top, Image1.picture.graphic, 
      450, punktsatz(y)); 
    zeit := gettickcount + 1000; 
    repeat 
      application.processmessages; 
      if application.terminated then exit; 
    until gettickcount >= zeit; 
  end; 
  refresh; 
  button6.enabled := true; 
end; 


 

Zugriffe seit 6.9.2001 auf Delphi-Ecke