【VB】裸眼3D图软件

前端之家收集整理的这篇文章主要介绍了【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
原文链接:https://www.f2er.com/vb/258770.html

猜你在找的VB相关文章