Attribute VB_Name = "Module2"
Option Explicit
Rem Anaglyph-stereo Globals


Rem Image width and height
Public stereowidth As Integer
Public stereoheight As Integer
Rem the solution at the cursor location
Public Xa As Double, Ya As Double, Za As Double
Rem Solution when doubleclicked
Public Xanasol As Double, Yanasol As Double, Zanasol As Double
Rem Solution at startup
Public start_X As Double, start_Y As Double, start_Z As Double
Rem strings
Public cdummy As String, cfilenameleft As String, cfilenameright As String
Rem geometry
Public xmin As Double, ymax As Double, pixelw As Double
Rem width, height and colormodel of the normalized iamges
Public nwidth As Integer, nheight As Integer, colormodel As Integer
Rem Focal lenghts
Public l_fn As Double, r_fn As Double
Rem Affine cefficients
Public la_ As Double, lb_ As Double, lc_ As Double, ld_ As Double, le_ As Double, lf_ As Double
Public ra_ As Double, rb_ As Double, rc_ As Double, rd_ As Double, re_ As Double, rf_ As Double
Rem Perspective centers
Public r_Xo As Double, r_Yo As Double, r_Zo As Double, l_Xo As Double, l_Yo As Double, l_Zo As Double
Rem Normalizing R-matrices
Public Rn_l(1 To 3, 1 To 3) As Double, Rn_r(1 To 3, 1 To 3) As Double
Rem Central proj. Object-to-image R-mayrices
Public R_l(1 To 3, 1 To 3) As Double, R_r(1 To 3, 1 To 3) As Double
Rem Needed ?
Public ImaOriCol As Double, ImaOriRow As Double
Rem coordinates of the normalized image at the origin
Public ImaOrixn As Double, Imaoriyn As Double
Public RImaOrixn As Double, RImaoriyn As Double
Rem center coordinates (image) in the view-window, and HALF width & height of view-window
Public rcrow As Integer, rccol As Integer, lcrow As Integer, lccol As Integer, ww As Integer, wh As Integer
Rem Where (image rectangles) to look for the view image (anaglyph) sources
Public lstartcol As Long, rstartcol  As Long, lstartrow As Long, rstartrow As Long, lendcol As Long, lendrow As Long, rendcol As Long, rendrow As Long
Rem
Public StereoZoomf As Integer

Public LeftImaOriRow As Integer
Public LeftImaOriCol As Integer
Public RightImaOriRow As Integer
Public RightImaOriCol As Integer
Public offset As Integer

Public lfile() As Byte
Public rfile() As Byte
Public ofile() As Byte


 


Public Sub set_stereo_window_size()
stereowidth = (Form5.ScaleWidth - 50)
stereowidth = stereowidth + (stereowidth * 3) Mod 4
stereoheight = Form5.ScaleHeight - 50 - Form5.ScaleHeight Mod 4 + 4
End Sub


