测试vb1.bas

应用编码与计算机密码学>程序 如果好的话请发言

Attribute VB_Name = "modDraw"
Option Explicit

Const mMax = 200

Private Type Sck
   xleft As Integer
   x As Integer
   y As Integer
End Type

Dim stack(mMax) As Sck
Dim scnt As Integer
Public Sub dmline(pc As PictureBox, x1, y1, z1, x2, y2, z2)

'Dim x12 As Integer
'Dim y12 As Integer
'Dim x22 As Integer
'Dim y22 As Integer
Dim p1 As Point
Dim p2 As Point
ChangCoodirate x1, y1, z1, p1.x, p1.y
ChangCoodirate x2, y2, z2, p2.x, p2.y
myline pc, p1, p2, 1, 1, RGB(0, 0, 0)

End Sub

Public Sub ChangCoodirate(x, y, z, nx, ny)
Dim R As Integer
R = 60 / 180 * 3.14159
nx = x - z * Cos(R)
ny = y - z * Sin(R)
End Sub
Public Sub BYangTiao(pc As PictureBox, PO() As Point, pcnt As Integer, col As ColorConstants)
Dim Matrix(40, 40) As Double
Dim D(40) As Double
Dim h(40) As Double
Dim x As Double
Dim y As Double
Dim px As Integer
Dim py As Integer
Dim nx As Integer
Dim ny As Integer
Dim f0 As Double
Dim fbcnt As Double
Dim i As Double
Dim j As Integer
Dim k As Integer
Dim m(40) As Double
Dim ti As Integer
Dim newx As Double
Dim newy As Double
Dim de As Integer
Dim temp As Double

Dim opcnt As Integer
opcnt = pcnt

For i = 1 To pcnt
 PO(i - 1) = PO(i)
Next

pcnt = pcnt - 1
f0 = 0
fbcnt = 0
For i = 1 To pcnt
   h(i - 1) = PO(i).x - PO(i - 1).x
Next
D(0) = 6 * ((PO(1).y - PO(0).y) / h(0) - f0)
For i = 1 To pcnt - 1
  D(i) = 6 * ((PO(i + 1).y - PO(i).y) / h(i - 1) - (PO(i).y - PO(i - 1).y) / h(i))
Next
D(pcnt) = 6 * (fbcnt - (PO(pcnt).y - PO(pcnt - 1).y) / h(pcnt - 1))


Matrix(0, 0) = 2 * h(0)
Matrix(0, 1) = h(0)
Matrix(pcnt, pcnt - 1) = h(pcnt - 1)
Matrix(pcnt, pcnt) = 2 * h(pcnt - 1)
For i = 1 To pcnt - 1
  Matrix(i, i - 1) = h(i - 1)
  Matrix(i, i) = 2 * (h(i - 1) + h(i))
  Matrix(i, i + 1) = h(i)
Next

For i = 0 To pcnt
  For j = 0 To pcnt
    If j <> i Then
        temp = Matrix(j, i)
        For k = 0 To pcnt
           Matrix(j, k) = Matrix(j, k) - Matrix(i, k) / Matrix(i, i) * temp
        Next
        D(j) = D(j) - D(i) * temp / Matrix(i, i)
    End If
  Next
Next

For i = 0 To pcnt
  D(i) = D(i) / Matrix(i, i)
Next

For i = 0 To pcnt
  m(i) = D(i)
Next

px = PO(0).x
py = PO(0).y

de = -1

For i = PO(0).x To PO(pcnt).x - 1 Step 1
    For ti = 0 To pcnt
       If PO(ti).x > i Then Exit For
    Next
    ti = ti - 1
    If ti > de Then
       DoEvents
       de = ti
    End If
    If i > 40 Then
       DoEvents
    End If
    newx = i
    newy = m(ti) * (PO(ti + 1).x - newx) * (PO(ti + 1).x - newx) * (PO(ti + 1).x - newx) / (6 * h(ti)) + m(ti + 1) * (newx - PO(ti).x) * (newx - PO(ti).x) * (newx - PO(ti).x) / (6 * h(ti)) + (PO(ti + 1).y / h(ti) - m(ti + 1) * h(ti) / 6) * (newx - PO(ti).x) + (PO(ti).y / h(ti) - m(ti) * h(ti) / 6) * (PO(ti + 1).x - newx)
    If newy > 3200 Then
       newy = 3200
    Else
       If newy < -3200 Then
          newy = -3200
       Else
          ny = newy
       End If
    End If
    nx = newx
    ny = newy
    pc.Line (px, py)-(nx, ny), col
    px = nx
    py = ny
    pc.PSet (px, py)
