● システム定義のカーソル・アイコンを表示する ●

'システム定義のカーソルをロードする
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

'システム定義のアイコンをロードする
Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long

'アイコンを描画する
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Boolean

'作成したアイコンを破棄する
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

'システム定義のカーソルの定数
Private Const IDC_APPSTARTING = 32650&   '標準矢印カーソルと小型砂時計
Private Const IDC_ARROW = 32512&         '標準矢印カーソル
Private Const IDC_CROSS = 32515&         '十字カーソル
Private Const IDC_IBEAM = 32513&         'アイビーム
Private Const IDC_NO = 32648&            '禁止カーソル
Private Const IDC_SIZEALL = 32646&       '4方向矢印カーソル
Private Const IDC_SIZENESW = 32643&      '斜め左下がり両方向カーソル
Private Const IDC_SIZENS = 32645&        '上下両方向矢印カーソル
Private Const IDC_SIZENWSE = 32642&      '斜め右下がり両方向カーソル
Private Const IDC_SIZEWE = 32644&        '左右両方向矢印カーソル
Private Const IDC_UPARROW = 32516&       '垂直矢印のカーソル
Private Const IDC_WAIT = 32514&          '砂時計カーソル

'システム定義のアイコンの定数
Private Const IDI_APPLICATION = 32512&   'アプリケーション
Private Const IDI_HAND = 32513&          '警告
Private Const IDI_QUESTION = 32514&      '問い合わせ
Private Const IDI_EXCLAMATION = 32515&   '注意
Private Const IDI_ASTERISK = 32516&      '情報

Private Const DI_MASK = &H1              'ropImageのラスタ操作実行
Private Const DI_IMAGE = &H2             'ropMaskのラスタ操作実行
Private Const DI_NORMAL = &H3            'DI_MASKとDI_IMAGEの組み合わせ

Private Type SYSTEM_DEF
    Value As Long
    Explanation As String
End Type
Public udtSd(16) As SYSTEM_DEF

'-----------------------------------------------------------------------
' 関数名 : InitStruct
' 機能   : 構造体を初期化する
' 引数   : なし
' 戻り値 : なし
'-----------------------------------------------------------------------
Public Sub InitStruct()
    'VBは構造体や配列の初期化が出来ないのが弱点… 不便や
    udtSd(0).Value = IDC_APPSTARTING
    udtSd(0).Explanation = "標準矢印カーソルと小型砂時計"
    udtSd(1).Value = IDC_ARROW
    udtSd(1).Explanation = "標準矢印カーソル"
    udtSd(2).Value = IDC_CROSS
    udtSd(2).Explanation = "十字カーソル"
    udtSd(3).Value = IDC_IBEAM
    udtSd(3).Explanation = "アイビーム"
    udtSd(4).Value = IDC_NO
    udtSd(4).Explanation = "禁止カーソル"
    udtSd(5).Value = IDC_SIZEALL
    udtSd(5).Explanation = "4方向矢印カーソル"
    udtSd(6).Value = IDC_SIZENESW
    udtSd(6).Explanation = "斜め左下がり両方向カーソル"
    udtSd(7).Value = IDC_SIZENS
    udtSd(7).Explanation = "上下両方向矢印カーソル"
    udtSd(8).Value = IDC_SIZENWSE
    udtSd(8).Explanation = "斜め右下がり両方向カーソル"
    udtSd(9).Value = IDC_SIZEWE
    udtSd(9).Explanation = "左右両方向矢印カーソル"
    udtSd(10).Value = IDC_UPARROW
    udtSd(10).Explanation = "垂直矢印のカーソル"
    udtSd(11).Value = IDC_WAIT
    udtSd(11).Explanation = "砂時計カーソル"
    udtSd(12).Value = IDI_APPLICATION
    udtSd(12).Explanation = "アプリケーションアイコン"
    udtSd(13).Value = IDI_HAND
    udtSd(13).Explanation = "警告のアイコン"
    udtSd(14).Value = IDI_QUESTION
    udtSd(14).Explanation = "問い合わせのアイコン"
    udtSd(15).Value = IDI_EXCLAMATION
    udtSd(15).Explanation = "注意のアイコン"
    udtSd(16).Value = IDI_ASTERISK
    udtSd(16).Explanation = "情報のアイコン"
End Sub

'-----------------------------------------------------------------------
' 関数名 : DrawCursorIcon
' 機能   : アイコンを描画する
' 引数   : (i)TargetObj … ピクチャーオブジェクト
'           (i)IsCursor  … カーソルかアイコンどうか
'           (i)CurIcnVal … InitStruct() に定義されている定数のインデックス
'           (i)xPos      … X座標
'           (i)yPos      … Y座標
'           (i)xWidth    … 幅
'           (i)xHeight   … 高さ
' 戻り値 : 正常終了…1   エラー…0
'-----------------------------------------------------------------------
Public Sub DrawCursorIcon(ByVal TargetObj As Object, _
                          ByVal IsCursor As Boolean, _
                          ByVal CurIcnVal As Long, _
                          Optional ByVal xPos As Long = 0, _
                          Optional ByVal yPos As Long = 0, _
                          Optional ByVal xWidth As Long = 32, _
                          Optional ByVal xHeight As Long = 32)
    Dim hImgWnd As Long

    If IsCursor Then
        hImgWnd = LoadCursor(0, CurIcnVal)
    Else
        hImgWnd = LoadIcon(0, CurIcnVal)
    End If

    '描画
    TargetObj.Cls
    Call DrawIconEx(TargetObj.hdc, xPos, yPos, hImgWnd, xWidth, xHeight, 0, 0, DI_NORMAL)
    TargetObj.Refresh

    'はたして DestroyIcon する必要があるのだろうか
    Call DestroyIcon(hImgWnd)
End Sub

あとはフォームにリストボックスを配置して、以下を書く。

Private Sub Form_Load()
    Dim i As Long

    With Me
        .Caption = "システム定義のカーソル・アイコンを表示"
        .ScaleMode = vbPixels
        .AutoRedraw = True
        .Width = 300 * Screen.TwipsPerPixelX
        .Height = 160 * Screen.TwipsPerPixelY

        .List1.Clear
        .List1.Left = 0
        .List1.Top = 4
        .List1.Width = 210
        .List1.Height = 130
    End With
    
    '構造体初期化
    Call InitStruct

    'リストボックスに値を追加
    For i = 0 To UBound(udtSd) - 1
        With List1
            .AddItem udtSd(i).Explanation
            .ItemData(i) = udtSd(i).Value
        End With
    Next

End Sub

Private Sub List1_Click()

    '描画
    Call DrawCursorIcon(Me, CBool(List1.ListIndex < 12), _
       List1.ItemData(List1.ListIndex), 220, 10, 64, 64)

End Sub

戻る