189 8069 5689
可以借助DirectX来编程。免费3D引擎可不好找，一般来说速度比不上硬件加速后的DX，尤其令人头疼的是一般都没有针对VB的文档，LZ有这方面理想的话，自己写一个吧……
创新互联建站主营莎车网站建设的网络公司,主营网站建设方案,app软件开发公司,莎车h5成都小程序开发搭建,莎车网站营销推广欢迎莎车等地区企业咨询
我不得不承认在VB上写DirectX的教程相当难找！如果LZ想深入研究三维图形问题，C++一定要学，就算不能用C++编程，起码要能把C++程序翻译成VB程序。
我自己学会DX编程花了两三个月（很浅）。编这样一个程序难度是有点大的。
工具：DirectX9和其针对VB的库(项目-添加引用。.NET库里DX库一般都有)，VB不知道现在支不支持DX10以上的版本，不过9绝对够用了。
思路：一切3D图形都是由三角形拼成的。矩形挖掉一个圆孔可不是一个方便画的图形，我估计至少得有24个三角形。你需要记录这些点的坐标，或者干脆把它们写在文件里，到时读出来。
这是我的一个老DX程序的不完全的代码(显示一个黑乎乎的平面)，不一定能编译，可以参考一下。
Imports Microsoft.DirectX '一定要~
Public Class FormMain
'Direct3D Startup
Dim d3dpp As New Direct3D.PresentParameters 'DX基本参数，例如全屏还是窗口等
Public MyDevice As Direct3D.Device ‘DX基本设备，画图就靠它。
'Matrices
Dim matWorld, matView, matProj As Matrix '世界位置矩阵，摄像机位置矩阵和透视矩阵，数学要学好啊。
'mesh
Public MyPlane as Direct3D.Mesh ’我们的物体
Public VBPlane(3) As Direct3D.CustomVertex.PositionNormalTextured '存放顶点位置的数组
#Region "DX Core"
Public Sub InitDeviceObjects()
With d3dpp ‘以下请照抄。
.Windowed = True ‘不全屏。
.SwapEffect = Direct3D.SwapEffect.Discard ’双缓冲交换效果。请百度“双缓冲”
.BackBufferFormat = Direct3D.Format.Unknown
.EnableAutoDepthStencil = True ’让DX自动管理深度缓冲
.AutoDepthStencilFormat = Direct3D.DepthFormat.D16
End With
MyDevice = New Direct3D.Device(0, Direct3D.DeviceType.Hardware, Me.Handle, Direct3D.CreateFlags.HardwareVertexProcessing, d3dpp) '创建DX设备啦！以下两句请照抄。
MyDevice.SetRenderState(Direct3D.RenderStates.ZEnable, True) ‘Z缓冲
MyDevice.SetRenderState(Direct3D.RenderStates.NormalizeNormals, True)'法线归一化，请看相关数学书籍。
End Sub
Public Sub RestoreDeviceObjects()
Dim PlaneIB() As Short = {0, 1, 3, 0, 2, 3} ’顶点索引信息。
Dim AttrTable(1) As Direct3D.AttributeRange ‘顶点分组属性表
AttrTable(0).AttributeId = 0
AttrTable(0).FaceStart = 0
AttrTable(0).FaceCount = 2 ’有两个三角形
AttrTable(0).VertexStart = 0
AttrTable(0).VertexCount = 4 ‘四个点
‘顶点坐标信息。
VBPlane(0) = New Direct3D.CustomVertex.PositionNormalTextured(-500, -500, 0, 0, 0, 1, 0, 0)
VBPlane(1) = New Direct3D.CustomVertex.PositionNormalTextured(500, -500, 0, 0, 0, 1, 1, 0)
VBPlane(2) = New Direct3D.CustomVertex.PositionNormalTextured(-500, 500, 0, 0, 0, 1, 0, 1)
VBPlane(3) = New Direct3D.CustomVertex.PositionNormalTextured(500, 500, 0, 0, 0, 1, 1, 1)
MyPlane = New Direct3D.Mesh(2, 4, Direct3D.MeshFlags.Managed, Direct3D.VertexFormats.Position + Direct3D.VertexFormats.Normal + Direct3D.VertexFormats.Texture1, MyDevice) ’创建物体
MyPlane.SetVertexBufferData(VBPlane, Direct3D.LockFlags.None) ‘输入顶点坐标数据
MyPlane.SetIndexBufferData(PlaneIB, Direct3D.LockFlags.None) ‘输入索引数据
MyPlane.SetAttributeTable(AttrTable) ‘输入顶点分组属性表
End Sub
Public Sub Render() ‘调用它画图
Dim vlook As New Vector3(1, 0, 0)
Dim vPos As New Vector3(0,0,0)
Dim vUp As New Vector3(0, 0, 1)
MatView = Matrix.LookAtLH(vPos, vlook, vUp) ‘计算摄像机位置矩阵
Device.SetTransform(Direct3D.TransformType.View, MatView) ‘设置当前摄像机位置矩阵为MatView。
Dim fAspect As Single = Me.Width / Me.Height ’窗口长宽比
matProj = Matrix.PerspectiveFovLH(Math.PI / 4, fAspect, 1.0F, 10001) ‘计算透视矩阵MatProj。
MyDevice.SetTransform(Direct3D.TransformType.Projection, matProj) ‘设置当前透视矩阵为MatProj。
MyDevice.Clear(Direct3D.ClearFlags.Target + Direct3D.ClearFlags.ZBuffer, Color.Blue, 1.0F, 0) ’先刷蓝屏
MyDevice.BeginScene() ‘开始画
MatWorld = Matrix.Identity ’物体位于原点，不旋转
Device.SetTransform(Direct3D.TransformType.World, MatWorld) ’设置物体位置
Me.Mesh.DrawSubset(0) ‘画物体
MyDevice.EndScene() ’结束
MyDevice.Present() ‘显示在屏幕上
End Sub
Public Sub DeleteDeviceObjects() ’结束程序时放掉资源
MyPlane.Dispose()
MyDevice.Dispose()
End Sub
#End Region
Private Sub FormMain_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
DeleteDeviceObjects()
Windows.Forms.Cursor.Show()
End Sub
Private Sub FormMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
InitDeviceObjects()
RestoreDeviceObjects()
Windows.Forms.Cursor.Hide()
Render()
End Sub
End Class
修改桌面图标的背景程序(vb6.0代码编写)要用到Dialog13:
标签：
修改桌面图标的背景程序(vb6.0代码
可设定多个隐藏关键字、设定快捷键、程序最小化到托盘。
任务栏图标就是窗体的ICON属性设置的图标，和标题栏的图标是完全一样的。如果你想做的不一样，那就用无边框窗体，自制一个标题栏
窗口边框（FormBorderStyle）设为None，窗口（WindowState）设为Maximized，如果想让窗口背景透明，将窗口背景颜色和TransparencyKey设为同一种颜色，按钮用Label（标签）代替，背景设为Transparent，边框设为None，文字位置一般是下中，Label控件支持无边框。
动感效果在鼠标事件（MouseDown按下，MouseUp抬起，MouseEnter进入，MouseLeave离开）更换指定的图片；
添加timer控件还可以使用动画
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Me.Label1.Refresh()
End Sub
快捷键用热键
RegisterHotKey
函数功能：该函数定义一个系统范围的热键。
函数原型：BOOL RegisterHotKey（HWND hWnd，intid，UINT fsModifiers，UINT vk）；
参数：
hWnd：接收热键产生WM_HOTKEY消息的窗口句柄。若该参数NULL，传递给调用线程的WM_HOTKEY消息必须在消息循环中中进行处理。
id：定义热键的标识符。调用线程中的其他热键不能使用同样的标识符。应用功能程序必须定义一个0X0000-0xBFFF范围的值。一个共享的动态链接库（DLL）必须定义一个0xC000-0xFFFF范围的值伯GlobalAddAtom函数返回该范围）。为了避免与其他动态链接库定义的热键冲突，一个DLL必须使用GlobalAddAtom函数获得热键的标识符。
fsModifoers：定义为了产生WM_HOTKEY消息而必须与由nVirtKey参数定义的键一起按下的键。该参数可以是如下值的组合：
MOD_ALT：按下的可以是任一Alt键。MOD_CONTROL：按下的可以是任一Ctrl键。
MOD_SHIFT：按下的可以是任一Shift键。
MOD_WIN：按下的可以是任一Windows按键。
vk：定义热键的虚拟键码。
返回值：若函数调用成功，返回一个非O值。若函数调用失败，则返回值为0。若要获得更多的错误信息，可以调用GetLastError函数。
备注：当某键被接下时，系统在所有的热键中寻找匹配者。一旦找到一个匹配的热键，系统将把WM_HOTKEY消息传递给登记了该热键的线程的消息队列。该消息被传送到队列头部，因此它将在下一轮消息循环中被移去。该函数不能将热键同其他线程创建的窗口关联起来。
若为一热键定义的击键己被其他热键所定义，则RegisterHotKey函数调用失败。
若hWnd参数标识的窗口已用与id参数定义的相同的标识符登记了一个热键，则参数fsModifiers和vk的新值将替代这些参数先前定义的值。
若设置MOD_KEYUP位，则当发生键被按下或被弹起的事件时，窗口将发送WM_HOTKEY消息。
RegisterHotKey可以被用来在线程之间登记热键。
UnregisterHotKey
函数功能：该函数释放调用线程先前登记的热键。
函数原型：BOOL UnregisterHotKey（HWND hWnd，int id）；
参数：
hWnd：与被释放的热键相关的窗口句柄。若热键不与窗口相关，则该参数为NULL。
id：定义被释放的热键的标识符。
返回值：若函数调用成功，返回值不为0。若函数调用失败，返回值为0。若要获得更多的错误信息，可以调用GetLastError函数。
1、首先定义所需要用到的常量
如图所示，在窗体代码后定义常量和API函数
代码如下：
Public Const WM_HOTKEY As Integer = H312
Public Const MOD_ALT As Integer = H1
Public Const MOD_CONTROL As Integer = H2
Public Const MOD_SHIFT As Integer = H4
Public Const GWL_WNDPROC As Integer = (-4)
Public Declare Auto Function RegisterHotKey Lib "user32.dll" Alias "RegisterHotKey" (ByVal hwnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Integer) As Boolean
Public Declare Auto Function UnRegisterHotKey Lib "user32.dll" Alias "UnregisterHotKey" (ByVal hwnd As IntPtr, ByVal id As Integer) As Boolean
下面过程是注册Ctrl+T的组合键为组合键，假如注册成功，则返回true，反之注册失败则返回false，我们可以根据返回的结果判断并提醒用户注册的情况。
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim isResult As Boolean
isResult=RegisterHotKey(Handle, 0, MOD_CONTROL, Asc("T")) ’注册Ctrl+T的组合键
If isResult = False Then
MsgBox("注册热键Ctrl+T失败")
End If
End Sub
[apge]
下面过程为重载WndProc过程，响应热键并处理热键，这里是用来隐藏和显示程序主界面。
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_HOTKEY Then
System.Diagnostics.Process.Start("C:\WINDOWS\system32\freecell.exe")'运行当空接龙游戏
End If
MyBase.WndProc(m)
End Sub
最后在关闭窗体的时候释放占用的热键，如果前面注册失败的话，则会出现释放失败的结果。
Private Sub Form1_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
Dim isResult As Boolean
isResult=UnRegisterHotKey(Handle, 0)
End Sub
双击打开指定的程序
Private Sub Label1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label1.DoubleClick
System.Diagnostics.Process.Start("C:\WINDOWS\system32\freecell.exe")
End Sub
System.Diagnostics.Process.Start("路径")打开指定程序
先列出这些吧