03-04-2024, 04:43 PM
So, this doesn't have everything you were looking for dritter. It's needs some modernization in term of the new language choices we have. Pretty well functions as an opening screen in which you can display tasks and mainly displaying the same code you see with the other examples
Code: (Select All)
Cls
Screen _NewImage(1200, 800, 32) ' now my favourite screen. top left (1,1)...top right (1,149) .... bottom left ( 48,1).....bottom right (48,149) = for the text
Dim Shared White&
Dim Shared Black&
Dim Shared LightGreen&
Dim Shared DarkGreen&
Dim Shared Teal&
Dim Shared Blue&
Dim Shared LightBlue&
Dim Shared Orange&
Dim Shared Red&
Dim Shared Grey&
Dim Shared Purple&
Dim Shared LightPurple&
Dim Shared LightBrown&
Dim Shared Yellow&
Dim Shared Pink&
White& = _RGB(255, 255, 255)
Black& = _RGB(0, 0, 0)
LightGreen& = _RGB(0, 255, 0)
DarkGreen& = _RGB32(0, 129, 0)
Teal& = _RGB(0, 129, 129)
Yellow& = _RGB(255, 255, 0)
Blue& = _RGB(0, 0, 129)
LightBlue& = _RGB(0, 0, 255)
Orange& = _RGB(255, 129, 0)
Red& = _RGB(255, 0, 0)
Grey& = _RGB(133, 133, 150)
Purple& = _RGB(129, 0, 129)
LightPurple& = _RGB(129, 0, 205)
LightBrown& = _RGB(172, 100, 61)
Yellow& = _RGB(255, 255, 0)
Pink& = _RGB(216, 50, 166)
OpeningScreenBox
OpeningScreenBoxHeaders
Sub OpeningScreenBox
Cls
'************************************ OPENING SCREEN BOX **************************
Line (0, 0)-(1199, 81), White&, B ' main top box - also to be use for Error Messaging
Line (1, 1)-(1198, 80), Black&, BF
Line (0, 81)-(1198, 160), White&, B ' the TASK menu box
Line (0, 160)-(1198, 780), White&, B
End Sub
Sub OpeningScreenBoxHeaders
'**************************************** OPENING SCREEN HEADINGS *********************
'Top Box - center = 600,30
Color LightGreen&, Black&
_PrintString (500, 10), "LET'S GET STARTED"
TodayTime$ = Time$
m$ = Left$(TodayTime$, 2): Dt = Val(m$) ' TodayTime$ will carry todays correct time in 24 hr format = HH:MM:SS
If Dt >= 1 And Dt < 12 Then
Greet$ = "Good Morning "
Locate 3, 2
Color Yellow&
Print Greet$
End If
'm$ = LEFT$(TodayTime$, 2): Dt = VAL(m$)
If Dt >= 12 And Dt < 18 Then ' Greet$ will carry one of three greeting depending on the HH of Time of Day - ie 1 to 12 = Morning : 12:01 to 6 pm = Afternoon : 6:01 to midnight = Evening
Greet$ = "Good Afternoon "
Locate 3, 2
Color Orange&
Print Greet$
End If
'm$ = LEFT$(TodayTime$, 2): Dt = VAL(m$)
If Dt >= 18 And Dt < 24 Then
Greet$ = "Good Evening "
Locate 3, 2
Color DarkGreen&
Print Greet$
End If
Today$ = Date$
mth$ = Left$(Today$, 2): M = Val(mth$)
day$ = Mid$(Today$, 4, 2): D = Val(day$)
day$ = Str$(D)
year$ = Right$(Today$, 4): Yr = Val(year$)
Select Case M ' Month$ will now carry the correct Month : D will carry the correct Day : Yr will carry the correct Year
Case 1: Month$ = "January"
Case 2: Month$ = "February"
Case 3: Month$ = "March"
Case 4: Month$ = "April"
Case 5: Month$ = "May"
Case 6: Month$ = "June"
Case 7: Month$ = "July"
Case 8: Month$ = "August"
Case 9: Month$ = "September"
Case 10: Month$ = "October"
Case 11: Month$ = "November"
Case 12: Month$ = "December"
End Select
If Month$ = "May" Then Locate 2, 2
If Month$ = "June" Or Month$ = "July" Then Locate 2, 2
If Month$ = "March" Or Month$ = "April" Then Locate 2, 2
If Month$ = "August" Then Locate 2, 2
If Month$ = "January" Or Month$ = "October" Then Locate 2, 2
If Month$ = "February" Or Month$ = "November" Or Month$ = "December" Then Locate 2, 2
If Month$ = "September" Then Locate 2, 2
Color LightGreen&
Print Month$; D; Yr
Close 1
'OPEN "j:LastPrgmRunDate" FOR INPUT AS #1
Open "d:\LastPrgmRunDate" For Input As #1
Input #1, LMonth$, LD, LY
Close #1
LastRunMonth$ = LMonth$
LastRunDay = LD
LastRunYear = LY
Locate 2, 129
Color LightGreen&
Print "Program Last Run Date"
Locate 3, 130
Color LightPurple&
Print LastRunMonth$; " "; LastRunDay; " "; LastRunYear
End Sub