apiicon.cls

几个不错的VB例子

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' ##MODULE_DESCRIPTION This class provides properties and methods for _
working with Icons.  An icon is a small picture which is used to represent _
an application and can be displayed on the windows desktop and also in the title _
bar of a window.


Private Declare Function LoadIconApi Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function GetIconInfoApi Lib "user32" Alias "GetIconInfo" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As Long
End Type

Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private mhIcon As Long

Private mStockIcon As Boolean

'\\ Stock icons
Public Enum enStockIcons
    IDI_WINLOGO = 32517&
    IDI_APPLICATION = 32512&
    IDI_ASTERISK = 32516&
    IDI_EXCLAMATION = 32515&
    IDI_HAND = 32513&
    IDI_QUESTION = 32514&
    IDI_UNKNOWN = 32518&
End Enum



Public Property Get ColourBitmap() As ApiBitmap

Dim info As ICONINFO

Dim bmThis As ApiBitmap
Dim lret As Long

Set bmThis = New ApiBitmap

lret = GetIconInfoApi(mhIcon, info)
If lret = 0 Or Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "ApiIcon:ColourBitmap", GetLastSystemError)
End If

With info
    bmThis.hBitmap = .hbmColor
End With

Set ColourBitmap = bmThis

End Property

Public Property Let hIcon(ByVal newhandle As Long)

If newhandle <> mhIcon Then
    mhIcon = newhandle
End If

End Property

Public Property Get hIcon() As Long
    
    hIcon = mhIcon
    
End Property

Public Property Get Hotspot() As APIPoint

Dim info As ICONINFO

Dim pointThis As APIPoint
Dim lret As Long

Set pointThis = New APIPoint

lret = GetIconInfoApi(mhIcon, info)
If lret = 0 Or Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "ApiIcon:HotSpot", GetLastSystemError)
End If
With info
    pointThis.x = .xHotspot
    pointThis.y = .yHotspot
End With

Set Hotspot = pointThis

End Property

Public Sub LoadSystemIcon(ByVal StockIcon As enStockIcons)

Dim lret As Long

lret = LoadIconApi(0, StockIcon)
If Err.LastDllError = 0 Then
    Me.hIcon = lret
    '\\ Flag that this icon was loded from a stock icon...
    mStockIcon = True
End If

End Sub


Public Property Get MaskBitmap() As ApiBitmap

Dim info As ICONINFO

Dim bmThis As ApiBitmap
Dim lret As Long

Set bmThis = New ApiBitmap

lret = GetIconInfoApi(mhIcon, info)
If lret = 0 Or Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "ApiIcon:MaskBitmap", GetLastSystemError)
End If

With info
    bmThis.hBitmap = .hbmMask
End With

Set MaskBitmap = bmThis

End Property


Private Sub Class_Terminate()
Dim lret As Long

If mhIcon > 0 And Not (mStockIcon) Then
    lret = DestroyIcon(mhIcon)
    If lret = 0 Or Err.LastDllError > 0 Then
        Call ReportError(Err.LastDllError, "ApiIcon:Terminate", GetLastSystemError)
    End If
End If

End Sub