Autostereogramm (3D-Bild)
Verfasst: 21.09.2004 15:32
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:
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.
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")
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.