Erstellen von Stereogrammen

[bundy]

Hi meine Lieben.

Ich will ein Tool schreiben mit welchen man Steriogramme erstellen kann.
Steriogramme sind jene Bilder in welche man 3D Bilder sehen kann, täuschung des Auges.
Ich hab da einen Sorcecode gefunden der das macht, aber leider ist dieser in PHP geschrieben.

Leider kann ich kein PHP.
Könnte mir wer von euch diesen Codeteil übersetzen in Pascal ?

Delphi-Quellcode:

   class StereoImage 
   { 
   // Bild in GD einlesen 
   function getImage($path) 
   { 
   if (ereg(".gif\$", $path)) $image=imageCreateFromGIF($path); else $image=imageCreateFromJPEG($path); 
   return($image); 
   } 
    
   // Stereogramm aus zwei GD- Bildern erzeugen 
   function createStereo($tileimage, $pictureimage) 
   { 
   // Tile einlesen 
   $tilewidth=imageSX($tileimage); if (!$tilewidth) return(false); 
   $tileheight=imageSY($tileimage); 
   for ($y=0;$y<$tileheight;$y+ + ) 
   for ($x=0;$x<$tilewidth;$x+ + ) 
   { 
   $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; 
   } 
    
   // Tiefenbild einlesen 
   $mincolor=256; 
   $picturewidth=imageSX($pictureimage); if (!$picturewidth) return(false); 
   $pictureheight=imageSY($pictureimage); 
   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+ =$tilewidth; 
   $stereoimage=imageCreateTrueColor($picturewidth, $pictureheight); 
   for ($x=0;$x<$picturewidth;$x+ + ) 
   for ($y=0;$y<$pictureheight;$y+ + ) 
   { 
   // Auf Tile mappen 
   $sx=$x % $tilewidth; 
   $sy=$y % $tileheight; 
   // Höhendiff ausrechnen 
   $rx=$x- $tilewidth; 
   $diff=floor(($picture[$y][$rx<0?0:$rx]- $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); 
   } 
    
   // Sterebild zurückgeben 
   return($stereoimage); 
   } 
}

Beschreibung zum Code, und was er machen soll:
BESCHREIBUNG


Ich bedanke mich im Voraus

lg
bundy

[RavenIV]

Während meines Studium (ca. 1998 / 1999) waren diese Zeichnugnen bei uns sehr gefragt.
Damals hatt ich auch einen Code in Pascal gehabt, der die Dinger berechnet und gemalt hat.
Man konnte ein Bild nehmen und dieses wurde so "verfremdet", dass ein Stereogramm dabei rauskam.

Aber vermutlich habe ich diesen Code nicht mehr.
Als die Dinger aus der Mode kamen, hab ich das Projekt bestimmt wieder gelöscht.
Der Code muss aber noch irgendwo im Internet liegen, ich hab ihn ja auch nur angepasst und erweitert...

[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...^^

[bundy]

danke für eure bemühungen !!

werd mal weiterbasteln an dem code !!

Super

lg
bundy

[RavenIV]

Zitat von NamenLozer:

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

Bei mir hat es auch ne Weile gedauert, bis ich die Bilder erkennen konnte.
Dann hat es auf einmal "Klick" gemacht und ich hatte ne Pyramide vor Augen.
Dann ist es immer schneller gegangen und zum Schluss brauchte ich ein solches Bild nur anzuschauen und sah das Kunstwerk.
Richtig heftig war es für mich dann nur noch, wenn's in Schwarz-Weiss gedruckt war.
Dann habe ich immer lange gebraucht.

Und für alle, die das nicht kennen, hier ein paar Bilder zu Anschauen.

Und ein Delphi-Projekt, das ich im I-net gefunden habe.
Musst halt mal schauen, ob Du daraus was "lernen" kannst.

[bundy]

hy danke für das Beispiel, cooles teil