【VB】裸眼3D图软件

前端之家收集整理的这篇文章主要介绍了【VB】裸眼3D图软件前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

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

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

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

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

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

  1. Sub shengcheng3d()
  2. Dim a,b,x,y,y0,h,red,green,blue As Integer
  3. Dim hh(tuqidu) As Single
  4. Dim i,d As Integer
  5.  
  6.  
  7. Dim color As Color
  8. Dim darkness As Color '定义灰度
  9. Dim T1,T2 As Integer '定义周期
  10.  
  11.  
  12. If Len(ComboBox1.SelectedItem) = 0 Then
  13. MsgBox("请选择一个底板")
  14. Exit Sub
  15. End If
  16. If Len(tuqipath) = 0 Then
  17. MsgBox("文件路径不能为空")
  18. Exit Sub
  19. End If
  20.  
  21.  
  22. T1 = diban.Width
  23. T2 = diban.Height
  24. a = tuqi.Width
  25. b = tuqi.Height
  26.  
  27.  
  28.  
  29.  
  30. jieguo = New Bitmap(a + T1,b)
  31.  
  32.  
  33.  
  34.  
  35. For x = 0 To T1 - 1
  36. For y = 0 To b - 1
  37. y0 = y Mod T2
  38. color = diban.GetPixel(x,y0)
  39. jieguo.SetPixel(x,color)
  40. Next
  41. Next '填充一个周期
  42.  
  43.  
  44. For i = 1 To tuqidu
  45. hh(i) = pingju * (T1 / (tongju - T1) - (T1 - (i - 1)) / (tongju - (T1 - (i - 1)))) '计算各个可能高度
  46. Next
  47.  
  48.  
  49.  
  50.  
  51. For x = 0 To a - 1
  52. For y = 0 To b - 1
  53. darkness = tuqi.GetPixel(x,y)
  54. red = darkness.R
  55. green = darkness.G
  56. blue = darkness.B
  57. h = hh(tuqidu) * (255 * 3 - red - green - blue) / (3 * 255) '计算高度
  58.  
  59.  
  60. If h < hh(2) / 2 Then
  61. d = 0
  62. ElseIf h >= (hh(tuqidu - 1) + hh(tuqidu)) / 2 Then
  63. d = tuqidu
  64. End If
  65. For i = 2 To tuqidu - 1
  66.  
  67.  
  68. If h < (hh(i) + hh(i + 1)) / 2 And h >= (hh(i - 1) + hh(i)) / 2 Then
  69. d = i
  70. Exit For
  71. End If
  72. Next '对比高度决定位移量
  73.  
  74.  
  75. color = jieguo.GetPixel(x + d,y) '获取左边一个周期颜色
  76. jieguo.SetPixel(x + T1,color) '填充颜色
  77. Next
  78.  
  79.  
  80. ProgressBar1.Value = 100 * x / (a - 1)
  81. Next
  82.  
  83.  
  84. SaveFileDialog1.ShowDialog()
  85. If Len(SaveFileDialog1.FileName) = 0 Then
  86.  
  87.  
  88. Else
  89. jieguo.Save(SaveFileDialog1.FileName)
  90. End If
  91. End Sub

猜你在找的VB相关文章