Autostereogramm (3D-Bild)

[remi_meier]

Hi Leutz
Hab grad ne schöne Anleitung für Autostereogramme in einem alten "Spektrum der Wissenschaft" gefunden. Wer nicht weiss, was Autostereogramme sind:

Hier ein Zip mit Code und Beispiel: http://mypage.bluewin.ch/remimeier/webs ... Bilder.zip
Und hier der reine Code:

Code: Alles auswählen

;Muster.bmp : Enthält ein (kachelbares,) farbiges Bild mit der gleichen Höhe des Tiefenbildes und einer Breite < Augenabstand
;Tiefenbild.bmp : 24-BitBitmap mit Graustufen. Irgendwelche Grösse. Schwarz=Hinten Weiss=Vorne
;Quelle: Spektrum der Wissenschaft: Digest 2/2002


Structure Bild
  id.l
  Breite.l
  Hoehe.l
  Wert.f
EndStructure


BMuster.Bild\id   = LoadImage(#PB_Any,"Muster.bmp")
BMuster\Breite   = ImageWidth()
BMuster\Hoehe  = ImageHeight()

BTiefen.Bild\id   = LoadImage(#PB_Any,"Tiefenbild.bmp")
BTiefen\Breite   = ImageWidth()
BTiefen\Hoehe   = ImageHeight()

B3D.Bild\id        = CreateImage(#PB_Any,BTiefen\Breite,BTiefen\Hoehe)
B3D\Breite        = BTiefen\Breite
B3D\Hoehe       = BTiefen\Hoehe

If IsImage(BMuster\id) = 0 Or IsImage(BTiefen\id) = 0 Or IsImage(B3D\id) = 0
  Debug "Fehler"
  End
EndIf


UseImage(B3D\id)
StartDrawing(ImageOutput())
  DrawImage(UseImage(BMuster\id), 0, 0)
StopDrawing()

For x = BMuster\Breite To BTiefen\Breite
  For y = 0 To BTiefen\Hoehe
    UseImage(BTiefen\id)
    StartDrawing(ImageOutput())
      BTiefen\Wert = Red(Point(x,y))
    StopDrawing()
    BTiefen\Wert = 1 - (BTiefen\Wert * 0.25 / 255)
    
    UseImage(B3D\id)
    StartDrawing(ImageOutput())
      Plot(x,y,Point(x - (BMuster\Breite * BTiefen\Wert),y))
    StopDrawing()
    
  Next
Next

SaveImage(B3D\id,"3D-Bild.bmp")

MessageRequester("Fertig","Fertig")

Greetz
remi

PS: Wenns sein muss könnte ich den Speed noch mit Win-Api vervielfachen, ist so aber leichter zu verstehen.
Edit: Info: Bei dem Tiefenbild kann man in der Breite des Musters die ersten Pixel nicht gebrauchen.