Really Fancy Clock

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Really Fancy Clock

Postby duke4e » Sep 09, 2009 20:02

This is a software emulation of this cool clock http://www.qlocktwo.com/ (which btw. costs more than 800 EUR).

Code: Select all

#include "FBGfx.bi"
#define False 0
#define True NOT False

Const BlackIceTea = Rgb(26, 23, 27)
Const CherryCake = Rgb(224, 9, 24)
Const VanillaSugar = Rgb(206, 199, 189)
Const FrozenBlackberry = Rgb(84, 50, 136)
Const LimeJuice = Rgb(168, 175, 10)
Const xfont = 8
Const yfont = 8

Screenres xfont * 13, yfont * 12, 32,, FB.GFX_NO_FRAME Or FB.GFX_ALPHA_PRIMITIVES
Dim Shared As Integer hrs, min


Function SetColor(active As Integer) As Uinteger
    Return Iif (active = True, Rgba(255, 255, 255, 255), Rgba(0, 0, 0, 40))
End Function

Sub Line1()
    'IT L IS ASTIME
    Draw String(xfont * 1, yfont * 1), "IT", SetColor(True)
    Draw String Step(xfont * 2, 0), "L", SetColor(False)
    Draw String Step(xfont * 1, 0), "IS", SetColor(True)
    Draw String Step(xfont * 2, 0), "ASTIME", SetColor(False)
End Sub

Sub Line2()
    'A C QUARTER DC
    Draw String(xfont * 1, yfont * 2), "A", SetColor(False)
    Draw String Step(xfont * 1, 0), "C", SetColor(False)
    Draw String Step(xfont * 1, 0), "QUARTER", Iif(min = 15 Or min = 45, SetColor(True), SetColor(False))
    Draw String Step(xfont * 7, 0), "DC", SetColor(False)
End Sub

Sub Line3()
    'TWENTY FIVE X
    Draw String(xfont * 1, yfont * 3), "TWENTY", Iif(min = 20 Or min = 40 Or min = 25 Or min = 35, SetColor(True), SetColor(False))
    Draw String Step(xfont * 6, 0), "FIVE", Iif(min = 5 Or min = 55 Or min = 25 Or min = 35, SetColor(True), SetColor(False))
    Draw String Step(xfont * 4, 0), "X", SetColor(False)
End Sub

Sub Line4()
    'HALF B TEN F TO
    Draw String(xfont * 1, yfont * 4), "HALF", Iif(min = 30, SetColor(True), SetColor(False))
    Draw String Step(xfont * 4, 0), "B", SetColor(False)
    Draw String Step(xfont * 1, 0), "TEN", Iif(min = 10 Or min = 50, SetColor(True), SetColor(False))
    Draw String Step(xfont * 3, 0), "F", SetColor(False)
    Draw String Step(xfont * 1, 0), "TO", Iif(min > 30, SetColor(True), SetColor(False))
End Sub

Sub Line5()
    'PAST ERU NINE
    Draw String(xfont * 1, yfont * 5), "PAST", Iif(min > 0 And min <= 30, SetColor(True), SetColor(False))
    Draw String Step(xfont * 4, 0), "ERU", SetColor(False)
    Draw String Step(xfont * 3, 0), "NINE", Iif(hrs = 9, SetColor(True), SetColor(False))
End Sub

Sub Line6()
    'ONE SIX THREE
    Draw String(xfont * 1, yfont * 6), "ONE", Iif(hrs = 1, SetColor(True), SetColor(False))
    Draw String Step(xfont * 3, 0), "SIX", Iif(hrs = 6, SetColor(True), SetColor(False))
    Draw String Step(xfont * 3, 0), "THREE", Iif(hrs = 3, SetColor(True), SetColor(False))
End Sub

Sub Line7()
    'FOUR FIVE TWO
    Draw String(xfont * 1, yfont * 7), "FOUR", Iif(hrs = 4, SetColor(True), SetColor(False))
    Draw String Step(xfont * 4, 0), "FIVE", Iif(hrs = 5, SetColor(True), SetColor(False))
    Draw String Step(xfont * 4, 0), "TWO", Iif(hrs = 2, SetColor(True), SetColor(False))
