BAM Sample Programs - Printable Version

Code: (Select All)

Function GetWeekDay& (Day$) 'use MM/DD/YYYY format

    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence

    If CheckDayFormat(Day$) = 0 Then GetWeekDay = 0: Exit Function

    Dim As Long century, zerocentury, result

    Dim As Long MM, DD, YYYY

    MM = GetMonth(Day$): DD = GetDay(Day$): YYYY = GetYear(Day$)

    If MM < 3 Then MM = MM + 12: YYYY = YYYY - 1

    century = YYYY Mod 100

    zerocentury = YYYY \ 100

    result = (DD + Int(13 * (MM + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7

    If result = 0 Then result = 7

    GetWeekDay& = result 'results are 1 to 7, from Sunday to Saturday

End Function

Code: (Select All)

Function GetWeekDayName$ (Day$) 'use MM/DD/YYYY format

    Dim result As Long

    result = GetWeekDay(Day$)

    Select Case result

        Case 1: GetWeekDayName = "Sunday"

        Case 2: GetWeekDayName = "Monday"

        Case 3: GetWeekDayName = "Tuesday"

        Case 4: GetWeekDayName = "Wednesday"

        Case 5: GetWeekDayName = "Thursday"

        Case 6: GetWeekDayName = "Friday"

        Case 7: GetWeekDayName = "Saturday"

    End Select

End Function

Code: (Select All)

_Title "Geometric Thingy, press any for next color set" ' b+ port Charlie's code to QB64pe 2025-02-08

' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2025.02.08 at 07:06 (Coordinated Universal Time)

' This program by Charlie Veniot is inspired by a small programming challenge by ZXDunny.



Screen _NewImage(370, 370, 12)



Dim I%(10000)



Color 0, 15

Cls



For I = 0 To 30 Step 7

    Line (1 + I, 1 + I)-(62 - I, 62 - I), 0, B

    Line (62 + I, 1 + I)-(123 - I, 62 - I), 0, B

    Line (1 + I, 62 + I)-(62 - I, 123 - I), 0, B

    Line (62 + I, 62 + I)-(123 - I, 123 - I), 0, B

Next I



Line (62, 1)-(1, 62), 0

Line (62, 1)-(123, 62), 0

Line (1, 62)-(62, 123), 0

Line (62, 123)-(123, 62), 0



PaintLoop:



PCopy 0, 1



C1% = Int(Rnd * 14) + 1

C2% = Int(Rnd * 14) + 1



For I = 7 To 21 Step 14

    Paint (2 + I, 2 + I), C1%, 0

    Paint (63 + I, 61 - I), C1%, 0

    Paint (61 - I, 63 + I), C1%, 0

    Paint (122 - I, 122 - I), C1%, 0

Next I



For I = 0 To 32 Step 14

    Paint (61 - I, 61 - I), C2%, 0

    Paint (122 - I, 2 + I), C2%, 0

    Paint (2 + I, 122 - I), C2%, 0

    Paint (63 + I, 63 + I), C2%, 0

Next I



Get (1, 1)-(123, 123), I%()

Put (123, 1), I%(), PSet

Put (245, 1), I%(), PSet

Put (1, 123), I%(), PSet

Put (123, 123), I%(), PSet

Put (245, 123), I%(), PSet

Put (1, 245), I%(), PSet

Put (123, 245), I%(), PSet

Put (245, 245), I%(), PSet



'PCopy 0, 2

'PCopy 1, 0



'For Y = 0 To 369

'PCOPY (0, Y) - (369, Y), 2, 0

'SLEEP 0.003

'NEXT Y



Sleep



GoTo PaintLoop