Next
'PC.Line (px, py)-(PO(pcnt).X, PO(pcnt).Y), Col
Dim PP As Point
PP.x = px
PP.y = py
myline pc, PP, PO(pcnt), 1, 1, col
pc.PSet (PO(pcnt).x, PO(pcnt).y)
pcnt = 0

pcnt = opcnt
For i = pcnt - 1 To 0 Step -1
 PO(i + 1) = PO(i)
Next

End Sub

Public Sub B3(pc As PictureBox, PO() As Point, col As ColorConstants)
Dim px As Integer
Dim py As Integer
Dim nx As Integer
Dim ny As Integer
Dim t As Double
px = PO(1).x
py = PO(1).y
pc.PSet (px, py)
For t = 0 To 1 Step 0.005
    nx = PO(1).x * (1 - t) * (1 - t) * (1 - t) + 3 * PO(2).x * (1 - t) * (1 - t) * t + 3 * PO(3).x * (1 - t) * t * t + PO(4).x * t * t * t
    ny = PO(1).y * (1 - t) * (1 - t) * (1 - t) + PO(2).y * 3 * (1 - t) * (1 - t) * t + 3 * PO(3).y * t * t * (1 - t) + PO(4).y * t * t * t
    pc.Line (px, py)-(nx, ny), col
    pc.PSet (nx, ny), col
    px = nx
    py = ny
Next

End Sub

Public Sub Lagenanri(pc As PictureBox, PO() As Point, pcnt As Integer, col As ColorConstants)
   Dim D(40) As Double
   Dim L(40) As Double
   Dim temp(40) As Double
   Dim B As Double
   Dim y As Double
   Dim mu As Double
   Dim i As Integer
   Dim id As Double
   Dim j As Integer
   Dim k As Integer
   Dim xi As Double
   Dim oldx As Double
   Dim oldy As Double
   Dim ti As Integer
   Dim bf As Boolean
   Dim sclleft As Integer
   Dim scltop As Integer
   Dim sclwidth As Integer
   Dim sclheight As Integer
   Dim th As Integer
   Dim tv As Integer
   Dim Vpo(20) As Point
   
   sclleft = pc.ScaleLeft
   scltop = pc.ScaleTop
   sclwidth = pc.ScaleWidth
   sclheight = pc.ScaleHeight
   th = sclwidth / 2
   tv = sclheight / 2
   'PC.Scale (-th, tv)-(th, -tv)
   pc.Scale (-th, tv)-(th, -tv)
   For i = 1 To pcnt
      Vpo(i).x = PO(i).x - th
      Vpo(i).y = -(PO(i).y - tv)
   Next
   
   oldx = Vpo(1).x
   oldy = Vpo(1).y
  ' pcnt = pcnt - 1
   For id = Vpo(1).x To Vpo(pcnt).x - 1 Step 1
        y = 0
        For ti = 1 To pcnt
           If id = Vpo(ti).x Then
              DoEvents
              bf = True
              Exit For
           Else
              bf = False
           End If
        Next
        For k = 0 To pcnt
          mu = Vpo(k).y
          For j = 0 To pcnt
            If j <> k Then
                mu = mu * (id - Vpo(j).x) / (Vpo(k).x - Vpo(j).x)
            End If
          Next
          y = y + mu
        Next
        If bf = True Then
           DoEvents
        End If
        pc.Line (oldx, oldy)-(id, y), col
        pc.PSet (id, y), col
        oldx = id
        oldy = y
    Next
    pc.Line (oldx, oldy)-(Vpo(pcnt).x, Vpo(pcnt).y), col
    pc.PSet (Vpo(pcnt).x, y), col

pc.Scale (sclleft, scltop)-(sclleft + sclwidth, scltop + sclheight)
End Sub

