Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StrokePath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Any) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetMiterLimit Lib "gdi32" (ByVal hdc As Long, ByVal eNewLimit As Single, peOldLimit As Single) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type LOGBRUSH
lbStyle As Long
lbColor As Long
lbHatch As Long
End Type
Private Const PS_SOLID = 0
Private Const PS_DASH = 1 ' -------
Private Const PS_DOT = 2 ' .......
Private Const PS_DASHDOT = 3 ' _._._._
Private Const PS_DASHDOTDOT = 4 ' _.._.._
Private Const PS_NULL = 5
Private Const PS_INSIDEFRAME = 6
Private Const PS_USERSTYLE = 7
Private Const PS_ALTERNATE = 8
Private Const PS_STYLE_MASK = &HF
Private Const PS_ENDCAP_ROUND = &H0
Private Const PS_ENDCAP_SQUARE = &H100
Private Const PS_ENDCAP_FLAT = &H200
Private Const PS_ENDCAP_MASK = &HF00
Private Const PS_JOIN_ROUND = &H0
Private Const PS_JOIN_BEVEL = &H1000
Private Const PS_JOIN_MITER = &H2000
Private Const PS_JOIN_MASK = &HF000
Private Const PS_COSMETIC = &H0
Private Const PS_GEOMETRIC = &H10000
Private Const PS_TYPE_MASK = &HF0000
Private Const BS_SOLID = 0
Private Const BS_NULL = 1
Private Const BS_HOLLOW = BS_NULL
Private Const BS_HATCHED = 2
Private Const BS_PATTERN = 3
Private Const BS_INDEXED = 4
Private Const BS_DIBPATTERN = 5
Private Const BS_DIBPATTERNPT = 6
Private Const BS_PATTERN8X8 = 7
Private Const BS_DIBPATTERN8X8 = 8
' Hatch Styles
Private Const HS_HORIZONTAL = 0 ' -----
Private Const HS_VERTICAL = 1 ' |||||
Private Const HS_FDIAGONAL = 2 ' \\\\\
Private Const HS_BDIAGONAL = 3 ' /////
Private Const HS_CROSS = 4 ' +++++
Private Const HS_DIAGCROSS = 5 ' xxxxx
Private Sub chkCross_Click()
Picture1.Refresh
End Sub
Private Sub chkEndcap_Click(Index As Integer)
Picture1.Refresh
End Sub
Private Sub chkJoin_Click(Index As Integer)
Picture1.Refresh
End Sub
Private Sub chkStyle_Click(Index As Integer)
Picture1.Refresh
End Sub
Private Sub chkType_Click(Index As Integer)
Picture1.Refresh
End Sub
Private Sub Form_Load()
CustomStyle(0) = 3
CustomStyle(1) = 1
CustomStyle(2) = 1
CustomStyle(3) = 2
CustomStyle(4) = 1
CustomStyle(5) = 2
CustomStyle(6) = 1
CustomStyle(7) = 2
BrushInfo.lbColor = RGB(0, 255, 0)
BrushInfo.lbHatch = HS_CROSS
End Sub
Private Sub DoPenUpdate()
Dim di&
Dim pentype&, penstyle&, endcap&, join&
Dim usewidth&
' Delete the pen if it exists
If ExtendedPen Then di = DeleteObject(ExtendedPen)
If chkType(0).Value Then pentype = PS_COSMETIC Else pentype = PS_GEOMETRIC
If chkStyle(0).Value Then penstyle = PS_SOLID
If chkStyle(1).Value Then penstyle = PS_DASH
If chkStyle(2).Value Then penstyle = PS_USERSTYLE
If chkEndcap(0).Value Then endcap = PS_ENDCAP_ROUND
If chkEndcap(1).Value Then endcap = PS_ENDCAP_SQUARE
If chkEndcap(2).Value Then endcap = PS_ENDCAP_FLAT
If chkJoin(0).Value Then join = PS_JOIN_BEVEL
If chkJoin(1).Value Then join = PS_JOIN_MITER
If chkJoin(2).Value Then join = PS_JOIN_ROUND
' Set the pen style
If chkCross.Value = 1 Then BrushInfo.lbStyle = BS_HATCHED Else BrushInfo.lbStyle = BS_SOLID
If pentype = PS_COSMETIC Then usewidth = 1 Else usewidth = scrWidth.Value
If penstyle = PS_USERSTYLE Then
ExtendedPen = ExtCreatePen(pentype Or penstyle Or endcap Or join, usewidth, BrushInfo, CustomStyleLength, CustomStyle(0))
Else
ExtendedPen = ExtCreatePen(pentype Or penstyle Or endcap Or join, usewidth, BrushInfo, 0, ByVal 0&)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim di&
If ExtendedPen Then di = DeleteObject(ExtendedPen)
End Sub
Private Sub Picture1_Paint()
Dim di&
Dim pt As POINTAPI
Dim oldpen&
Dim oldmiter As Single
Dim newmiter As Single
DoPenUpdate
newmiter = scrMiter
di = SetMiterLimit(Picture1.hdc, newmiter, oldmiter)
oldpen = SelectObject(Picture1.hdc, ExtendedPen&)
di = MoveToEx(Picture1.hdc, 10, 150, pt)
di = LineTo(Picture1.hdc, 10, 20)
di = LineTo(Picture1.hdc, 40, 150)
di = LineTo(Picture1.hdc, 50, 20)
di = LineTo(Picture1.hdc, 70, 20)
di = LineTo(Picture1.hdc, 70, 150)
di = BeginPath(Picture1.hdc)
di = MoveToEx(Picture1.hdc, 100, 150, pt)
di = LineTo(Picture1.hdc, 100, 20)
di = LineTo(Picture1.hdc, 130, 150)
di = LineTo(Picture1.hdc, 140, 20)
di = LineTo(Picture1.hdc, 160, 20)
di = LineTo(Picture1.hdc, 160, 150)
di = EndPath(Picture1.hdc)
di = StrokePath(Picture1.hdc)
di = SelectObject(Picture1.hdc, oldpen)
di = SetMiterLimit(Picture1.hdc, oldmiter, newmiter)
(.txt)