apigdiobject.cls

来自「几个不错的VB例子」· CLS 代码 · 共 68 行

CLS
68
字号
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiGDIObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'\\ --[ApiGDIObject]----------------------------------------------
'\\ Wrapper for the "Object" functions that are used to manipulate
'\\ the GDI object table exported by GDI32.dll
'\\ --------------------------------------------------------------
'\\ (c) 2001 Merrion Computing Ltd


Public Enum GDIObjectTypes
    OBJ_BRUSH = 2
    OBJ_DC = 3
    OBJ_BITMAP = 7
    OBJ_ENHMETADC = 12
    OBJ_ENHMETAFILE = 13
    OBJ_EXTPEN = 11
    OBJ_FONT = 6   '\\ApiLogFont
    OBJ_MEMDC = 10
    OBJ_METADC = 4
    OBJ_METAFILE = 9
    OBJ_PAL = 5
    OBJ_PEN = 1
    OBJ_REGION = 8
End Enum


Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long
Private Declare Function GetGdiObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private mObjectHandle As Long


Friend Property Get ObjectHandle() As Long

    ObjectHandle = mObjectHandle

End Property

Friend Property Let ObjectHandle(ByVal newhandle As Long)

    mObjectHandle = newhandle
    
End Property

Public Property Get ObjectType() As GDIObjectTypes

Dim lRet As Long

If mObjectHandle <> 0 Then
    lRet = GetObjectType(mObjectHandle)
    If Err.LastDllError <> 0 Then
        ReportError Err.LastDllError, "ApiGDIObject:ObjectType", GetLastSystemError
    End If
    ObjectType = lRet
End If

End Property

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?