Question

求一个VB程序的代码最好50行以上！

一个用到的代码简单但编写在50行以上的程序编写，请附上图！

Answer 1

（这里有更多的源码）

一个简单的时钟

DefDbl A-Z
Private Sub Form_Load()
    Timer1.Interval = 100
    Width = 4000
    Height = 4000
    Left = Screen.Width \ 2 - 2000
    Top = (Screen.Height - Height) \ 2
End Sub

Private Sub Form_Resize()
    Dim i As Long
    Dim Angle As Single
    Static Flag As Boolean
    
    If Flag = False Then
        Flag = True
        For i = 0 To 14
            If i > 0 Then Load Line1(i)
            Line1(i).Visible = True
            Line1(i).BorderWidth = 5
            Line1(i).BorderColor = RGB(0, 128, 0)
        Next i
    End If
    For i = 0 To 14
        Scale (-1, 1)-(1, -1)
        Angle = i * 2 * Atn(1) / 3
        Line1(i).X1 = 0.9 * Cos(Angle)
        Line1(i).Y1 = 0.9 * Sin(Angle)
        Line1(i).X2 = Cos(Angle)
        Line1(i).Y2 = Sin(Angle)
    Next i
End Sub

Private Sub Timer1_Timer()
    Const HH = 0
    Const MH = 13
    Const SH = 14
    Static ls
    If Second(Now) = ls Then Exit Sub
    ls = Second(Now)
    Angle = 0.5236 * (15 - (Hour(Now) + Minute(Now) / 60))
    Line1(HH).X1 = 0
    Line1(HH).Y1 = 0
    Line1(HH).X2 = 0.3 * Cos(Angle)
    Line1(HH).Y2 = 0.3 * Sin(Angle)
    Angle = 0.1047 * (75 - (Minute(Now) + Second(Now) / 60))
    Line1(MH).X1 = 0
    Line1(MH).Y1 = 0
    Line1(MH).X2 = 0.7 * Cos(Angle)
    Line1(MH).Y2 = 0.7 * Cos(Angle)
    Angle = 0.5236 * (75 - Second(Now))
    Line1(SH).X1 = 0
    Line1(SH).Y1 = 0
    Line1(SH).X2 = 0.8 * Cos(Angle)
    Line1(SH).Y2 = 0.8 * Sin(Angle)
End Sub

Answer 2

Private X() As Double, Y() As Double

Private Sub Command3_Click()
OrderXY X, Y
List1.Clear
Dim i As Integer
For i = 1 To List2.ListCount
List1.AddItem "最近　X=" & X(i) & Space(15 - Len(CStr(X(i)))) & "Y=" & Y(i)
Next
End Sub

Private Sub Form_Load()
'List2.AddItem "X20.79Y-97.81"
'List2.AddItem "X-20.79Y-97.81"
'List2.AddItem "X58.78Y-80.90"
'List2.AddItem "X-58.78Y-80.90"
'List2.AddItem "X-60.78Y-80.90"
'List2.AddItem "X-60.78Y-50.00"
'List2.AddItem "X86.60Y-50.00"
'List2.AddItem "X-99.45Y-10.45"
'List2.AddItem "X99.45Y-10.45"
'List2.AddItem "X-95.11Y30.90"
'List2.AddItem "X95.11Y30.90"
'List2.AddItem "X-74.31Y66.91"'大多了会溢出
List2.AddItem "X74.31Y66.91"
List2.AddItem "X-40.67Y91.35"
List2.AddItem "X40.67Y91.35"
List2.AddItem "X0Y100.00"
List2.AddItem "X0Y-50.00"
List2.AddItem "X0Y50.00"
List2.AddItem "X60Y-80.90"
List2.AddItem "X0Y0"
Dim i As Integer
ReDim X(List2.ListCount)
ReDim Y(List2.ListCount)
For i = 1 To List2.ListCount
X(i) = Val(Mid(List2.List(i - 1), 2, InStr(List2.List(i - 1), "Y") - 2))
Y(i) = Val(Mid(List2.List(i - 1), InStr(List2.List(i - 1), "Y") + 1, 20))
List1.AddItem "原序　X=" & X(i) & Space(15 - Len(CStr(X(i)))) & "Y=" & Y(i)
Next
End Sub