End Sub

Sub Line8()
    'EIGHT ELEVEN
    Draw String(xfont * 1, yfont * 8), "EIGHT", Iif(hrs = 8, SetColor(True), SetColor(False))
    Draw String Step(xfont * 5, 0), "ELEVEN", Iif(hrs = 11, SetColor(True), SetColor(False))
End Sub

Sub Line9()
    'SEVEN TWELVE
    Draw String(xfont * 1, yfont * 9), "SEVEN", Iif(hrs = 7, SetColor(True), SetColor(False))
    Draw String Step(xfont * 5, 0), "TWELVE", Iif(hrs = 12, SetColor(True), SetColor(False))
End Sub

Sub Line10()
    'TEN S O'CLOCK
    Draw String(xfont * 1, yfont * 10), "TEN", Iif(hrs = 10, SetColor(True), SetColor(False))
    Draw String Step(xfont * 3, 0), "S", SetColor(False)
    Draw String Step(xfont * 1, 0), "O'CLOCK", Iif(min = 0, SetColor(True), SetColor(False))
End Sub

Sub Init()
    Randomize Timer
    Select Case Int(Rnd * 5)
        Case 0 : Color Rgb(255, 255, 255), BlackIceTea
        Case 1 : Color Rgb(255, 255, 255), CherryCake
        Case 2 : Color Rgb(255, 255, 255), VanillaSugar
        Case 3 : Color Rgb(255, 255, 255), FrozenBlackberry
        Case 4 : Color Rgb(255, 255, 255), LimeJuice
    End Select
End Sub

Sub Update()
    min = Val(Mid(Time, 4, 2))   
    min = Int(min / 5) * 5
   
    hrs = Val(Left(Time, 2))
    hrs = Iif(min > 30, hrs + 1, hrs)
    hrs = Iif(hrs <= 0, hrs + 12, hrs)
    hrs = Iif(hrs > 12, hrs - 12, hrs)
    hrs = Iif(hrs > 12, hrs - 12, hrs)
   
   
    Screenlock
    Cls
    Line1()
    Line2()
    Line3()
    Line4()
    Line5()
    Line6()
    Line7()
    Line8()
    Line9()
    Line10()
    Screenunlock
End Sub


Init()
Do
    Update()
    Sleep 1000
Loop Until Inkey <> ""


A minute ago I found a bug and corrected it quickly. If you by any chance get incorrect time, please post what time it really was and what was written my clock.

Enjoy.

Edit:
Here's console version

Code: Select all

#define False 0
#define True NOT False

Const BlackIceTea = Rgb(26, 23, 27)
Const CherryCake = Rgb(224, 9, 24)
Const VanillaSugar = Rgb(206, 199, 189)
Const FrozenBlackberry = Rgb(84, 50, 136)
Const LimeJuice = Rgb(168, 175, 10)
Dim Shared As Integer hrs, min, bgcolor


Sub SetColor(active As Integer)
    If active = True Then Color Rgb(255, 255, 255), bgcolor
    If active = False Then Color Rgb(0, 0, 0), bgcolor
End Sub

Sub Init()
    Randomize Timer
    Select Case Int(Rnd * 5)
        Case 0 : bgcolor = BlackIceTea
        Case 1 : bgcolor = CherryCake
        Case 2 : bgcolor = VanillaSugar
        Case 3 : bgcolor = FrozenBlackberry
        Case 4 : bgcolor = LimeJuice
    End Select
End Sub

Sub Line1()
    Locate 2, 2
    'IT L IS ASTIME
    SetColor(True)  : Print "IT";
    SetColor(False) : Print "L";
    SetColor(True)  : Print "IS";
    SetColor(False) : Print "ASTIME"
End Sub

Sub Line2()
    Locate 3, 2
    'A C QUARTER DC
    SetColor(False) : Print "A";
    SetColor(False) : Print "C";
    If min = 15 Or min = 45 Then SetColor(True) Else SetColor(False)
    Print "QUARTER";
    SetColor(False) : Print "DC"
