求助完善代码

Question

以下代码能实现画箭头功能，但我想在箭头顶端加条短横线，请问各位高人如何实现，谢谢！Sub Arrow(Pic As Object, X0 As Single, Y0 As Single, X1 As Single, Y1 As Single, ArrowLen As Single)
Dim Xa As Single, Ya As Single, Xb As Single, Yb As Single, D As Double
D = Sqr((Y1 - Y0) * (Y1 - Y0) + (X1 - X0) * (X1 - X0))
If D > 0.0000000001 Then
Xa = X1 + ArrowLen * ((X0 - X1) + (Y0 - Y1) / 2) / D
Ya = Y1 + ArrowLen * ((Y0 - Y1) - (X0 - X1) / 2) / D
Xb = X1 + ArrowLen * ((X0 - X1) - (Y0 - Y1) / 2) / D
Yb = Y1 + ArrowLen * ((Y0 - Y1) + (X0 - X1) / 2) / D
Pic.Line (Xa, Ya)-(X1, Y1)
Pic.Line (Xb, Yb)-(X1, Y1)
Pic.Line (X0, Y0)-(X1, Y1) '如果仅画箭头，此句可删除
End If
End SubPrivate Sub Picture1_Click()
Arrow Picture1, 1, 1, 3600, 1600, 100
End Sub