'通过声明类来实现链表 OptionExplicit Public xValue AsSingle'线与当前x扫描线的交点 Public yMax AsInteger'线的y最大值 Public kSubOne AsSingle'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 PrivateSub Command2_Click()Sub Command2_Click() '退出 End End Sub PrivateSub Command3_Click()Sub Command3_Click() '生成并输出AET Dim i AsInteger Form2.Show For i =1To12 Call CreatLink(i) '依次建立12条扫描线的AET Next End Sub PrivateSub CreatLink()Sub CreatLink(xLine AsInteger) '建立AET的过程 Dim xTemp AsSingle'当前线与x扫描线的交点的x坐标变量 Dim kTemp AsSingle'斜率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 AsString For i =1To 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坐标 IfVal(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存入链结点的第一个位置 IfVal(vy(i +1)) >Val(vy(i)) Then'判断y点谁大 将最大值存入链结点的第二个位置 n.yMax =Val(vy(i +1)) Else n.yMax =Val(vy(i)) EndIf kTemp = (Val(vy(i +1)) -Val(vy(i))) / (Val(vx(i +1)) -Val(vx(i))) '求k n.kSubOne = kTemp '将k存入链结点的第三个位置 If ListHead IsNothingThen'如果链表未空 Set ListHead = n '通过头 新节点入链 Else Set ListTail.NextNode = n '通过尾 新节点入链 EndIf Set ListTail = n '定义新的尾 Set ListTail.NextNode =Nothing'尾指向空 Else EndIf ElseIfVal(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 IfVal(vy(i +1)) >Val(vy(i)) Then n.yMax =Val(vy(i +1)) Else n.yMax =Val(vy(i)) EndIf kTemp = (Val(vy(i +1)) -Val(vy(i))) / (Val(vx(i +1)) -Val(vx(i))) n.kSubOne = kTemp If ListHead IsNothingThen Set ListHead = n Else Set ListTail.NextNode = n EndIf Set ListTail = n Set ListTail.NextNode =Nothing Else EndIf EndIf Next '按照xValue排序 Set nI2 = ListHead WhileNot nI2 IsNothing Set nI = nI2 Set nMax = nI2 While (Not nI IsNothingAndNot nI.NextNode IsNothing) If nI.xValue < nI.NextNode.xValue Then Set nMax = nI.NextNode EndIf Set nI = nI.NextNode Wend Dim tempV AsSingle 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 WhileNot ListHead IsNothing 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 PrivateSub Form_Activate()Sub Form_Activate() Set n =New Node X =0 Y =0 For i =1To xMax +1'画方格 Line (0, Y)-(xMax * grid, Y) Line (X, 0)-(X, xMax * grid) X = X + grid Y = Y + grid Next For i =1To 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 PrivateSub Form_Load()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 PrivateSub Form_MouseDown()Sub Form_MouseDown(Button AsInteger, Shift AsInteger, X AsSingle, Y AsSingle) Text1(Vid *2-2) =Round(X / grid): Text1(Vid *2-1) =Round(Y / grid) End Sub PrivateSub Text1_Change()Sub Text1_Change(Index AsInteger) Form1.Cls DrawWidth =1: X =0: Y =0 Text2 =Int((Index +1) /2+0.5) Vid = Text2 For i =1To xMax +1'画方格 Line (0, Y)-(xMax * grid, Y) Line (X, 0)-(X, xMax * grid) X = X + grid Y = Y + grid Next 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 =1To 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 PrivateSub Text2_Change()Sub Text2_Change() If Text2 <1Then Text2 =1 If Text2 > Vnumber Then Text2 = Vnumber For tt =1To Vnumber Label1(tt -1).ForeColor =QBColor(0) Text1(2* tt -1).ForeColor =QBColor(0) Text1(2* tt -2).ForeColor =QBColor(0) Next Vid = Text2 Label1(Vid -1).ForeColor =QBColor(9) Text1(2* Vid -1).ForeColor =QBColor(9) Text1(2* Vid -2).ForeColor =QBColor(9) End Sub PrivateSub Command1_Click()Sub Command1_Click() 'For i = 1 To 12 ' Call CreatLink(i) '依次建立12条扫描线的AET 'Next End Sub
通过声明类来实现链表Option ExplicitPublic xValue As Single 线与当前x扫描线的交点Public yMax As Integer 线的y最大值Public kSubOne As Single k的-1次方Public NextNode As Node 下一个Option Base 1