Erstellen von Stereogrammen

[Namenloser]

Also das macht echt keinen Spaß
Habs angefangen udn bin so weit gekommen:

Delphi-Quellcode:

type
  tStereoImage = class
  public
    function getImage(path: string): tbitmap;
    function createStereo(tileimage,pictureimage: tbitmap): tbitmap;
  end;

implementation
   // Bild in GD einlesen
   function tStereoImage.getImage(path: string): tbitmap;
   var gr: tgraphic;
   begin
     result := nil;
     if ansisametext(ExtractFileExt(path),'gif') then
       gr := tGifImage.Create
     else
       gr := tJPEGImage.Create;
     gr.LoadFromFile(path);
     result := tbitmap.create;
     result.assign(gr);
     gr.free;
   end;

   // Stereogramm aus zwei GD- Bildern erzeugen
   function createStereo(tileimage, pictureimage: tBitmap): tBitmap;
   var
     tilewidth,tileheight,x,y: integer;
     picturewidth,pictureheight: integer;
     mincolor,maxcolor: integer;
     space,elevation: integer;
     factor: double;
     color: tcolor;
     stereoimage: tbitmap;
   begin
     result := nil;
     // Tile einlesen
     tilewidth=tileimage.width;
     if tilewidth=0 then exit;
     tileheight=tileimage.Width;
     {
     for y := 0 to tileheight-1 do
       for x := 0 to tilewidth-1 do
       begin
         color := tileimage.Canvas.Pixels[x,y];
         color=imageColorAt($tileimage, $x, $y); if (!is_array($color)) $color=imageColorsForIndex($tileimage, $color);
         color=chr($color[red]).chr($color[green]).chr($color[blue]);
         tile[$y][$x]=$color;
       end;      }
   
     // Tiefenbild einlesen
     mincolor := 256;
     maxcolor := 0;
     picturewidth=pictureimage.width;
     if picturewidth=0 then exit;
     pictureheight=pictureimage.height;
     {
     for ($y=0;$y<$pictureheight;$y+ + )
       for ($x=0;$x<$picturewidth;$x+ + )
       {
         $color=imageColorAt($pictureimage, $x, $y); if (!is_array($color)) $color=imageColorsForIndex($pictureimage, $color);
         $color=floor(($color[red]+ $color[green]+ $color[blue])/3);
         $mincolor=min($mincolor, $color);
         $maxcolor=max($maxcolor, $color);
         $picture[$y][$x]=$color;
       }

     // Höhenfaktor/- verschiebung berechnen
     space := maxcolor- mincolor+1;
     elevation := mincolor;
     factor := space/(tilewidth*0.1); // Max. 10% Verzerrung

     // Stereobild erzeugen
     picturewidth := picturewidth+tilewidth;
     stereoimage := tbitmap.create;
     stereoimage.Width := picturewidth;
     stereoimage.height := pictureheight;
     for x := 0 to picturewidth-1 do
       for y := 0 to pictureheight-1 do
       begin
         // Auf Tile mappen
         sx := x mod tilewidth;
         sy := y mod tileheight;
         // Höhendiff ausrechnen
         rx := x- tilewidth;
         diff := floor(
           (pictureimage.Canvas.Pixels[y][max(rx,0)] - elevation)/ factor)
            + diffs[$y][$rx- $tilewidth];
         $diffs[$y][$x- $tilewidth]=$diff;
         // Höhendiff zum X addieren und clippen
         $sx+ =$diff;
         if ($sx>=$tilewidth) $sx- =$tilewidth; else if ($sx<0) $sx+ =$tilewidth;
         // Pixel kopieren
         $sourcecolor=$tile[$sy][$sx];
         $color=imageColorAllocate($stereoimage, ord($sourcecolor[0]), ord($sourcecolor[1]), ord($sourcecolor[2]));
         imageSetPixel($stereoimage, $x, $y, $color);
       end

     // Sterebild zurückgeben
     return($stereoimage);
   end;}
}

Dann hatte ich keinen Bock mehr. Da müsste man eh noch einiges optimieren, weil die Zugriffe über Canvas.Pixels verdammt langsam sein würden.

Ich kann in den Dingern auch nie was erkennen...^^