用vb模拟斐波那契钟效果

传送：斐波那契钟百度百科
手痒，元器件在家，电烙铁在大陆的另一头，用vb搞些事情好了
界面差不多是这个样子


两个text用来方便看时间，最后会删掉
使用Now来获取系统时间
开始完善内容

写了一长串if。。。看的糟心

运行了之后是这样，原来是And写成了&。。。改正之后一切正常

这就对了

要看懂它，只需要简单加上呈现红色和蓝色色块的总数值即可。同样的，要读分钟数，加上绿色和蓝色色块的总数值即可。另外，一小时里有60分钟，这60分钟以5分钟隔断，共有12块，所以分钟数值加好后，还需要乘以5以得到最后的实际分钟值。
小时数 = 红色数值 + 蓝色数值
分钟数 = (绿色数值 + 蓝色数值) x 5

基本功能实现完毕，开始写函数，并添加自动更新时间以及随机呈现钟面功能
现在的代码

Option Explicit
Dim uhr, minuten

Private Sub Form_Load()
    uhr = Hour(Now)
    minuten = Minute(Now)
    Text1.Text = uhr
    Text2.Text = minuten
'5判断
    If uhr > 5 And minuten > 25 Then
        Shape1(4).BackColor = vbBlue
        uhr = uhr - 5
        minuten = minuten - 25
    ElseIf uhr > 5 Then
        Shape1(4).BackColor = vbRed
        uhr = uhr - 5
    ElseIf minuten > 25 Then
        Shape1(4).BackColor = vbGreen
        minuten = minuten - 25
    Else
        Shape1(4).BackColor = vbWhite
    End If
'3判断
    If uhr > 3 And minuten > 15 Then
        Shape1(3).BackColor = vbBlue
        uhr = uhr - 3
        minuten = minuten - 15
    ElseIf uhr > 3 Then
        Shape1(3).BackColor = vbRed
        uhr = uhr - 3
    ElseIf minuten > 15 Then
        Shape1(3).BackColor = vbGreen
        minuten = minuten - 15
    Else
        Shape1(3).BackColor = vbWhite
    End If
'2判断
    If uhr > 2 And minuten > 10 Then
        Shape1(2).BackColor = vbBlue
        uhr = uhr - 2
        minuten = minuten - 10
    ElseIf uhr > 2 Then
        Shape1(2).BackColor = vbRed
        uhr = uhr - 2
    ElseIf minuten > 10 Then
        Shape1(2).BackColor = vbGreen
        minuten = minuten - 10
    Else
        Shape1(2).BackColor = vbWhite
    End If
'1判断
    If uhr > 1 And minuten > 5 Then
        Shape1(1).BackColor = vbBlue
        uhr = uhr - 1
        minuten = minuten - 5
    ElseIf uhr > 1 Then
        Shape1(1).BackColor = vbRed
        uhr = uhr - 1
    ElseIf minuten > 5 Then
        Shape1(1).BackColor = vbGreen
        minuten = minuten - 5
    Else
        Shape1(1).BackColor = vbWhite
    End If
'另一个1判断
    If uhr = 1 And minuten = 5 Then
        Shape1(0).BackColor = vbBlue
    ElseIf uhr = 1 Then
        Shape1(0).BackColor = vbRed
    ElseIf minuten = 5 Then
        Shape1(0).BackColor = vbGreen
    Else
        Shape1(0).BackColor = vbWhite
    End If
End Sub

后来又测试了一遍发现程序是错的。。。所有判断应为>=而不是>

---

写了个死循环vb崩溃代码没保存，让我去哭会儿先

---

完成啦

这是实际效果

每30s刷新一次钟面，除了随机钟面功能其他都已经实现
这里是源码

Option Explicit
Dim uhr, minuten
Dim i

'先显示一次钟面
Private Sub Form_Load()
    Call Uhrzeigen
End Sub

'每隔30s刷新一次
Private Sub Timer1_Timer()
    Call Uhrzeigen
End Sub

'调用Quardfarbe()函数完成整个钟面的显示
Private Function Uhrzeigen()
    uhr = Hour(Time)
    If uhr > 12 Then
        uhr = uhr - 12
    End If
'强制转换为12小时制，可用Format$(Time, "hh")代替
    minuten = Minute(Time)
    For i = 4 To 0 Step -1
    Quardfarbe (i)
    Next
End Function

'逐块完成颜色显示
Private Function Quardfarbe(q As Integer)
    Select Case q
        Case 4
            q = 5
        Case 3
            q = 3
        Case 2
            q = 2
        Case 1
            q = 1
        Case 0
            q = 1
    End Select
    If uhr >= q And minuten >= q * 5 Then
        Shape1(i).BackColor = vbBlue
        uhr = uhr - q
        minuten = minuten - q * 5
    ElseIf uhr >= q Then
        Shape1(i).BackColor = vbRed
        uhr = uhr - q
    ElseIf minuten >= q * 5 Then
        Shape1(i).BackColor = vbGreen
        minuten = minuten - q * 5
    Else
        Shape1(i).BackColor = vbWhite
    End If
End Function

完事，继续玩linux去了