【VB】裸眼3D图软件

这是一种裸眼3D图，其实也比较老了，不过学会去看这种图也不容易。

原理是左眼和右眼分别盯住不同的地方，由于图片从左到右是重复的，当左右眼的焦点相差一个重复周期的时候，两眼看到的图象就可以重叠。但是并不是完全重叠，正是大部分是重叠，有少部分是错位的，才产生了视差，视差就会造成立体的效果。明白了原理后，做出处理的软件就比较简单了。

这个软件操作者需提供一张作为底板的图片，和一种代表深度的黑白图片。

以上图为例，底板就是蓝色的雪花，而代表深度的图片是一个由椭圆转化而来的等高线图。读入软件后就处理产生了这个效果。

既然图片做出来了，动画也是可以做出来的。我做了个伸缩的动画，不过CSDN貌似传GIF貌似没有效果，所以就算了。更好的想法是，可以跟3D动画设计的软件结合，产生裸眼3D的视频，那就一流了。我找了一些软件，貌似没找到二次开发比较好用的动画软件。呵呵。下面是主要处理过程的VB源代码。

Sub shengcheng3d()
        Dim a,b,x,y,y0,h,red,green,blue As Integer
        Dim hh(tuqidu) As Single
        Dim i,d As Integer


        Dim color As Color
        Dim darkness As Color    '定义灰度
        Dim T1,T2 As Integer     '定义周期


        If Len(ComboBox1.SelectedItem) = 0 Then
            MsgBox("请选择一个底板")
            Exit Sub
        End If
        If Len(tuqipath) = 0 Then
            MsgBox("文件路径不能为空")
            Exit Sub
        End If


        T1 = diban.Width
        T2 = diban.Height
        a = tuqi.Width
        b = tuqi.Height




        jieguo = New Bitmap(a + T1,b)




        For x = 0 To T1 - 1
            For y = 0 To b - 1
                y0 = y Mod T2
                color = diban.GetPixel(x,y0)
                jieguo.SetPixel(x,color)
            Next
        Next       '填充一个周期


        For i = 1 To tuqidu
            hh(i) = pingju * (T1 / (tongju - T1) - (T1 - (i - 1)) / (tongju - (T1 - (i - 1)))) '计算各个可能高度
        Next




        For x = 0 To a - 1
            For y = 0 To b - 1
                darkness = tuqi.GetPixel(x,y)
                red = darkness.R
                green = darkness.G
                blue = darkness.B
                h = hh(tuqidu) * (255 * 3 - red - green - blue) / (3 * 255) '计算高度


                If h < hh(2) / 2 Then
                    d = 0
                ElseIf h >= (hh(tuqidu - 1) + hh(tuqidu)) / 2 Then
                    d = tuqidu
                End If
                For i = 2 To tuqidu - 1


                    If h < (hh(i) + hh(i + 1)) / 2 And h >= (hh(i - 1) + hh(i)) / 2 Then
                        d = i
                        Exit For
                    End If
                Next      '对比高度决定位移量


                color = jieguo.GetPixel(x + d,y)   '获取左边一个周期颜色
                jieguo.SetPixel(x + T1,color)            '填充颜色
            Next


            ProgressBar1.Value = 100 * x / (a - 1)
        Next


        SaveFileDialog1.ShowDialog()
        If Len(SaveFileDialog1.FileName) = 0 Then


        Else
            jieguo.Save(SaveFileDialog1.FileName)
        End If
    End Sub

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!