Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/vbpg32/samples5/ch09/stockbms.frm

Visual Basic Form | 1997-02-16 | 6.3 KB | 180 lines

VERSION 5.00
Begin VB.Form StockBMS
   Caption         =   "Stock Bitmaps and Icons Viewer"
   ClientHeight    =   2985
   ClientLeft      =   1125
   ClientTop       =   1485
   ClientWidth     =   4065
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2985
   ScaleWidth      =   4065
   Begin VB.PictureBox Picture2
      BackColor       =   &H00FFFF80&
      Height          =   855
      Left            =   1560
      ScaleHeight     =   55
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   83
      TabIndex        =   2
      Top             =   1920
      Width           =   1275
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H00FFFFFF&
      Height          =   855
      Left            =   240
      ScaleHeight     =   825
      ScaleWidth      =   1065
      TabIndex        =   1
      Top             =   1920
      Width           =   1095
   End
   Begin VB.ListBox List1
      Height          =   1200
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   3615
   End
Attribute VB_Name = "StockBMS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Copyright
 1997 by Desaware Inc. All Rights Reserved
'   Initialize the list box
Private Sub Form_Load()
    ' Load the listbox with entries for each stock
    ' bitmap and icon
    List1.AddItem "OBM_CLOSE = 32754"
    List1.AddItem "OBM_UPARROW = 32753"
    List1.AddItem "OBM_DNARROW = 32752"
    List1.AddItem "OBM_RGARROW = 32751"
    List1.AddItem "OBM_LFARROW = 32750"
    List1.AddItem "OBM_REDUCE = 32749"
    List1.AddItem "OBM_ZOOM = 32748"
    List1.AddItem "OBM_RESTORE = 32747"
    List1.AddItem "OBM_REDUCED = 32746"
    List1.AddItem "OBM_ZOOMD = 32745"
    List1.AddItem "OBM_RESTORED = 32744"
    List1.AddItem "OBM_UPARROWD = 32743"
    List1.AddItem "OBM_DNARROWD = 32742"
    List1.AddItem "OBM_RGARROWD = 32741"
    List1.AddItem "OBM_LFARROWD = 32740"
    List1.AddItem "OBM_MNARROW = 32739"
    List1.AddItem "OBM_COMBO = 32738"
    List1.AddItem "OBM_UPARROWI = 32737"
    List1.AddItem "OBM_DNARROWI = 32736"
    List1.AddItem "OBM_RGARROWI = 32735"
    List1.AddItem "OBM_LFARROWI = 32734"
    List1.AddItem "OBM_OLD_CLOSE = 32767"
    List1.AddItem "OBM_SIZE = 32766"
    List1.AddItem "OBM_OLD_UPARROW = 32765"
    List1.AddItem "OBM_OLD_DNARROW = 32764"
    List1.AddItem "OBM_OLD_RGARROW = 32763"
    List1.AddItem "OBM_OLD_LFARROW = 32762"
    List1.AddItem "OBM_BTSIZE = 32761"
    List1.AddItem "OBM_CHECK = 32760"
    List1.AddItem "OBM_CHECKBOXES = 32759"
    List1.AddItem "OBM_BTNCORNERS = 32758"
    List1.AddItem "OBM_OLD_REDUCE = 32757"
    List1.AddItem "OBM_OLD_ZOOM = 32756"
    List1.AddItem "OBM_OLD_RESTORE = 32755"
    List1.AddItem "IDI_APPLICATION = 32512"
    List1.AddItem "IDI_HAND = 32513"
    List1.AddItem "IDI_QUESTION = 32514"
    List1.AddItem "IDI_EXCLAMATION = 32515"
    List1.AddItem "IDI_ASTERISK = 32516"
    List1.AddItem "IDI_WINLOG = 32517"
End Sub
'   Just display the current object
Private Sub List1_Click()
    ShowObject
End Sub
'  When redrawing the picture control, show the currently
'   selected object (if any)
Private Sub Picture1_Paint()
    ShowObject
End Sub
'   Paints the stock icon or bitmap in picture1
'   Retrieve a stock bitmap or icon for the selected list box
'   entry. Draws the bitmap or icon on the picture control.
Private Sub ShowObject()
    Dim ShadowDC&
    Dim isbm%
    Dim param$
    Dim idlong&
    Dim objhandle&, oldobject&
    Dim di&
    Dim bm As BITMAP
    ' Be sure there is a valid entry
    If List1.ListIndex < 0 Then Exit Sub
    Picture1.Cls    ' Clear the picture control
    Picture2.Cls
    param$ = List1.Text
    ' Find out if it's a bitmap or an icon
    If Left$(param$, 3) = "OBM" Then isbm% = -1
    ' Extract the id value to use
    idlong& = Val(Mid$(param$, InStr(param$, "=") + 1))
    If isbm% Then   ' It's a stock bitmap

        ' Create a memory device context compatible with
        ' the picture control
        ShadowDC& = CreateCompatibleDC&(Picture1.hdc)

        ' Load the bitmap
        objhandle& = LoadBitmapBynum(0, idlong&)

        ' Retrieve the height and width of the bitmap
        di = GetObjectAPI(objhandle, Len(bm), bm)

        ' Select the bitmap into the memory DC, keeping
        ' a handle to the prior bitmap.
        oldobject = SelectObject(ShadowDC, objhandle)
        ' BitBlt the bitmap into the picture control,
        ' offset by 2 pixels from the upper left corner
        ' (just to make it look better)
        di = BitBlt(Picture1.hdc, 2, 2, bm.bmWidth, bm.bmHeight, ShadowDC&, 0, 0, SRCCOPY)
        ' Select the bitmap OUT of the memory DC
        di = SelectObject(ShadowDC, oldobject)
        ' and delete it (yes - even though they are system
        ' bitmaps - this doesn't destroy them, just releases
        ' your private copy of the bitmap.
        di = DeleteObject(objhandle)

        Picture2.CurrentX = 2
        Picture2.CurrentY = 2
        Picture2.Print "N/A"
        ' Finally, delete the memory DC
        di = DeleteDC(ShadowDC)
    Else    ' It's an icon - a much easier process
        ' Get the stock icon
        objhandle& = LoadIconBynum(0, idlong&)

        ' Draw it directly onto the picture control
        di = DrawIcon(Picture1.hdc, 2, 2, objhandle&)


        ' Now try loading it as in image

        objhandle& = LoadImageBynum(0, idlong&, IMAGE_ICON, 0, 0, LR_DEFAULTCOLOR Or LR_DEFAULTSIZE Or LR_SHARED)

        di = DrawIconEx(Picture2.hdc, 0, 0, objhandle&, Picture2.ScaleWidth, Picture2.ScaleHeight, 0, 0, DI_NORMAL)

    End If
End Sub