End Sub

Sub Line3()
    Locate 4, 2
    'TWENTY FIVE X
    If min = 20 Or min = 40 Or min = 25 Or min = 35 Then SetColor(True) Else SetColor(False)
    Print "TWENTY";
    If min = 5 Or min = 55 Or min = 25 Or min = 35 Then SetColor(True) Else SetColor(False)
    Print "FIVE";
    SetColor(False) : Print "X"
End Sub

Sub Line4()
    Locate 5, 2
    'HALF B TEN F TO
    If min = 30 Then SetColor(True) Else SetColor(False)
    Print "HALF";
    SetColor(False) : Print "B";
    If min = 10 Or min = 50 Then SetColor(True) Else SetColor(False)
    Print "TEN";
    SetColor(False) : Print "F";
    If min > 30 Then SetColor(True) Else SetColor(False)
    Print "TO"
End Sub

Sub Line5()
    Locate 6, 2
    'PAST ERU NINE
    If min > 0 And min <= 30 Then SetColor(True) Else SetColor(False)
    Print "PAST";
    SetColor(False) : Print "ERU";
    If hrs = 9 Then SetColor(True) Else SetColor(False)
    Print "NINE"
End Sub

Sub Line6()
    Locate 7, 2
    'ONE SIX THREE
    If hrs = 1 Then SetColor(True) Else SetColor(False)
    Print "ONE";
    If hrs = 6 Then SetColor(True) Else SetColor(False)
    Print "SIX";
    If hrs = 3 Then SetColor(True) Else SetColor(False)
    Print "THREE"
End Sub

Sub Line7()
    Locate 8, 2
    'FOUR FIVE TWO
    If hrs = 4 Then SetColor(True) Else SetColor(False)
    Print "FOUR";
    If hrs = 5 Then SetColor(True) Else SetColor(False)
    Print "FIVE";
    If hrs = 2 Then SetColor(True) Else SetColor(False)
    Print "TWO"
End Sub

Sub Line8()
    Locate 9, 2
    'EIGHT ELEVEN
    If hrs = 8 Then SetColor(True) Else SetColor(False)
    Print "EIGHT";
    If hrs = 11 Then SetColor(True) Else SetColor(False)
    Print "ELEVEN"
End Sub

Sub Line9()
    Locate 10, 2
    'SEVEN TWELVE
    If hrs = 7 Then SetColor(True) Else SetColor(False)
    Print "SEVEN";
    If hrs = 12 Then SetColor(True) Else SetColor(False)
    Print "TWELVE"
End Sub

Sub Line10()
    Locate 11, 2
    'TEN SE OCLOCK
    If hrs = 10 Then SetColor(True) Else SetColor(False)
    Print "TEN";
    SetColor(False) : Print "S";
    If min = 0 Then SetColor(True) Else SetColor(False)
    Print "O'CLOCK";
End Sub

Sub Update()
    min = Val(Mid(Time, 4, 2))
    min = Int(min / 5) * 5
   
    hrs = Val(Left(Time, 2))
    hrs = Iif(min > 30, hrs + 1, hrs)
    hrs = Iif(hrs <= 0, hrs + 12, hrs)
    hrs = Iif(hrs > 12, hrs - 12, hrs)
    hrs = Iif(hrs > 12, hrs - 12, hrs)
   
    SetColor(False)
    Cls
    Line1()
    Line2()
    Line3()
    Line4()
    Line5()
    Line6()
    Line7()
    Line8()
    Line9()
    Line10()
End Sub


Init()
Do
    Update()
    Sleep 1000
Loop Until Inkey <> ""
angros47
Posts: 1830
Joined: Jun 21, 2005 19:04

Postby angros47 » Sep 09, 2009 20:26

funny :-)
Hezad
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:

Postby Hezad » Sep 10, 2009 18:26

funny and nice :D

To compile under linux I needed to change

Code: Select all

FBGfx.bi

to

Code: Select all

fbgfx.bi

;)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: Google [Bot] and 4 guests