Make your own free website on Tripod.com

AllApi.net

[an error occurred while processing this directive]
 
Const OBJ_BITMAP = 7
Const OBJ_BRUSH = 2
Const OBJ_FONT = 6
Const OBJ_PAL = 5
Const OBJ_PEN = 1
Const OBJ_EXTPEN = 11
Const OBJ_REGION = 8
Const OBJ_DC = 3
Const OBJ_MEMDC = 10
Const OBJ_METAFILE = 9
Const OBJ_METADC = 4
Const OBJ_ENHMETAFILE = 13
Const OBJ_ENHMETADC = 12
Private Declare Function GetNearestColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim nDC As Long, nBitmap As Long
    nDC = CreateCompatibleDC(Me.hdc)
    'Create a Black/White bitmap
    nBitmap = CreateBitmap(10, 10, 1, 1, ByVal 0&)
    SelectObject nDC, nBitmap
    'GetObjectType
    Select Case GetObjectType(nBitmap)
        Case OBJ_BITMAP
            MsgBox "Object type: Bitmap"
        Case OBJ_BRUSH
            MsgBox "Object type: Brush"
        Case OBJ_FONT
            MsgBox "Object type: Font"
        Case OBJ_PAL
            MsgBox "Object type: Pal"
        Case OBJ_PEN
            MsgBox "Object type: Pen"
        Case OBJ_EXTPEN
            MsgBox "Object type: ExtPen"
        Case OBJ_REGION
            MsgBox "Object type: Region"
        Case OBJ_DC
            MsgBox "Object type: Device Context"
        Case OBJ_MEMDC
            MsgBox "Object type: Memory Device Context"
        Case OBJ_METAFILE
            MsgBox "Object type: Metafile"
        Case OBJ_METADC
            MsgBox "Object type: Metafile DC"
        Case OBJ_ENHMETAFILE
            MsgBox "Object type: Enhanched Meatfile"
        Case OBJ_ENHMETADC
            MsgBox "Object type: Enhanched Meatfile DC"
    End Select
    MsgBox "Nearest color: " + GetNearestColor(nDC, vbYellow)
    'Clean up
    DeleteDC nDC
    DeleteObject nBitmap
End Sub


 
Copyright © 1998-2000, The KPD-Team.
Send mail to KPDTeam@Allapi.net with comments about this web site.
This site is located at
http://www.Allapi.net/