※※※ Windows 95 ※※※		※※※ Windows XP ※※※

Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type

'ビットマップを転送する
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

'デバイスコンテキストと互換性のあるデバイス依存ビットマップを作成する
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

'作成したデバイスコンテキストを破棄する
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

'取得したオブジェクトのハンドルを開放する
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'デバイスと独立したビットマップをロードする
Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Long) As Long

'オブジェクトを取得する
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

'オブジェクトを選択する
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Const OBM_LFARROWI = 32734
Private Const OBM_RGARROWI = 32735
Private Const OBM_DNARROWI = 32736
Private Const OBM_UPARROWI = 32737
Private Const OBM_COMBO = 32738
Private Const OBM_MNARROW = 32739
Private Const OBM_LFARROWD = 32740
Private Const OBM_RGARROWD = 32741
Private Const OBM_DNARROWD = 32742
Private Const OBM_UPARROWD = 32743
Private Const OBM_RESTORED = 32744
Private Const OBM_ZOOMD = 32745
Private Const OBM_REDUCED = 32746
Private Const OBM_RESTORE = 32747
Private Const OBM_ZOOM = 32748
Private Const OBM_REDUCE = 32749
Private Const OBM_LFARROW = 32750
Private Const OBM_RGARROW = 32751
Private Const OBM_DNARROW = 32752
Private Const OBM_UPARROW = 32753
Private Const OBM_CLOSE = 32754
Private Const OBM_OLD_RESTORE = 32755
Private Const OBM_OLD_ZOOM = 32756
Private Const OBM_OLD_REDUCE = 32757
Private Const OBM_BTNCORNERS = 32758
Private Const OBM_CHECKBOXES = 32759
Private Const OBM_CHECK = 32760
Private Const OBM_BTSIZE = 32761
Private Const OBM_OLD_LFARROW = 32762
Private Const OBM_OLD_RGARROW = 32763
Private Const OBM_OLD_DNARROW = 32764
Private Const OBM_OLD_UPARROW = 32765

'-----------------------------------------------------------------------
' 関数名 ： DrawResBitmap
' 機能   ： フォームにビットマップリソースを表示する
' 引数   ： (in) ObjForm … フォームだよ
' 戻り値 ： デバイスコンテキストのフォント名
'-----------------------------------------------------------------------
Private Sub DrawResBitmap(ByVal ObjForm As Form)

    Dim udtBITMAP As BITMAP
    Dim hBitMapCreated As Long  '作成したビットマップのハンドル
    Dim hBitMapIcon As Long     '右上のアイコンのビットマップリソースのハンドル
    Dim hOldDc As Long          '以前のデバイスコンテキスト
    Dim i As Long               'ループ用作業変数
    Dim xPos&, yPos As Long

    'OBM_OLD_UPARROW - OBM_LFARROWI = 31
    For i = 0 To (OBM_OLD_UPARROW - OBM_LFARROWI)
        'ビットマップを作成する
        hBitMapCreated = CreateCompatibleDC(ObjForm.hdc)

        'ビットマップリソース取得
        hBitMapIcon = LoadBitmap(0, i + OBM_LFARROWI)

        'オブジェクトを取得
        Call GetObject(hBitMapIcon, Len(udtBITMAP), udtBITMAP)

        'オブジェクトを選択する
        hOldDc = SelectObject(hBitMapCreated, hBitMapIcon)

        xPos = (i Mod 10) * 30 + 2
        yPos = (i \ 10) * 20 + 2

        Call BitBlt(ObjForm.hdc, xPos, yPos, udtBITMAP.bmWidth, udtBITMAP.bmHeight, _
                    hBitMapCreated, 0, 0, vbSrcCopy)

        '元のオブジェクトを選択する
        Call SelectObject(hBitMapCreated, hOldDc)

        'オブジェクトを選択する
        Call DeleteObject(hBitMapIcon)

        'デバイスコンテキストを削除する
        Call DeleteDC(hBitMapCreated)
    Next i

    '再描画
    ObjForm.Refresh

End Sub

Private Sub Form_Load()

    With Me
        .ScaleMode = vbPixels
        .AutoRedraw = True
        .Width = 310 * Screen.TwipsPerPixelX
        .Height = 90 * Screen.TwipsPerPixelY + .Height - _
                 .ScaleHeight * Screen.TwipsPerPixelY
    End With

    Call DrawResBitmap(Me)

End Sub