Stereogram Algorithms - Smart Links
This page shows how to modify the basic stereogram code to incorporate an
improved algorithm for creating links (called 'smart links').
Basic Stereogram with Smart Links Source Code:
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 Dim L As Long 'smart links
5 DPI = 72: E = 2.5 * DPI: mu = 0.2: w = 0.5
6 maxX = picDepth.ScaleWidth: maxY = picDepth.ScaleHeight
7 ReDim same(maxX), z(maxX, maxY): Randomize
8 For y = 0 To maxY
9 For x = 0 To maxX - 1 '1 scanline
10 z(x, y) = picDepth.Point(x, y) / 16777215 'initialize
11 same(x) = x 'initialize
12 s = (1 - mu * z(x, y)) * E / (2 - mu * z(x, y)) 'image plane separation
13 left = x - (s / 2) 'left link position
14 right = left + s 'right link position
15 If 0 <= left And right < maxX Then
16 L = same(left) 'begin smart links code
17 While (L <> left) And (L <> right) '
18 If L < right Then '
19 left = L '
20 L = same(left) '
21 Else '
22 same(left) = right '
23 left = right '
24 L = same(left) '
25 right = L '
26 End If '
27 Wend
28 same(left) = right 'create link
29 End If
30 Next x
31 For x = maxX - 1 To 0 Step -1 'set colors
32 If same(x) = x Then
33 picOut.PSet (x, y), Int(Rnd + w) * vbWhite 'Rnd*vbwhite for color
34 Else
35 picOut.PSet (x, y), picOut.Point(same(x), y) 'use link color
36 End If
37 Next x
38 Next y
Code Discussion
The smart link code, found in lines 17-28, works in the following way ...
|