Public Sub echo_anaglyph_on_screen()
Dim k As Double, x0 As Double, y0 As Double, xn As Double, yn As Double
Dim X As Double, Y As Double, z As Double
    ' camera coordinates
      
    k = (R_l(1, 3) * (Xa - l_Xo) + R_l(2, 3) * (Ya - l_Yo) + R_l(3, 3) * (Za - l_Zo))
    x0 = -l_fn * (R_l(1, 1) * (Xa - l_Xo) + R_l(2, 1) * (Ya - l_Yo) + R_l(3, 1) * (Za - l_Zo)) / k
    y0 = -l_fn * (R_l(1, 2) * (Xa - l_Xo) + R_l(2, 2) * (Ya - l_Yo) + R_l(3, 2) * (Za - l_Zo)) / k
    ' normalized coordinates
    xn = -l_fn * (Rn_l(1, 1) * x0 + Rn_l(1, 2) * y0 - Rn_l(1, 3) * l_fn) / (Rn_l(3, 1) * x0 + Rn_l(3, 2) * y0 - Rn_l(3, 3) * l_fn)
    yn = -l_fn * (Rn_l(2, 1) * x0 + Rn_l(2, 2) * y0 - Rn_l(2, 3) * l_fn) / (Rn_l(3, 1) * x0 + Rn_l(3, 2) * y0 - Rn_l(3, 3) * l_fn)
    ' its row, col values
    lcrow = (ymax - yn) / pixelw
    lccol = Abs(xmin - xn) / pixelw
    ww = (stereowidth) / 2
    wh = (stereoheight) / 2
    ImaOrixn = xn - (ww - 1) * pixelw
    Imaoriyn = yn + (wh - 1) * pixelw
    LeftImaOriRow = lcrow - (wh - 1)
    LeftImaOriCol = lccol - (ww - 1)
    k = (R_r(1, 3) * (Xa - r_Xo) + R_r(2, 3) * (Ya - r_Yo) + R_r(3, 3) * (Za - r_Zo))
    x0 = -r_fn * (R_r(1, 1) * (Xa - r_Xo) + R_r(2, 1) * (Ya - r_Yo) + R_r(3, 1) * (Za - r_Zo)) / k
    y0 = -r_fn * (R_r(1, 2) * (Xa - r_Xo) + R_r(2, 2) * (Ya - r_Yo) + R_r(3, 2) * (Za - r_Zo)) / k
    ' normalized coordinates
    xn = -r_fn * (Rn_r(1, 1) * x0 + Rn_r(1, 2) * y0 - Rn_r(1, 3) * r_fn) / (Rn_r(3, 1) * x0 + Rn_r(3, 2) * y0 - Rn_r(3, 3) * r_fn)
    yn = -r_fn * (Rn_r(2, 1) * x0 + Rn_r(2, 2) * y0 - Rn_r(2, 3) * r_fn) / (Rn_r(3, 1) * x0 + Rn_r(3, 2) * y0 - Rn_r(3, 3) * r_fn)
    ' its row, col values
    RImaOrixn = xn - (ww - 1) * pixelw + offset * pixelw
    RImaoriyn = yn + (wh - 1) * pixelw
    rcrow = (ymax - yn) / pixelw
    rccol = Abs(xmin - xn) / pixelw + offset
    RightImaOriRow = rcrow - (wh - 1)
    RightImaOriCol = rccol - (ww - 1)
    StereoZoomf = 1
Rem lstartcol, rstartcol ,  lstartrow , rstartrow , lendcol , lendrow , rendcol , rendrow
lstartcol = (lccol - (ww - 1))
rstartcol = (rccol - (ww - 1))
lstartrow = (lcrow - (wh - 1))
rstartrow = (rcrow - (wh - 1))
lendcol = (lccol + ww)
lendrow = (rccol + ww)
rendcol = (lcrow + wh)
rendrow = (rcrow + wh)


End Sub
Public Sub namewrapper()
Dim lfile_in_str As String, rfile_in_str As String, outfile_in_str As String
Dim lengthl As Integer, lengthr As Integer, lengtho As Integer
lfile_in_str = cfilenameleft
rfile_in_str = cfilenameright
outfile_in_str = "c:\data\pic_left.bmp"
lengthl = Len(lfile_in_str)
lengthr = Len(rfile_in_str)
lengtho = Len(outfile_in_str)

Rem Declare a "char array" (C) for passing the filename to the C-function
ReDim lfile(0 To lengthl) As Byte
ReDim rfile(0 To lengthr) As Byte
ReDim ofile(0 To lengtho) As Byte
Dim i As Integer
For i = 0 To lengthl - 1
lfile(i) = CByte(Asc(Mid$(lfile_in_str, i + 1, 1)))
Next i

For i = 0 To lengthr - 1
rfile(i) = CByte(Asc(Mid$(rfile_in_str, i + 1, 1)))
Next i

For i = 0 To lengtho - 1
ofile(i) = CByte(Asc(Mid$(outfile_in_str, i + 1, 1)))
Next i

End Sub

Public Sub create_bmp_ana(ByVal lfile As String, ByVal rfile As String, ByVal lstartcol As Integer, ByVal rstartcol As Integer, ByVal lstartrow As Integer, ByVal rstartrow As Integer, ByVal lendcol As Integer, ByVal lendrow As Integer, ByVal rendcol As Integer, ByVal rendrow As Integer, FileName As String, ByVal pan_x As Double, ByVal pan_y As Double, ByVal nwidth As Long, ByVal nheight As Long)

Rem Declarations Needed for BMP-printing
Rem This subroutine receives a byte array (intensity image 8-bits / pixel)
Rem Calculates need for byte padding (4-byte segments / line )

