VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "dwPen"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' Class dwPen
' Desaware API Class library
' Copyright (c) 1996 by Desaware Inc.
' All rights reserved

#If Win32 Then
Private InternalPen As Long
#Else
Private InternalPen As Integer
#End If

Private pCreated%   ' Pen was created


#If Win32 Then
Private Declare Function apiGetStockObject& Lib "gdi32" Alias "GetStockObject" (ByVal nIndex As Long)
Private Declare Function apiDeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long)
Private Declare Function apiCreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
Private Declare Function apiCreatePenIndirect& Lib "gdi32" Alias "CreatePenIndirect" (lpLogPen As LOGPEN)

#Else
Private Declare Function apiGetStockObject% Lib "gdi" Alias "GetStockObject" (ByVal nIndex As Integer)
Private Declare Function apiDeleteObject% Lib "gdi" Alias "DeleteObject" (ByVal hObject As Integer)
Private Declare Function apiCreatePen% Lib "gdi" Alias "CreatePen" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Long)
Private Declare Function apiCreatePenIndirect% Lib "gdi" Alias "CreatePenIndirect" (lpLogPen As LOGPEN)
#End If 'WIN32

Public Property Get hPen()
    hPen = InternalPen
End Property

Public Property Let hPen(vNewValue)
    Cleanup
    InternalPen = vNewValue
End Property

' Delete any allocated objects
Public Sub Cleanup()
    If pCreated Then
        Call apiDeleteObject(InternalPen)
        pCreated = False
        InternalPen = apiGetStockObject(WHITE_PEN)
    End If
End Sub

Private Sub Class_Initialize()
      InternalPen = apiGetStockObject(WHITE_PEN)
End Sub

Private Sub Class_Terminate()
    Cleanup
End Sub

Public Property Get WHITE_PEN() As Integer
    WHITE_PEN = 6
End Property

Public Property Get BLACK_PEN() As Integer
    BLACK_PEN = 7
End Property

Public Property Get NULL_PEN() As Integer
    NULL_PEN = 8
End Property

Public Sub GetStockObject(idx%)
Attribute GetStockObject.VB_HelpID = 2569
Attribute GetStockObject.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Cleanup
    If idx < WHITE_PEN Or idx > NULL_PEN Then
        RaisePenError DWERR_INVALIDPARAMETER
    Else
        InternalPen = apiGetStockObject(idx)
    End If
End Sub

Public Sub CreatePen(ByVal nPenStyle, ByVal nWidth, ByVal crColor As Long)
Attribute CreatePen.VB_HelpID = 2510
Attribute CreatePen.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ret& = apiCreatePen(nPenStyle, nWidth, crColor)
    Cleanup
    If ret& = 0 Then RaisePenError
    InternalPen = ret&
    pCreated = True
End Sub

Private Sub RaisePenError(Optional errval)
    Dim useerr%
    If IsMissing(errval) Then
        RaisePenError DWERR_APIRESULT
    Else
        RaiseError errval, "dwPen"
    End If
End Sub
