vb.net实现桌面图标3D翻滚-阿南达文事网

vb.net实现桌面图标3D翻滚

最近将网页上的3D标签云翻滚程序移植到桌面上来了（用vb实现的）
效果如下

按住ctrl键会停止翻转，鼠标指到图标时会显示图标软件信息

程序第一次运行时会自动将桌面所有图标加入到3D翻滚里面来，移动鼠标图标就翻滚起来了，双击图标可以运行程序，哈哈！桌面干净多了！

还有一点bug，对部份64位程序的桌面快捷方式暂不能获取执行文件原始地址（只能保留原快捷方式文件来运行程序）。对32位程序的桌面图标，运行一次后都可将原图标删除不影响程序运行
还有在图标翻滚时CPU占用率较高(要对每个图标大小，位置，透明度，还有前后顺序进行排序）

对于不能自动获取程序路径的增加了手动修改功能
3D翻转部份球面等分部份代码：
Public Sub positionall()
        Dim phi, theta, lx, ly, lz As Double
        DIm left1,top1 as integer
               Dim  radius as integer=300   ‘球面半径
        Dim   max as integer            '等分数
        Dim i As Integer
        While i <= max
            phi = Math.Acos(x)
            theta = Math.Sqrt(max * Math.PI) * phi
            lx = radius * Math.Cos(theta) * Math.Sin(phi)    '从球面坐标转换为笛卡尔积坐标
            ly = radius * Math.Sin(theta) * Math.Sin(phi)
            lz = radius * Math.Cos(phi)
            left1 = CInt(lx + Me.Width / 2) - picturewidth / 2    '转换为图片中心在窗体中位置
            top1 = CInt(ly + Me.Height / 2) - pictureheight / 2
            i += 1
        End While
end sub

以下两个函数获取快捷方式的程序绝对路径和开始路径
Public Function GetFilePathFromLinkPath(ByVal LinkPath As String) As String
        Dim objecttemp As Object = CreateObject("WScript.Shell")
        Dim link As Object = objecttemp.CreateShortcut(LinkPath)
        Dim ret As String = link.TargetPath()
        objecttemp = Nothing
        Return ret
    End Function

    Public Function getfiledirectfromlinkpath(ByVal linkpath As String) As String
        Dim objecttemp As Object = CreateObject("WScript.Shell")
        Dim link As Object = objecttemp.CreateShortcut(linkpath)
        Dim ret2 As String = link.WorkingDirectory()
        objecttemp = Nothing
        Return ret2
    End Function