|
|
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
|
|
