Viewing Tips
Web Sites

Depth Masks

Text Algorithm
Pixel Algorithm
Smart Links
Hidden Surface
Over Sampling
All Combined

Stereogram Algorithms - Basic
It takes surprisingly few lines of code to generate a stereogram. The 25 lines of code below will create a sterogram.

Stereograms created by this minimal code are fun to view, but suffer from several visual shortcomings - primarily the apparent layering of the object being viewed. Other visual issues (echoes, artifacts, holes, ...) can also be seen in the results of the basic code.

Fortunately, improvements in the basic algorithm are available which can significantly improve the resulting stereograms. These algorithm improvements, and the source code to implement them, are discussed on other pages (see the menu links under Algorithm on the left side of this page).

  • Smart Links
  • Hidden Surface Removal
  • Oversampling
  • Center-out Processing

Basic Stereogram Source Code
In this example, two pictureboxes are used - one to provide the depth information (picDepth) and one to display the stereogram (picOut).

1   Dim x As Long, y As Long, maxX As Long, maxY As Long, same() As Long  'basic
2   Dim z() As Single, mu As Single, E As Long, DPI As Long, s As Long    'basic
3   Dim right As Long, left As Long, w As Single                          'basic
4   DPI = 72:  E = 2.5 * DPI:  mu = 0.2: w = 0.5
5   maxX = picDepth.ScaleWidth: maxY = picDepth.ScaleHeight
6   ReDim same(maxX), z(maxX, maxY): Randomize
7   For y = 0 To maxY
8     For x = 0 To maxX - 1                                      '1 scanline
9       z(x, y) = picDepth.Point(x, y) / 16777215              'initialize
10      same(x) = x                                            'initialize
11      s = (1 - mu * z(x, y)) * E / (2 - mu * z(x, y))        'image plane separation
12      left = x - (s / 2)                                     'left link position
13      right = left + s                                       'right link position
14      If 0 <= left And right < maxX Then same(left) = right  'create link
15    Next x
16    For x = maxX - 1 To 0 Step -1                              'set colors
17      If same(x) = x Then
18        picOut.PSet (x, y), Int(Rnd + w) * vbWhite             'random Rnd*vbwhite for color
19      Else
20        picOut.PSet (x, y), picOut.Point(same(x), y)           'use link color
21      End If
22    Next x
23  Next y

Code Discussion
The code works in the following way ...