form1.frm

用vb实现橡皮筋技术

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "直线、移动与画树"
   ClientHeight    =   7065
   ClientLeft      =   5895
   ClientTop       =   2160
   ClientWidth     =   8190
   LinkTopic       =   "Form1"
   ScaleHeight     =   7065
   ScaleWidth      =   8190
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   120
      TabIndex        =   12
      Text            =   "5000"
      Top             =   1920
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   120
      TabIndex        =   10
      Text            =   "0.618"
      Top             =   1320
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.CommandButton Command6 
      Caption         =   "画"
      Height          =   615
      Left            =   120
      TabIndex        =   9
      Top             =   2520
      Visible         =   0   'False
      Width           =   1335
   End
   Begin VB.CommandButton Command5 
      Caption         =   "画树"
      Height          =   615
      Left            =   6720
      TabIndex        =   8
      Top             =   6360
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Text            =   "1.2"
      Top             =   720
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Text            =   "80"
      Top             =   120
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.CommandButton Command4 
      Caption         =   "清除画线"
      Height          =   615
      Left            =   1680
      TabIndex        =   3
      Top             =   6360
      Width           =   1335
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   615
      Left            =   5040
      TabIndex        =   2
      Top             =   6360
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "画线"
      Height          =   615
      Left            =   3360
      TabIndex        =   1
      Top             =   6360
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "随机画线"
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   6360
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "树高"
      Height          =   375
      Left            =   1080
      TabIndex        =   13
      Top             =   1920
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Label Label3 
      Caption         =   "生长树枝处百分比"
      Height          =   255
      Left            =   1080
      TabIndex        =   11
      Top             =   1320
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "偏转角度"
      Height          =   375
      Left            =   1080
      TabIndex        =   7
      Top             =   720
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "最小树枝长度"
      Height          =   375
      Left            =   1080
      TabIndex        =   6
      Top             =   120
      Visible         =   0   'False
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim startx, starty, endx, endy, xx1, yy1, xx2, yy2, sign, yidong, huaxian, huashu As Integer
Dim high As Double
Dim min As Double
Dim angle As Double
Dim where As Double
Sub drawtree(high As Double, min As Double, angle As Double, where As Double, x As Double, y As Double)
Dim xx As Double
Dim yy As Double
Dim xx1 As Double
Dim xx2 As Double
Dim yy1 As Double
Dim yy2 As Double
Dim high1 As Double
Dim high2 As Double
xx = high * (1 - where) * Cos(angle)
yy = high * (1 - where) * Sin(angle)
Line (x, y)-(x + xx, y - yy), vbGreen
Line (x, y)-(x - xx, y - yy), vbGreen
'high = high * where
high1 = high * (1 - where)
xx1 = x + high1 * (1 - where) * Cos(angle)
yy1 = y - high1 * (1 - where) * Sin(angle)
xx2 = x - high1 * (1 - where) * Cos(angle)
yy2 = y - high1 * (1 - where) * Sin(angle)
If high1 > min Then
Call drawtree(high1, min, angle, where, xx1, yy1)
End If
If high1 > min Then
Call drawtree(high1, min, angle, where, xx2, yy2)
End If
If high1 > min Then
Call drawtree(high * where, min, angle, where, x, y - high * where * (1 - where))
End If
End Sub


Private Sub Command1_Click()
Dim x1, x2, y1, y2
Randomize
x1 = Int(Rnd * 2000 + 200)
y1 = Int(Rnd * 2000 + 200)
x2 = Int(Rnd * 6000 + 200)
y2 = Int(Rnd * 6000 + 200)
startx = x1
starty = y1
endx = x2
endy = y2
Line (x1, y1)-(x2, y2), RGB(255, 0, 0)
End Sub
Private Sub Command2_Click()
If sign = 1 And huashu = 0 Then
sign = 0
Command2.Caption = "画线"
Else
sign = 1
Command2.Caption = "移动直线"
End If
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
Cls
End Sub



Private Sub Command5_Click()
If huashu = 0 Then
Cls
huashu = 1
Command5.Caption = "返回"
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Command4.Visible = False
Command6.Visible = True
Text1.Visible = True
Text2.Visible = True
Text3.Visible = True
Text4.Visible = True
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Else
Cls
huashu = 0
Command5.Caption = "画树"
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
Command4.Visible = True
Command6.Visible = False
Text1.Visible = False
Text2.Visible = False
Text3.Visible = False
Text4.Visible = False
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
End If
End Sub

Private Sub Command6_Click()
Cls
high = CDbl(Text4.Text)
min = CDbl(Text1.Text)
where = CDbl(Text3.Text)
angle = CDbl(Text2.Text)
Line (4000, 6500)-(4000, 6500 - high), vbGreen
Call drawtree(high, min, angle, where, 4000, 6500 - high * (1 - where))
End Sub

Private Sub Form_Load()
Form1.AutoRedraw = True '重画  y1x0-y2x0-x1y0+x2y0+x1y2-x2y1
sign = 0
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If (sign = 0 And huashu = 0) Then
startx = x
starty = y
huaxian = 1
ElseIf huashu = 0 Then
 If starty * x - endy * x - startx * y + endx * y + startx * endy - endx * endy < 1E-39 Then
 yidong = 1
 Line (startx, starty)-(endx, endy), RGB(0, 0, 255)
 Circle (startx, starty), 20
 Circle (endx, endy), 20
 End If
xx1 = startx - x
yy1 = starty - y
xx2 = endx - x
yy2 = endy - y

End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If yidong = 1 And huashu = 0 Then
Cls
startx = x + xx1
starty = y + yy1
endx = x + xx2
endy = y + yy2
Line (startx, starty)-(endx, endy), RGB(0, 0, 255)
Circle (startx, starty), 20
Circle (endx, endy), 20
End If
If huaxian = 1 And sign = 0 And huashu = 0 Then
Cls
Line (startx, starty)-(x, y), RGB(0, 0, 255)
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If sign = 0 And huashu = 0 Then
endx = x
endy = y
Line (startx, starty)-(endx, endy), RGB(0, 0, 255)
huaxian = 0
Else
If yidong = 1 Then
Cls
startx = x + xx1
starty = y + yy1
endx = x + xx2
endy = y + yy2
Line (startx, starty)-(endx, endy), RGB(0, 0, 255)
End If
yidong = 0
End If

End Sub