Dim byteapu As Byte
Dim hederi As BITMAPINFOHEADER ' 40 bytes
Dim varitaulu(0 To 255) As RGBQUAD
Dim bmicolor As RGBQUAD
Dim isohederi As BITMAPINFO
Dim filehederi As BITMAPFILEHEADER ' 14 bytes
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, N As Integer, lisa As Integer
Dim W_byte_array As Integer, H_byte_array As Integer
Dim i_step As Integer
Dim j_step As Integer
Dim isum As Integer, apusum As Integer, maxh As Integer
Dim paikka As Long
Dim colorm As Integer

H_byte_array = stereoheight
W_byte_array = stereowidth

' On Error GoTo error_in_creating_bmp_file

Open FileName For Binary As 1
Dim padding As Integer

lisa = (W_byte_array * 3) Mod 4
If lisa = 0 Then
 padding = 0
 Else
 padding = 4 - lisa
End If

If colormodel = 0 Then
 colorm = 1
Else
 colorm = 3
End If

ReDim bkuva(0 To (W_byte_array - 1) + (padding), 0 To H_byte_array - 1) As RGBQ

filehederi.bfType = &H4D42
filehederi.bfSize = (CLng(W_byte_array + padding) * CLng(H_byte_array) * CLng(3))
filehederi.bfReserved1 = &H0
filehederi.bfReserved2 = &H0

filehederi.bfOffBits = &H36 ' 55 (54 byte offset, read 55th as first data-byte)

Rem aking Dib - bitmap , header is defined here
hederi.biSize = CLng(40)  ' 4 bytes
hederi.biWidth = CLng(W_byte_array) ' 4
hederi.biHeight = CLng(-H_byte_array) ' 4
Rem By making Height negative we assume (WINDOWS programs assume) it's a BMP with Low-left corner on first scan-line!!
hederi.biPlanes = CInt(1) ' 2
hederi.biBitCount = CInt(24) '2
hederi.biCompression = CLng(0) '4
hederi.biSizeImage = CLng(0) '4
hederi.biXPelsPerMeter = CLng(0) '4
hederi.biYPelsPerMeter = CLng(0) '4
hederi.biClrUsed = CLng(0) '4
hederi.biClrImportant = CLng(0) '4
isohederi.bmiHeader = hederi

Put #1, , filehederi
Put #1, , hederi   ' 40 Bytes

If pan_x > 0.99 And pan_x < 1.1 Then GoTo pan_x_1

pan_x_1:

' apu = MYFUNC_READBINARYFILES(bkuva(0, 0), lstartrow, rstartrow, lstartcol, rstartcol, lendcol, nwidth)

ReDim lrow(0 To (stereowidth) * colorm - 1) As Byte
ReDim RROW(0 To (stereowidth) * colorm - 1) As Byte
Open lfile For Binary As 2
Open rfile For Binary As 3
Dim rl As Integer, rr As Integer
Dim paikkal As Long, paikkar As Long
 For i = 0 To (stereoheight) - 1
 
   rl = lstartrow + i
   rr = rstartrow + i
   paikkal = CLng(nheight - rl) * CLng(nwidth) * colorm + CLng(lstartcol) * colorm
   paikkar = CLng(nheight - rr) * CLng(nwidth) * colorm + CLng(rstartcol) * colorm
   If paikkal < 0 Or paikkal > nheight * nwidth * colorm Then GoTo skipleft
   Rem Read a row
   Get #2, paikkal + 1, lrow()
skipleft:
   If paikkar < 0 Or paikkar > nheight * nwidth * colorm Then GoTo skiprigth
   Get #3, paikkar + 1, RROW()
skiprigth:
   
    k = -1
    For m = 0 To (lendcol - lstartcol - 1) Step 1
     k = k + colorm
     If (lrow(k) * 1.2) < 255 Then
      lrow(k) = lrow(k) * 1.2
     Else
      lrow(k) = 255
     End If
     bkuva(m, i).r = lrow(k)
     bkuva(m, i).g = RROW(k + 2 * colormodel)
     bkuva(m, i).B = 0
    Next m
  Next i
Close (2)
Close (3)

GoTo loppu
loppu: Put #1, , bkuva
Close (1)
Exit Sub
error_in_creating_bmp_file:
Close (1)
MsgBox ("Error in creating the bmp-file!")
Exit Sub


End Sub