读取外部图标_在桌面上画图.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5220
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7515
   LinkTopic       =   "Form1"
   ScaleHeight     =   5220
   ScaleWidth      =   7515
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "在桌面上画图标"
      Height          =   315
      Left            =   3600
      TabIndex        =   2
      Top             =   4620
      Width           =   1515
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   3240
      Top             =   0
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开图标文件"
      Height          =   375
      Left            =   1140
      TabIndex        =   1
      Top             =   4620
      Width           =   1455
   End
   Begin VB.PictureBox Picture1 
      Height          =   4275
      Left            =   120
      ScaleHeight     =   281
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   477
      TabIndex        =   0
      Top             =   120
      Width           =   7215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3240
      Top             =   480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private total As Long
Private p(300) As Long
Private Const GW_HWNDLAST = 1
Private Sub Command1_Click()
    CommonDialog1.Filter = "图标|*.exe;*.ico;*.dll"
    CommonDialog1.ShowOpen
    If Dir(CommonDialog1.FileName) <> "" Then
        total = ExtractIcon(App.hInstance, CommonDialog1.FileName, -1)
        If total = 0 Then
            MsgBox "没有图标"
            Exit Sub
        End If
        For i = 0 To total - 1
            p(i) = ExtractIcon(App.hInstance, CommonDialog1.FileName, i)
        Next i
        Timer1.Enabled = True
    End If
End Sub

Private Sub Command2_Click()
    Dim DeskHwnd As Long
    Dim DeskDc As Long
    Dim i As Long, j As Long
    DeskHwnd = GetWindow(hwnd, GW_HWNDLAST) '可用GetNextWindow(hwnd,GW_HWNDLAST)
    DeskDc = GetWindowDC(DeskHwnd)
    For i = 0 To Screen.Width / 32 / 15
        For j = 0 To Screen.Height / 32 / 15
            DrawIcon DeskDc, 32 * i, 32 * j, p(0)
        Next j
    Next i
End Sub

Private Sub Timer1_Timer()
    Static i As Long
    Static x As Long
    Static y As Long
    Command1.Enabled = False
    DrawIcon Picture1.hdc, x, y, p(i)
    x = x + 34
    If x + 34 > Picture1.ScaleWidth Then
        y = y + 34
        x = 0
    End If
    i = i + 1
    If i = total Then
        i = 0
        Timer1.Enabled = False
        Command1.Enabled = True
    End If
End Sub