构建扫描线链表-优快云博客

'通过声明类来实现链表

Option Explicit

Public xValue As Single '线与当前x扫描线的交点

Public yMax As Integer '线的y最大值

Public kSubOne As Single 'k的-1次方

Public NextNode As Node '下一个

Option Base 1 '让代码中所有数组的上标是从1开始

Dim X%, Y%, Vid%

Dim vx As Variant, vy As Variant '定义存放各个点坐标的数组

Const Vnumber = 7 '点的数目

Const xMax = 12 '坐标最大值

Const grid = 400

Private Sub Command2_Click() '退出

End

End Sub

Private Sub Command3_Click() '生成并输出AET

Dim i As Integer

Form2.Show

For i = 1 To 12

Call CreatLink(i) '依次建立12条扫描线的AET

End Sub

Private Sub CreatLink(xLine As Integer) '建立AET的过程

Dim xTemp As Single '当前线与x扫描线的交点的x坐标变量

Dim kTemp As Single '斜率k变量

Dim n As Node

Dim nI As Node

Dim nI2 As Node

Dim nMax As Node

Dim ListHead As Node '头

Dim ListTail As Node '尾

Dim printText As String

For i = 1 To Vnumber '依次检测各线p1p2 p2p3 p3p4...

xTemp = (((xLine - Val(vy(i))) * (Val(vx(i + 1)) - Val(vx(i)))) / (Val(vy(i + 1)) - Val(vy(i)))) + Val(vx(i)) '求得当前线与x扫描线的交点的x坐标

If Val(vx(i + 1)) > Val(vx(i)) Then '如果pi+1>pi的情况

If xTemp >= Val(vx(i)) And xTemp <= Val(vx(i + 1)) Then '交点位于有效范围内

Set n = New Node '声明结点

n.xValue = xTemp '将xTemp存入链结点的第一个位置

If Val(vy(i + 1)) > Val(vy(i)) Then '判断y点谁大将最大值存入链结点的第二个位置

n.yMax = Val(vy(i + 1))

Else

n.yMax = Val(vy(i))

End If

kTemp = (Val(vy(i + 1)) - Val(vy(i))) / (Val(vx(i + 1)) - Val(vx(i))) '求k

n.kSubOne = kTemp '将k存入链结点的第三个位置

If ListHead Is Nothing Then '如果链表未空

Set ListHead = n '通过头新节点入链

Else

Set ListTail.NextNode = n '通过尾新节点入链

End If

Set ListTail = n '定义新的尾

Set ListTail.NextNode = Nothing '尾指向空

Else

End If

ElseIf Val(vx(i)) > Val(vx(i + 1)) Then '如果pi+1<pi的情况

If xTemp >= Val(vx(i + 1)) And xTemp <= Val(vx(i)) Then '交点位于有效范围内

Set n = New Node

n.xValue = xTemp

If Val(vy(i + 1)) > Val(vy(i)) Then

n.yMax = Val(vy(i + 1))

Else

n.yMax = Val(vy(i))

End If

kTemp = (Val(vy(i + 1)) - Val(vy(i))) / (Val(vx(i + 1)) - Val(vx(i)))

n.kSubOne = kTemp

If ListHead Is Nothing Then

Set ListHead = n

Else

Set ListTail.NextNode = n

End If

Set ListTail = n

Set ListTail.NextNode = Nothing

Else

End If

'按照xValue排序

Set nI2 = ListHead

While Not nI2 Is Nothing

Set nI = nI2

Set nMax = nI2

While (Not nI Is Nothing And Not nI.NextNode Is Nothing)

If nI.xValue < nI.NextNode.xValue Then

Set nMax = nI.NextNode

End If

Set nI = nI.NextNode

Wend

Dim tempV As Single

tempV = nMax.xValue

nMax.xValue = nI2.xValue

nI2.xValue = tempV

tempV = nMax.yMax

nMax.yMax = nI2.yMax

nI2.yMax = tempV

tempV = nMax.kSubOne

nMax.kSubOne = nI2.kSubOne

nI2.kSubOne = tempV

Set nI2 = nI2.NextNode

Wend

'---

'输出当前链表到form2

While Not ListHead Is Nothing

Set n = ListHead

Set ListHead = ListHead.NextNode

printText = Format(n.xValue, "###0.00") & ", " & n.yMax & ", " & Format(n.kSubOne, "###0.00") + " " + printText

Set n = Nothing

Wend

Form2.Print Str(xLine) + " " + printText

End Sub

Private Sub Form_Activate()

Set n = New Node

X = 0

Y = 0

For i = 1 To xMax + 1 '画方格

Line (0, Y)-(xMax * grid, Y)

Line (X, 0)-(X, xMax * grid)

X = X + grid

Y = Y + grid

For i = 1 To Vnumber

Line (vx(i) * grid, vy(i) * grid)-(vx(i + 1) * grid, vy(i + 1) * grid), QBColor(12)

Print "p" & IIf((i + 1) = 8, 1, i + 1)

Next i

Vid = Text2

Label1(Vid - 1).ForeColor = QBColor(9)

Text1(2 * Vid - 1).ForeColor = QBColor(9)

Text1(2 * Vid - 2).ForeColor = QBColor(9)

End Sub

Private Sub Form_Load()

Scale (-ScaleWidth / 4, ScaleHeight - 200)-(ScaleWidth * 3 / 4 - 200, -200)

vx = Array(Text1(0), Text1(2), Text1(4), Text1(6), Text1(8), Text1(10), Text1(12), Text1(0))

vy = Array(Text1(1), Text1(3), Text1(5), Text1(7), Text1(9), Text1(11), Text1(13), Text1(1))

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Text1(Vid * 2 - 2) = Round(X / grid): Text1(Vid * 2 - 1) = Round(Y / grid)

End Sub

Private Sub Text1_Change(Index As Integer)

Form1.Cls

DrawWidth = 1: X = 0: Y = 0

Text2 = Int((Index + 1) / 2 + 0.5)

Vid = Text2

For i = 1 To xMax + 1 '画方格

Line (0, Y)-(xMax * grid, Y)

Line (X, 0)-(X, xMax * grid)

X = X + grid

Y = Y + grid

vx = Array(Text1(0), Text1(2), Text1(4), Text1(6), Text1(8), Text1(10), Text1(12), Text1(0))

vy = Array(Text1(1), Text1(3), Text1(5), Text1(7), Text1(9), Text1(11), Text1(13), Text1(1))

For i = 1 To Vnumber

Line (vx(i) * grid, vy(i) * grid)-(vx(i + 1) * grid, vy(i + 1) * grid), QBColor(12)

Print "p" & IIf((i + 1) = 8, 1, i + 1)

Next i

End Sub

Private Sub Text2_Change()

If Text2 < 1 Then Text2 = 1

If Text2 > Vnumber Then Text2 = Vnumber

For tt = 1 To Vnumber

Label1(tt - 1).ForeColor = QBColor(0)

Text1(2 * tt - 1).ForeColor = QBColor(0)

Text1(2 * tt - 2).ForeColor = QBColor(0)

Vid = Text2

Label1(Vid - 1).ForeColor = QBColor(9)

Text1(2 * Vid - 1).ForeColor = QBColor(9)

Text1(2 * Vid - 2).ForeColor = QBColor(9)

End Sub

Private Sub Command1_Click()

'For i = 1 To 12

' Call CreatLink(i) '依次建立12条扫描线的AET

'Next

End Sub

有效边表 VB6.0代码