apilogbrush.cls

几个不错的VB例子

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiLogBrush"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' ##MODULE_DESCRIPTION This class provides the properties and methods _
for a logical brush.

' ##MODULE_DESCRIPTION A logical brush is a description of a brush that _
is used to perform any painting type operations on a %device context:EventVB~ApiDeviceContext%.

' ##MODULE_DESCRIPTION Not every device can produce the exact brush as defined here in which case _
the system will approximate the nearest possible alternative.


Private Type LogBrush
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type

Private mHBRUSH As Long
Private mLogBrush As LogBrush

Public Enum BrushStyles
    BS_SOLID = 0
    BS_NULL = 1
    BS_HATCHED = 2
    BS_PATTERN = 3
    BS_INDEXED = 4
    BS_DIBPATTERN = 5
    BS_DIBPATTERNPT = 6
    BS_PATTERN8X8 = 7
    BS_DIBPATTERN8X8 = 8
    BS_MONOPATTERN = 9
End Enum

Public Enum HatchStyles
     HS_HORIZONTAL = 0            '/* ----- */
     HS_VERTICAL = 1              '/* ||||| */
     HS_FDIAGONAL = 2             '/* \\\\\ */
     HS_BDIAGONAL = 3             '/* ///// */
     HS_CROSS = 4                 '/* +++++ */
     HS_DIAGCROSS = 5             '/* xxxxx */
End Enum

'\\ Getting a LOGFONT from its handle
Private Declare Function GetObjectLOGBRUSH Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As LogBrush) As Long
Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LogBrush) As Long

Private mStock As Boolean

'\\ Private memory handling functions
Private Declare Sub CopyMemoryLogBrush Lib "kernel32" Alias "RtlMoveMemory" (Destination As LogBrush, ByVal Source As Long, ByVal Length As Long)
Private Declare Function IsBadReadPtrLogBrush Lib "kernel32" Alias "IsBadReadPtr" (ByVal lp As Long, ByVal ucb As Long) As Long
Private Declare Function IsBadWritePtrLogBrush Lib "kernel32" Alias "IsBadWritePtr" (ByVal lp As Long, ByVal ucb As Long) As Long
Private CreatedOK As Boolean

'\\ --[CreateFromPointer]---------------------------------------------
'\\ Fills this LogBrush object from the location poiunted to by
'\\ lpLogBrush
'\\ VB.NET Porting note: This function should be replaced with an override
'\\ of the New() for correctness
'\\ ----------------------------------------------------------------------------------------
'\\ (c) 2001 - Merrion Computing.  All rights  to use, reproduce or publish this code reserved
'\\ Please check http://www.merrioncomputing.com for updates.
'\\ ----------------------------------------------------------------------------------------
Friend Function CreateFromPointer(lpLogBrush As Long) As Boolean

Dim lbThis As LogBrush

CreatedOK = False

If Not IsBadReadPtrLogBrush(lpLogBrush, Len(lbThis)) Then
    Call CopyMemoryLogBrush(lbThis, lpLogBrush, Len(lbThis))
    If Err.LastDllError = 0 Then
        With lbThis
            mLogBrush.lbColor = .lbColor
            mLogBrush.lbHatch = .lbHatch
            mLogBrush.lbStyle = .lbStyle
        End With
    End If
End If

CreateFromPointer = CreatedOK

End Function
Public Property Set Colour(ByVal newColour As ApiColour)

    mLogBrush.lbColor = newColour.ColourRef
    
End Property

Public Property Get Colour() As ApiColour

    Dim colThis As ApiColour
    
    Set colThis = New ApiColour
    colThis.ColourRef = mLogBrush.lbColor
    
End Property

Public Property Let Hatch(ByVal newhatch As HatchStyles)

    mLogBrush.lbHatch = newhatch
    
End Property

Public Property Get Hatch() As HatchStyles

    Hatch = mLogBrush.lbHatch
    
End Property

Friend Property Get IsStockObject() As Boolean

    IsStockObject = mStock
    '\\ Note:  This will need to be amended to read from the
    '\\ GDI object table and return True if the stock object's
    '\\ owner process id is zero...
    
End Property

Friend Property Let IsStockObject(ByVal bIs As Boolean)

    mStock = bIs

End Property

Friend Property Get Handle() As Long

    If mHBRUSH = 0 Then
        mHBRUSH = CreateBrushIndirect(mLogBrush)
        If Err.LastDllError Then
            ReportError Err.LastDllError, "ApiLogBrush:Handle (get)", GetLastSystemError
        End If
    End If
    Handle = mHBRUSH
    
End Property

Friend Property Let Handle(ByVal newhandle As Long)

Dim lret As Long

    If newhandle <> mHBRUSH Then
        mHBRUSH = newhandle
        If newhandle <> 0 Then
            lret = GetObjectLOGBRUSH(newhandle, Len(mLogBrush), mLogBrush)
            If Err.LastDllError <> 0 Then
                ReportError Err.LastDllError, "ApiLogBRUSH:Handle (Let)", GetLastSystemError
            End If
        End If
    End If
    
End Property

Public Property Let Style(ByVal newStyle As BrushStyles)

    mLogBrush.lbStyle = newStyle
    
End Property


Public Property Get Style() As BrushStyles

    Style = mLogBrush.lbStyle
    
End Property