home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / classlib / desaware / dwpen.cls < prev    next >
Encoding:
Text File  |  1996-04-05  |  3.0 KB  |  106 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwPen"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. ' Class dwPen
  11. ' Desaware API Class library
  12. ' Copyright (c) 1996 by Desaware Inc.
  13. ' All rights reserved
  14.  
  15. #If Win32 Then
  16. Private InternalPen As Long
  17. #Else
  18. Private InternalPen As Integer
  19. #End If
  20.  
  21. Private pCreated%   ' Pen was created
  22.  
  23.  
  24. #If Win32 Then
  25. Private Declare Function apiGetStockObject& Lib "gdi32" Alias "GetStockObject" (ByVal nIndex As Long)
  26. Private Declare Function apiDeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long)
  27. Private Declare Function apiCreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
  28. Private Declare Function apiCreatePenIndirect& Lib "gdi32" Alias "CreatePenIndirect" (lpLogPen As LOGPEN)
  29.  
  30. #Else
  31. Private Declare Function apiGetStockObject% Lib "gdi" Alias "GetStockObject" (ByVal nIndex As Integer)
  32. Private Declare Function apiDeleteObject% Lib "gdi" Alias "DeleteObject" (ByVal hObject As Integer)
  33. Private Declare Function apiCreatePen% Lib "gdi" Alias "CreatePen" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor As Long)
  34. Private Declare Function apiCreatePenIndirect% Lib "gdi" Alias "CreatePenIndirect" (lpLogPen As LOGPEN)
  35. #End If 'WIN32
  36.  
  37. Public Property Get hPen()
  38.     hPen = InternalPen
  39. End Property
  40.  
  41. Public Property Let hPen(vNewValue)
  42.     Cleanup
  43.     InternalPen = vNewValue
  44. End Property
  45.  
  46. ' Delete any allocated objects
  47. Public Sub Cleanup()
  48.     If pCreated Then
  49.         Call apiDeleteObject(InternalPen)
  50.         pCreated = False
  51.         InternalPen = apiGetStockObject(WHITE_PEN)
  52.     End If
  53. End Sub
  54.  
  55. Private Sub Class_Initialize()
  56.       InternalPen = apiGetStockObject(WHITE_PEN)
  57. End Sub
  58.  
  59. Private Sub Class_Terminate()
  60.     Cleanup
  61. End Sub
  62.  
  63. Public Property Get WHITE_PEN() As Integer
  64.     WHITE_PEN = 6
  65. End Property
  66.  
  67. Public Property Get BLACK_PEN() As Integer
  68.     BLACK_PEN = 7
  69. End Property
  70.  
  71. Public Property Get NULL_PEN() As Integer
  72.     NULL_PEN = 8
  73. End Property
  74.  
  75. Public Sub GetStockObject(idx%)
  76. Attribute GetStockObject.VB_HelpID = 2569
  77. Attribute GetStockObject.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  78.     Cleanup
  79.     If idx < WHITE_PEN Or idx > NULL_PEN Then
  80.         RaisePenError DWERR_INVALIDPARAMETER
  81.     Else
  82.         InternalPen = apiGetStockObject(idx)
  83.     End If
  84. End Sub
  85.  
  86. Public Sub CreatePen(ByVal nPenStyle, ByVal nWidth, ByVal crColor As Long)
  87. Attribute CreatePen.VB_HelpID = 2510
  88. Attribute CreatePen.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
  89.     Dim ret&
  90.     
  91.     ret& = apiCreatePen(nPenStyle, nWidth, crColor)
  92.     Cleanup
  93.     If ret& = 0 Then RaisePenError
  94.     InternalPen = ret&
  95.     pCreated = True
  96. End Sub
  97.  
  98. Private Sub RaisePenError(Optional errval)
  99.     Dim useerr%
  100.     If IsMissing(errval) Then
  101.         RaisePenError DWERR_APIRESULT
  102.     Else
  103.         RaiseError errval, "dwPen"
  104.     End If
  105. End Sub
  106.