delaunay.frm

构建delaunay三角网的程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Triangulate"
   ClientHeight    =   5685
   ClientLeft      =   165
   ClientTop       =   315
   ClientWidth     =   7035
   LinkTopic       =   "Form1"
   ScaleHeight     =   5685
   ScaleWidth      =   7035
   StartUpPosition =   1  'CenterOwner
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   7935
      Left            =   120
      ScaleHeight     =   7875
      ScaleWidth      =   13155
      TabIndex        =   0
      Top             =   600
      Width           =   13215
   End
   Begin VB.Label Label1 
      Caption         =   "Click The Pic Box to add points"
      Height          =   375
      Left            =   4200
      TabIndex        =   3
      Top             =   120
      Width           =   2655
   End
   Begin VB.Label lblTris 
      Height          =   375
      Left            =   2040
      TabIndex        =   2
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label lblPoints 
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tPoints As Integer 'Variable for total number of points (vertices)

Private Sub Form_Load()
'Initiate total points to 1, using base 0 causes problems in the functions
tPoints = 1
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    'variable to hold how many triangles are created by the triangulate function
    Dim HowMany As Integer
    
    'Set Vertex coordinates where you clicked the pic box
    Vertex(tPoints).x = x
    Vertex(tPoints).y = y
    
    'Perform Triangulation Function if there are more than 2 points
    If tPoints > 2 Then
        'Clear the Picture Box
        Picture1.Cls
        'Returns number of triangles created.
        HowMany = Triangulate(tPoints)
    Else
       
        'Draw a circle where you clicked so it does something
        Picture1.Circle (Vertex(tPoints).x, Vertex(tPoints).y), 50, vbBlack
    End If
    
    'Increment the total number of points
    tPoints = tPoints + 1
    
    'Display the total points and total triangles
    lblPoints.Caption = "Points: " & tPoints
    lblTris.Caption = "Triangles: " & HowMany
    
    'Draw the created triangles
    For i = 1 To HowMany
        Picture1.Line (Vertex(Triangle(i).vv0).x, Vertex(Triangle(i).vv0).y)-(Vertex(Triangle(i).vv1).x, Vertex(Triangle(i).vv1).y)
        Picture1.Line (Vertex(Triangle(i).vv1).x, Vertex(Triangle(i).vv1).y)-(Vertex(Triangle(i).vv2).x, Vertex(Triangle(i).vv2).y)
        Picture1.Line (Vertex(Triangle(i).vv0).x, Vertex(Triangle(i).vv0).y)-(Vertex(Triangle(i).vv2).x, Vertex(Triangle(i).vv2).y)
    Next i

End Sub