?? apilogbrush.cls
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -