Public Sub HatchBox(ByVal obj As Object, ByVal x1 As _
Single, ByVal y1 As Single, ByVal x2 As Single, ByVal _
y2 As Single)
Const PIX_SPACING = 10 ' Spacing in pixels.
Dim spacing As Single
Dim tmp As Single
Dim c As Integer
Dim c1 As Integer
Dim c2 As Integer
Dim i1 As Integer
Dim j1 As Integer
Dim i2 As Integer
Dim j2 As Integer
spacing = obj.ScaleX(PIX_SPACING, vbPixels, _
obj.ScaleMode)
If x1 > x2 Then
tmp = x1
x1 = x2
x2 = tmp
End If
If y1 > y2 Then
tmp = y1
y1 = y2
y2 = tmp
End If
' Hatch like this: \\\.
c1 = Int((y1 - x2) / spacing + 1)
c2 = Int((y2 - x1) / spacing)
For c = c1 To c2
i1 = x1
i2 = x2
j1 = i1 + c * spacing
j2 = i2 + c * spacing
If j1 < y1 Then
i1 = y1 - c * spacing
j1 = i1 + c * spacing
End If
If j2 > y2 Then
i2 = y2 - c * spacing
j2 = i2 + c * spacing
End If
obj.Line (i1, j1)-(i2, j2)
Next c
' Hatch like this: ///.
c1 = Int((y1 + x1) / spacing + 1)
c2 = Int((y2 + x2) / spacing)
For c = c1 To c2
i1 = x1
i2 = x2
j1 = c * spacing - i1
j2 = c * spacing - i2
If j2 < y1 Then
i2 = c * spacing - y1
j2 = c * spacing - i2
End If
If j1 > y2 Then
i1 = c * spacing - y2
j1 = c * spacing - i1
End If
obj.Line (i1, j1)-(i2, j2)
Next c
End Sub
|