 NPSC補完計劃

• 十月 18, 2019, 02:08:33 am • 歡迎光臨, 訪客 NPSC補完計劃 » NPSC國中組 » NPSC2001國中組決賽 [VB] NPSC 2001 決賽 pB 描繪輪廓 作者主題: [VB] NPSC 2001 決賽 pB 描繪輪廓  (閱讀 1351 次)

lini

• 高級會員
•    • 文章數: 101 [VB] NPSC 2001 決賽 pB 描繪輪廓
« 於: 十一月 29, 2009, 07:26:49 pm »

Sub main()
Open "city.in" For Input As #1
Open "city.out" For Output As #2
Do
e2do = False: ReDim a(10000, 2): ct = 1
a(0, 0) = 0: a(0, 1) = 0: a(0, 2) = 10000
Do
Input #1, vl
If vl = -1 Then Exit Do
If vl = 0 Then e2do = True: Exit Do
Input #1, vh, vr
a(ct, 0) = vl
a(ct, 1) = vh
a(ct, 2) = vr
ct = ct + 1
Loop
ReDim pt(10000, 1): ptct = 0
For i = 1 To ct - 1
c = False
For j = 0 To ct - 1
If a(i, 0) > a(j, 0) And a(i, 0) <= a(j, 2) And a(j, 1) >= a(i, 1) Then c = True: Exit For
Next
If c = False Then
pt(ptct, 0) = a(i, 0)
pt(ptct, 1) = a(i, 1)
ptct = ptct + 1
End If
For k = 0 To ct - 1
If a(i, 2) >= a(k, 0) And a(i, 2) < a(k, 2) And a(k, 1) < a(i, 1) Then
c2 = False
For l = 0 To ct - 1
If a(i, 2) >= a(l, 0) And a(i, 2) < a(l, 2) And a(l, 1) > a(k, 1) Then c2 = True: Exit For
Next
If c2 = False Then
pt(ptct, 0) = a(i, 2)
pt(ptct, 1) = a(k, 1)
ptct = ptct + 1
End If
End If
Next
Next
For m = ptct - 2 To 0 Step -1
For n = 0 To m
If pt(m, 0) > pt(m + 1, 0) Then
t1 = pt(m, 0)
t2 = pt(m, 1)
pt(m, 0) = pt(m + 1, 0)
pt(m, 1) = pt(m + 1, 1)
pt(m + 1, 0) = t1
pt(m + 1, 1) = t2
End If
Next
Next
f = ""
For o = 0 To ptct - 1
f = f & pt(o, 0) & " " & pt(o, 1) & " "
Next
Print #2, Trim(f)
If e2do = True Then Exit Do
Loop
Close
End Sub 記錄 NPSC補完計劃 » NPSC國中組 » NPSC2001國中組決賽 [VB] NPSC 2001 決賽 pB 描繪輪廓