Public Sub myline(pc As PictureBox, PO1 As Point, PO2 As Point, width, solid, color)
  
  Dim Index As Integer
  Dim index2 As Integer
  Dim lx As Double
  Dim ly As Double
  
  Dim mstep As Integer
  Dim currentX As Long
  Dim currentY As Long
  Dim opo1x As Integer
  Dim opo1y As Integer
  Dim opo2x As Integer
  Dim opo2y As Integer
  Dim temp As Integer
  
  Dim mlen As Integer
  Dim index3 As Integer
  Dim starty As Integer
  Dim left As Integer
  
  opo1x = PO1.x
  opo1y = PO1.y
  opo2x = PO2.x
  opo2y = PO2.y
  
  If PO1.x = PO2.x And PO1.y = PO2.y Then
    pc.PSet (PO1.x, PO1.y), color
    Exit Sub
  End If
  For index2 = width / 2 - width To width / 2

    If Abs(PO1.x - PO2.x) >= Abs(PO1.y - PO2.y) Then
    
        PO1.y = opo1y + index2
        PO2.y = opo2y + index2
        currentX = PO1.x
        currentY = PO1.y
        lx = 1
        
        If (PO2.y - PO1.y) <> 0 Then
          ly = (PO2.y - PO1.y) / (PO2.x - PO1.x)
        Else
          ly = 0
        End If
        mstep = (PO2.x - PO1.x) / Abs(PO2.x - PO1.x)
        
        If solid = 1 Then
            For Index = PO1.x To PO2.x Step mstep
               pc.PSet (currentX, currentY), color
               currentX = currentX + mstep
               currentY = PO1.y + (currentX - PO1.x) * ly
            Next
            pc.PSet (PO2.x, PO2.y), color
        Else
            mlen = (PO2.x - PO1.x) \ 21
            left = (PO2.x - PO1.x) \ 21
            For index3 = 0 To 9
                 For Index = 0 To mlen Step mstep
                   pc.PSet (currentX, currentY), color
                   currentX = currentX + mstep
                   currentY = PO1.y + (currentX - PO1.x) * ly
                Next Index
                currentX = currentX + mlen
                currentY = PO1.y + (currentX - PO1.x) * ly
            Next index3
            temp = Index + 2 * index3 * mlen
            left = PO2.x - currentX
            For index3 = currentX To PO2.x + 1 Step mstep
               pc.PSet (index3, currentY), color
               currentY = PO1.y + (index3 - PO1.x) * ly
            Next index3
            pc.PSet (PO2.x, PO2.y), color
        End If
        
    Else
     
        PO1.x = opo1x + index2
        PO2.x = opo2x + index2
        currentX = PO1.x
        currentY = PO1.y
        If (PO2.x - PO1.x) <> 0 Then
          lx = (PO2.x - PO1.x) / (PO2.y - PO1.y)
        Else
          lx = 0
        End If
        ly = 1
        mstep = (PO2.y - PO1.y) / Abs(PO2.y - PO1.y)
        If solid = 1 Then
            For Index = PO1.y To PO2.y Step mstep
               pc.PSet (currentX, currentY), color
               currentY = currentY + mstep
               currentX = PO1.x + (currentY - PO1.y) * lx
            Next
            pc.PSet (PO2.x, PO2.y), color
        Else
        
            mlen = (PO2.y - PO1.y) \ 21
            left = (PO2.y - PO1.y) \ 21
            For index3 = 0 To 9
                 For Index = 0 To mlen Step mstep
                   pc.PSet (currentX, currentY), color
                   currentY = currentY + mstep
                   currentX = PO1.x + (currentY - PO1.y) * lx
                Next Index
                currentY = currentY + mlen
                currentX = PO1.x + (currentY - PO1.y) * lx
            Next index3
            temp = Index + 2 * index3 * mlen
            For index3 = currentY To PO2.y Step mstep
               pc.PSet (currentX, index3), color
               currentX = PO1.x + (index3 - PO1.y) * lx
            Next index3
            pc.PSet (PO2.x, PO2.y), color
        End If
    End If
  Next
  PO1.x = opo1x
  PO1.y = opo1y
  PO2.x = opo2x
  PO2.y = opo2y
  
End Sub

Public Sub myRect(pc As PictureBox, PO1 As Point, PO2 As Point, color_in, color_out, Optional HasColor = 1)
   Dim mpo1 As Point
   Dim mpo2 As Point
   Dim temp As Integer
   Dim Index As Integer
   Dim a1 As Integer
   Dim a2 As Integer
   Dim a3 As Integer
   Dim a4 As Integer
   
   a1 = PO1.x
   a2 = PO1.y
   a3 = PO2.x
   a4 = PO2.y
   If PO1.x < PO2.x And PO1.y < PO2.y Then
      temp = PO2.x
      PO2.x = PO1.x