Private Function OrderXY(X() As Double, Y() As Double)
'==========VB 坐标最短路径 函数　改自网上　http://zhidao.baidu.com/question/281678791.html?
Dim i&, j&, k&, m&, n&, num&, temp As Double
Dim NewX() As Double
Dim NewY() As Double
Dim Smin As Double '定义最短总距离
Dim Stance() As Double '======================更正
If UBound(X()) <> UBound(Y()) Then MsgBox "坐标错误": Exit Function '防止数据错误
n = UBound(X())
ReDim p(n) As Long
p(0) = 0: num = 1
For i = 1 To n
p(i) = i 'p()数组依次存储从0到n共n+1个数
num = num * i '计算num，num表示的是n个坐标（除X(0),Y(0)以外)共有n！种排列
Next
ReDim Stance(num - 1) '定义数组存储每种连接方法的总距离'======================更正
ReDim NewX(n)
ReDim NewY(n)
For i = 0 To n - 1 'Stance（0）是按照原坐标顺序依次连接的总距离
Stance(0) = Stance(0) + Sqr((Y(i + 1) - Y(i)) * (Y(i + 1) - Y(i)) + (X(i + 1) - X(i)) * (X(i + 1) - X(i)))
Next
Smin = Stance(0)
For k = 0 To n
NewX(k) = X(k)
NewY(k) = Y(k)
Next
i = n - 1
'下面对p()数组的n个数（除0以外）进行排列，每产生一种排列方式，坐标数组的数据就对应交换，并计算这一路径的总距离
Do While i > 0
If p(i) < p(i + 1) Then
For j = n To i + 1 Step -1 '从排列右端开始
If p(i) <= p(j) Then Exit For '找出递减子序列
Next
temp = p(i): p(i) = p(j): p(j) = temp '将递减子序列前的数字与序列中比它大的第一个数交换
temp = X(i): X(i) = X(j): X(j) = temp '与之对应的X Y也交换
temp = Y(i): Y(i) = Y(j): Y(j) = temp
For j = n To 1 Step -1 '将这部分排列倒转
i = i + 1
If i >= j Then Exit For
temp = p(i): p(i) = p(j): p(j) = temp
temp = X(i): X(i) = X(j): X(j) = temp
temp = Y(i): Y(i) = Y(j): Y(j) = temp
Next
m = m + 1
For k = 0 To n - 1
Stance(m) = Stance(m) + Sqr((Y(k + 1) - Y(k)) * (Y(k + 1) - Y(k)) + (X(k + 1) - X(k)) * (X(k + 1) - X(k)))
Next

If Stance(m) <= Smin Then
Smin = Stance(m)
For k = 0 To n
NewX(k) = X(k): NewY(k) = Y(k)
Next
End If
i = n
End If
i = i - 1
Loop

For k = 0 To n
X(k) = NewX(k): Y(k) = NewY(k)
Next '此时的X（） Y（） 就按照最短路径排列

End Function
Private Function OrderX(X() As Double, Y() As Double)
'==========X优先排序
Dim i&, j&, k&, m&, n&, num&, temp As Double
Dim NewX() As Double
Dim NewY() As Double
If UBound(X()) <> UBound(Y()) Then MsgBox "坐标错误": Exit Function '防止数据错误
n = UBound(X())
ReDim p(n) As Long
p(0) = 0: num = 1
For i = 1 To n
p(i) = i 'p()数组依次存储从0到n共n+1个数
num = num * i '计算num，num表示的是n个坐标（除X(0),Y(0)以外)共有n！种排列
Next
ReDim Stance(num - 1) '定义数组存储每种连接方法的总距离'======================更正
ReDim NewX(n)
ReDim NewY(n)
For i = 0 To n - 1 'Stance（0）是按照原坐标顺序依次连接的总距离
Stance(0) = Stance(0) + Sqr((Y(i + 1) - Y(i)) * (Y(i + 1) - Y(i)) + (X(i + 1) - X(i)) * (X(i + 1) - X(i)))
Next
Smin = Stance(0)
For k = 0 To n
NewX(k) = X(k)
NewY(k) = Y(k)
Next
i = n - 1
'下面对p()数组的n个数（除0以外）进行排列，每产生一种排列方式，坐标数组的数据就对应交换，并计算这一路径的总距离
Do While i > 0
If p(i) < p(i + 1) Then
For j = n To i + 1 Step -1 '从排列右端开始
If p(i) <= p(j) Then Exit For '找出递减子序列
Next
temp = p(i): p(i) = p(j): p(j) = temp '将递减子序列前的数字与序列中比它大的第一个数交换
temp = X(i): X(i) = X(j): X(j) = temp '与之对应的X Y也交换
temp = Y(i): Y(i) = Y(j): Y(j) = temp
For j = n To 1 Step -1 '将这部分排列倒转
i = i + 1
If i >= j Then Exit For
temp = p(i): p(i) = p(j): p(j) = temp
temp = X(i): X(i) = X(j): X(j) = temp
temp = Y(i): Y(i) = Y(j): Y(j) = temp
Next
m = m + 1
For k = 0 To n - 1
Stance(m) = Stance(m) + Sqr((Y(k + 1) - Y(k)) * (Y(k + 1) - Y(k)) + (X(k + 1) - X(k)) * (X(k + 1) - X(k)))
Next

If Stance(m) <= Smin Then
Smin = Stance(m)
For k = 0 To n
NewX(k) = X(k): NewY(k) = Y(k)
Next
End If
i = n
End If
i = i - 1
Loop

For k = 0 To n
X(k) = NewX(k): Y(k) = NewY(k)
Next '此时的X（） Y（） 就按照最短路径排列

End Function