Children's Clock
#1
This is what happens when you have small children at home, they draw something and you show them that the drawing can be used in some way.

Program need H00H.gif file

Code: (Select All)
$NoPrefix
Title "Kids clock"
Dim Shared nrs(14) As Long
'DataCreate "hrsml.txt", "h00h.gif" - not used, is here for you - you can test it, it is way how find numbers to DATA lines in this program
LoadSubImages
Screen NewImage(1024, 768, 32)
CX = 500: CY = 350: A = -_Pi / 2 + _Pi(2) / 12
Circle (535, 419), 340, _RGB32(200)
Paint (535, 419), _RGB32(250), _RGB32(200)
For t = 0 To 11
    Xv = CX + Cos(A) * 250
    Yv = CY + Sin(A) * 250
    A = A + _Pi(2) / 12
    PutImage (Xv, Yv), nrs(t)
Next

PCopy Display, 1
Do Until k&
    k& = KeyDown(27)
    PCopy 1, Display
    Mode = 1
    Select Case Mode '                                   mode: 0 for standard STEPs mode, 1 for smooth steps.
        Case 0
            Hrs = Int(Timer / 3600)
            If Hrs > 12 Then Hrs = Hrs - 12
            Min = Int((Timer / 3600 - Hrs) * 60)
            Secs = Int(Timer - (Hrs * 3600 + Min * 60))
        Case 1
            Hrs = Timer / 3600
            Min = (Hrs - (Int(Timer / 3600))) * 60
            Secs = Timer - (Int(Hrs) * 3600 + Int(Min) * 60)
    End Select

    For HrsSel = 1 To 3
        Select Case HrsSel
            Case 1 'hours
                Asecs = _Pi(2) / 12 * Hrs - _Pi / 2
                iW = 45: iH = 144: Handle = 13: L1 = 170

            Case 2 'minutes
                Asecs = _Pi(2) / 60 * Min - _Pi / 2
                iW = 54: iH = 145: Handle = 14: L1 = 222

            Case 3 'seconds
                Asecs = _Pi(2) / 60 * Secs - _Pi / 2
                iW = 61: iH = 143: Handle = 12: L1 = 200
        End Select

        X1 = 535 + Cos(Asecs - .09) * L1
        X2 = 535 + Cos(Asecs + .09) * L1
        Y1 = 419 + Sin(Asecs - .09) * L1
        Y2 = 419 + Sin(Asecs + .09) * L1

        X3 = 535 + Cos(Asecs - .6) * -20
        X4 = 535 + Cos(Asecs + .6) * -20
        Y3 = 419 + Sin(Asecs - .6) * -20
        Y4 = 419 + Sin(Asecs + .6) * -20

        MapTriangle (0, 0)-(iW, iH)-(0, iH), nrs(Handle) To(X1, Y1)-(X3, Y3)-(X4, Y4)
        MapTriangle (iW, 0)-(0, 0)-(iW, iH), nrs(Handle) To(X2, Y2)-(X1, Y1)-(X3, Y3)
    Next HrsSel
    Display
    Limit 20
Loop

Sub DataCreate (OutputFile As String, InputFile As String) 'this sub is not need for run, but is used between developing this program. This sub create DATA values for us.
    img = LoadImage(InputFile$, 32)
    img2 = CopyImage(img, 32)

    ff = FreeFile
    Open OutputFile$ For Output As #ff
    Screen img
    Do Until k&
        k& = KeyDown(27)
        While _MouseInput: Wend
        MX = MouseX: MY = MouseY
        MB1 = MouseButton(1)
        MB2 = MouseButton(2)
        If MB1 Then
            Do Until MB1 = 0
                PutImage , img2
                Line (MX, MY)-(MouseX, MouseY), &HFF000000, B
                While MouseInput: Wend
                MB1 = MouseButton(1)
                Limit 15
            Loop
            wMX = MX: wMY = MY: wMx2 = _MouseX: wMy2 = _MouseY
        End If
        If MB2 Then
            If wMx2 Then
                r$ = Str$(wMX) + ", " + Str$(wMY) + ", " + Str$(wMx2) + ", " + Str$(wMy2)
                Print #ff, r$
                wMx2 = 0
            End If
        End If
    Loop
End Sub

Sub LoadSubImages
    img = LoadImage("H00H.gif", 32)
    For lsi = 0 To 14
        Read x1, y1, x2, y2, i
        wdth = x2 - x1: hght = y2 - y1
        nrs(i) = _NewImage(wdth, hght, 32)
        PutImage , img, nrs(i), (x1, y1)-(x2, y2)
        SetAlpha 0, _RGB32(255) To _RGB32(200), nrs(i)
    Next
    FreeImage img

    Data 0,4,62,148,12
    Data 69,5,115,150,13
    Data 118,7,172,153,14
    Data 182,9,226,140,8
    Data 226,10,310,134,9
    Data 320,10,430,144,10
    Data 435,11,522,132,11
    Data 1,177,59,270,0
    Data 64,171,130,260,1
    Data 143,170,204,267,2
    Data 211,168,280,269,3
    Data 282,168,330,265,4
    Data 332,167,401,272,5
    Data 402,156,469,274,6
    Data 474,157,518,265,7
End Sub


Attached Files Image(s)
   


Reply


Messages In This Thread
Children's Clock - by Petr - 03-25-2023, 02:21 PM



Users browsing this thread: 1 Guest(s)