Guidance
指路人
g.yi.org
software / rapidq / Examples / Date & Time / Days.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'Days 2.61, a days-dates calculator
'By Achilles B. Mina
'Updated: October 9, 2001

'This utility is based on one of the modules of Calculait, a full-featured
'scientific calculator with a world clock. Calculait and Days are both
'downloadable from ZDNet, CNet, Tucows, Rocketdownload and other freeware sites, and at my
'website at http://pages.zdnet.com/wasaywasay/wasaywasay/

'You can do as you please with this code.

     $INCLUDE "RAPIDQ.INC"
     $ESCAPECHARS ON

'$RESOURCE DaysIco AS "days.ico"
'$RESOURCE clocktow AS "clocktow.wav"
'$RESOURCE camera AS "camera.wav"
'$RESOURCE cuckoo AS "cuckoo.wav"
'$RESOURCE gong AS "gong.wav"
'$RESOURCE handbell AS "handbell.wav"
'$RESOURCE whoosh AS "whoosh.wav"

     CONST AW_CENTER = &H10 'Makes the window appear to collapse inward if AW_HIDE is used or expand outward if the AW_HIDE is not used.
     CONST AW_HIDE = &H10000 'Hides the window. By default, the window is shown.

     DECLARE FUNCTION AnimateWindow LIB "user32" ALIAS "AnimateWindow"(BYVAL hwnd AS LONG, BYVAL dwTime AS LONG, BYVAL dwFlags AS LONG) AS INTEGER
     DECLARE FUNCTION SetFocus LIB "USER32" ALIAS "SetFocus" (HWnd AS LONG) AS LONG
     DECLARE FUNCTION PaintDesktop LIB "USER32" ALIAS "PaintDesktop" (HDC AS INTEGER) AS INTEGER
     DECLARE FUNCTION GetDC LIB "USER32" ALIAS "GetDC" (HWND AS INTEGER) AS INTEGER
     DECLARE SUB SetWindowPos LIB "User32" ALIAS "SetWindowPos"(hWnd AS LONG,hWndInsertAfter AS LONG,X AS LONG,Y AS LONG,cx AS LONG,cy AS LONG,wFlags AS LONG)
     DECLARE SUB PseudoMini
     DECLARE SUB Animate(Handle AS INTEGER)
     DECLARE SUB Deanimate(Handle AS INTEGER)
     DECLARE SUB CloseNoteProductForm
     DECLARE SUB CloseDays
     DECLARE SUB ShowNotes
     DECLARE SUB NotesShow
     DECLARE SUB EMailMe
     DECLARE SUB SendMe
     DECLARE SUB TopMost
     DECLARE SUB GetMonth(monthtocheck AS STRING)
     DECLARE SUB GetDay(daytocheck AS STRING)
     DECLARE SUB NewD
     DECLARE SUB preNew_Date
     DECLARE SUB New_Date(key AS BYTE)
     DECLARE SUB DaysDifference(key AS BYTE)
     DECLARE SUB preDaysDifference
     DECLARE FUNCTION GetAOdays AS INTEGER
     DECLARE FUNCTION GetOdays AS INTEGER
     DECLARE SUB TransDaysLeft
     DECLARE SUB TransDaysRight
     DECLARE SUB TransDateUp
     DECLARE SUB TransDateDn
     DECLARE SUB DayTodayRt
     DECLARE SUB DayTodayLt
     DECLARE SUB Initialize
     DECLARE SUB YearsMonths
     DECLARE SUB Time
     DECLARE SUB Nights
     DECLARE SUB Noisemaker
     DECLARE SUB Today
     DECLARE SUB Calendar
     DECLARE SUB CloseCalendar
     DECLARE SUB PopMonths
     DECLARE SUB MonthChanged(Sender AS QMENUITEM)
     DECLARE SUB YearChanged(key AS BYTE)
     DECLARE SUB DayChanged(Sender AS QCOOLBTN)
     DECLARE SUB Blink
     DECLARE SUB LoopColor
     DECLARE SUB CalendarColor
     DECLARE SUB UpDownYear
     DECLARE SUB PaintForm
     DECLARE SUB PanelColors
     DECLARE SUB ButtonColor
     DECLARE SUB ImageFiles

     DEFWORD buttcolor,monthnow, monththen, monthchecked, yearnow, yearthen, betyears
     DEFBYTE ccolorcount,blinking,soundoff,juston,colorcount,countyrsmos,leapnow, leapthen, bleap, circa, weekday, fmonth, emonth, pmonth, todate, always
     DEFINT totyears, totmonths, byear, bmonth, bleapyear, yearhence, AOyears, fyear, eyear, pyear
     DEFINT Bdays, rundays, edays, otherdays, totdays, yeardays,Odays, AOdays, diffdays, betleaps, daynow, daythen, Adays
     DEFINT lastColor, fday, eday, pday, neweday, newpday, monthdays, daysthence, dayshence, bday, days
     DEFSTR PreWeeksPanel$, wday$, month$, thedate$, inifile, iDir, image0, image1, image2, image3, image4, image5

     CONST HWND_TOPMOST = -1
     CONST HWND_NOTOPMOST = -2
     CONST SWP_NOSIZE = &H1
     CONST SWP_NOMOVE = &H2

'CONST SC_SIZE = 61440
'CONST SC_MOVE = 61456
'CONST SC_MINIMIZE = 61472
'CONST SC_MAXIMIZE = 61488
'CONST SC_CLOSE = 61536
'CONST SC_RESTORE = 61728

     CONST WM_SYSCOMMAND = &H0112
'CONST WM_SIZING = 532
'CONST WM_MOVING = 534

     CREATE Arial8B AS QFONT
      Name = "Arial"
      Size = 8
      AddStyles(fsBold)
     END CREATE

     CREATE Arial10B AS QFONT
      Name = "Arial"
      Size = 10
      AddStyles(fsBold)
     END CREATE

     CREATE Arial9B AS QFONT
      Name = "Arial"
      Size = 12
      AddStyles(fsBold)
     END CREATE

     CREATE TimeFont AS QFONT
      Name = "Univers"
      COLOR = clGreen
      Size = 12
      AddStyles(fsBold)
     END CREATE

     CREATE ArialY10 AS QFONT
      Name = "Arial"
      Size = 10
      COLOR = &HFFFFF 'HGFCCC '&HBCCC
      AddStyles = fsBold
     END CREATE

     CREATE ArialP10 AS QFONT
      Name = "Arial"
      Size = 10
      COLOR = clPurple
      AddStyles = fsBold
     END CREATE

     CREATE ArialB10 AS QFONT
      Name = "Arial"
      Size = 10
      COLOR = clBlue
      AddStyles = fsBold
     END CREATE

     CREATE ArialG10 AS QFONT
      Name = "Arial"
      Size = 10
      COLOR = clGreen
      AddStyles = fsBold
     END CREATE

     CREATE Timer1 AS QTIMER
      Enabled = 1
      Interval = 1000
      OnTimer = Time
     END CREATE

     CREATE Timer2 AS QTIMER
      Enabled = 0
      Interval = 1
      OnTimer = NotesShow
     END CREATE

     CREATE Timer3 AS QTIMER
      Enabled = 1
      Interval = 80
      OnTimer = LoopColor
     END CREATE
     CREATE DaysDates AS QFORM
      Width = 497 '500
      Height = 260
      Center
      WndProc = PaintForm
      OnClose = CloseDays
      CREATE NewDForm AS QPANEL
       CAPTION = "New Date"
       Top = 20 '10
       Left = 10 '5
       Width = 230 '237
       Height = 195 '205
       Cursor = -21
       ShowHint = 1
       Hint = "Click to change the backdrop."
       OnClick = PanelColors
  'CREATE NewDImage AS QIMAGE
    'Autosize = 1
    'Align = alClient
    'Left = 10
    'OnClick = CalendarColor
  'END CREATE
       CREATE Month AS QEDIT
        Text = LEFT$(DATE$,2)
        Left = 10
        Top = 5
        Width = 65
        TabOrder = 1
        OnKeyPress = New_Date
       END CREATE
       CREATE Day AS QEDIT
        Text = MID$(DATE$,4,2)
        Left = 82
        Top = 5
        Width = 65
        TabOrder = 2
        OnKeyPress = New_Date
       END CREATE
       CREATE Year AS QEDIT
        Text = RIGHT$(DATE$,4)
        Left = 154
        Top = 5
        Width = 65
        TabOrder = 3
        OnKeyPress = New_Date
       END CREATE
       CREATE DayThence AS QEDIT
        Text = "Days past"
        Left = 10
        Top = 30
        Width = 65
        TabOrder = 4
        OnKeyPress = New_Date
       END CREATE
       CREATE SNotes AS QLABEL
        Alignment = taCenter
        Layout = tlCenter
        LabelStyle = 1
        CAPTION = "NOTES"
        Left = 82
        Top = 31
        Width = 65
        Height = 19
        COLOR = clWhite
        Hint = "Click to know more about Days"
        ShowHint = 1
        OnClick = ShowNotes
       END CREATE
       CREATE DayHence AS QEDIT
        Text = "Days hence"
        Left = 154
        Top = 30
        Width = 65
        TabOrder = 5
        OnKeyPress = New_Date
       END CREATE
       CREATE DateButt AS QBUTTON
        Font = Arial9B
        CAPTION = "New Date"
        Left = 10
        Top = 65
        Width = 210
        Height = 25
        Cursor = -21
        Hint = "Click to get new date"
        ShowHint = 1
        OnClick = preNew_Date
       END CREATE
       CREATE DatePanel AS QPANEL
        Left = 10
        Top = 90
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "The new date"
        Hint = "Click to send date to the Clipboard\nand the Days Difference lower row.\nDouble-click to send to upper row."
        ShowHint = 1
        Cursor = -21
        OnClick = TransDateDn
        OnDblClick = TransDateUp
       END CREATE
       CREATE WeekdayPanel AS QPANEL
        Left = 10
        Top = 130
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "Day of the week"
        Hint = "Click to post today's date on the upper row."
        ShowHint = 1
        Cursor = -21
        OnClick = DayTodayLt
       END CREATE
       CREATE Cal AS QOVALBTN
        Left = 105
        Top = 172
        Height = 20
        Width = 20
        Flat = 1
        Down = 1
        Hint = "Click to bring up the calendar."
        ShowHint = 1
        Cursor = -12
        OnClick = Calendar
       END CREATE
      END CREATE
      CREATE DaysDForm AS QPANEL
       CAPTION = "Days Difference"
       Top = 20 '10
       Left = 250
       Width = 230 '237
       Height = 195 '205
       Cursor = -21
       Hint = "Click to change the backdrop."
       ShowHint = 1
       OnClick = TopMost
    'CREATE DaysDImage AS QIMAGE
      'Autosize = 1
      'Align = alClient
      'Left = 10
      'OnClick = CalendarColor
    'END CREATE
       CREATE Month1 AS QEDIT
        Text = LEFT$(DATE$,2)
        Left = 10
        Top = 5
        Width = 65
        TabOrder = 1
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Day1 AS QEDIT
        Text = MID$(DATE$,4,2)
        Left = 82
        Top = 5
        Width = 65
        TabOrder = 2
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Year1 AS QEDIT
        Text = RIGHT$(DATE$,4)
        Left = 154
        Top = 5
        Width = 65
        TabOrder = 3
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Month2 AS QEDIT
        Text = "End month"
        Left = 10
        Top = 30
        Width = 65
        TabOrder = 4
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Day2 AS QEDIT
        Text = "End day"
        Left = 82
        Top = 30
        Width = 65
        TabOrder = 5
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Year2 AS QEDIT
        Text = "End year"
        Left = 154
        Top = 30
        Width = 65
        TabOrder = 6
        OnKeyPress = DaysDifference
       END CREATE
       CREATE DaysButt AS QBUTTON
        Font = Arial9B
        CAPTION = "Days Difference"
        Left = 10
        Top = 65
        Width = 210
        Height = 25
        Cursor = -21
        Hint = "Click to get the difference in days between the dates"
        ShowHint = 1
        OnClick = preDaysDifference
       END CREATE
       CREATE DaysPanel AS QPANEL
        Left = 10
        Top = 90
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "Difference in days"
        Hint = "Click to send result to the Clipboard \nand to Days-past on the left.\nDouble-click to send to Days-hence,\nalso on the left."
        ShowHint = 1
        Cursor = -21
        OnClick = TransDaysLeft
        OnDblClick = TransDaysRight
       END CREATE
       CREATE WeeksPanel AS QPANEL
        Left = 10
        Top = 130
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "Difference in weeks"
        Hint = "Click to cycle through weeks, months and years."
        ShowHint = 1
        Cursor = -21
        OnClick = YearsMonths
       END CREATE
       CREATE Noise AS QOVALBTN
        Left = 105
        Top = 172
        Height = 20
        Width = 20
        Flat = 1
        Down = 1
        Hint = "Click to turn on/off sound effects."
        ShowHint = 1
        Cursor = -12
        OnClick = Noisemaker
       END CREATE
      END CREATE
      CREATE NoteProductForm AS QFORM
       Top = Screen.Height/2 + 25
       Left = Screen.Width/2 - 170
       Width = 340 '320
       Height = 205
       COLOR = &HCC000 '&HABC777
       BorderStyle = 1
       DelBorderIcons(biMaximize)
       DelBorderIcons(biMinimize)
       BorderStyle = bsSingle
       FormStyle = fsStayOnTop
       CAPTION = "Notes on Days"
       OnClose = CloseNoteProductForm
       CREATE DXNotes AS QCANVAS
        Top = 21
        Left = 242
        Height = 63
        Width = 84
        COLOR = 0
        Cursor = -21
        Hint = "Click to email comment or bug report."
        Showhint = 1
        OnClick = EmailMe
       END CREATE
       CREATE ProductList AS QLISTBOX
        Width = 232
        Height = 177
        AddItems ""
        AddItems "Welcome!"
        AddItems ""
        AddItems "  »  Days runs best on Pentium-class  "
        AddItems "      machines with Windows 98 or better."
        AddItems "      (It will run on older 486 PCs"
        AddItems "      on Windows 95 but will show a "
        AddItems "      harmless incompatibility message."
        AddItems "      Just ignore it.)"
        AddItems ""
        AddItems "  »  Days is an easy-to-use date  "
        AddItems "      calculator and calendar that can"
        AddItems "      easily calculate the difference"
        AddItems "      in days, weeks, months or years "
        AddItems "      between two dates or get the date "
        AddItems "      in the future or past given the "
        AddItems "      number of days from any specified "
        AddItems "      date."
        AddItems ""
        AddItems "  »  To use Days, just follow the hints"
        AddItems "      attached to each button, panel or"
        AddItems "      display. Days doesn't use menus."
        AddItems ""
        AddItems "  »  Days has two panels: the left one"
        AddItems "      calculates new dates; the right "
        AddItems "      one, days difference."
        AddItems ""
        AddItems "  »  To get a new date in the past from,"
        AddItems "      say, today, enter the number "
        AddItems "      of days in the Days-past (left)"
        AddItems "      field. Conversely, to get a future"
        AddItems "      date, enter the number of days"
        AddItems "      in the Days-hence (right) field."
        AddItems ""
        AddItems "  »  To get the day of the week of any"
        AddItems "      date, just input the date in the "
        AddItems "      upper row of the left panel and "
        AddItems "      press Enter or click New Date."
        AddItems ""
        AddItems "  »  If both Days-past and Days-hence "
        AddItems "      are filled, Days calculates for "
        AddItems "      days past."
        AddItems ""
        AddItems "  »  To calculate the difference between"
        AddItems "      two dates, you must fill in six "
        AddItems "      fields, three to each row. The first "
        AddItems "      field on either row is for the month;  "
        AddItems "      the second, for the day; the third, "
        AddItems "      for the year."
        AddItems ""
        AddItems "  »  You can use either numbers or words"
        AddItems "      (e.g. 01, 1, Jan, jan., january), "
        AddItems "      the calculator will know what to do. "
        AddItems "      The year, however, must be written "
        AddItems "      in full and in numbers."
        AddItems ""
        AddItems "  »  Press Enter while in any of the "
        AddItems "      fields or click on the appropriate  "
        AddItems "      button to get the answer."
        AddItems ""
        AddItems "  »  Click The-new-date panel to send the "
        AddItems "      new date to the lower-row fields of "
        AddItems "      Days Difference and the Clipboard.  "
        AddItems "      Double-click to send the new date "
        AddItems "      to the upper row.     "
        AddItems ""
        AddItems "  »  Click the Difference-in-days panel  "
        AddItems "      to send the result to the Days-past"
        AddItems "      field and also to the Clipboard.  "
        AddItems "      Double-click to send it to the "
        AddItems "      Days-hence field.     "
        AddItems ""
        AddItems "  »  Clicking on the Day-of-the-week   "
        AddItems "      posts the current date on the left "
        AddItems "      upper-row field. Clicking on the   "
        AddItems "      Weeks panel cycles through the   "
        AddItems "      number of weeks, months and years."
        AddItems ""
        AddItems "  »  Theoretically, Days can calculate "
        AddItems "      dates from Year 0 to Year 65000, a "
        AddItems "      span of over 23 million days. For a"
        AddItems "      meaningful result, however, confine "
        AddItems "      dates to after September 14, 1752-- "
        AddItems "      the day our calendar, the Gregorian, "
        AddItems "      was last significantly amended and  "
        AddItems "      the day it was adopted by Britain."
        AddItems ""
        AddItems "  »  You can change the calendar's "
        AddItems "      backdrop by clicking on the button"
        AddItems "      marked B. You can cycle through "
        AddItems "      six backdrops by repeatedly"
        AddItems "      clicking on the backdrop. You can "
        AddItems "      even substitute your own images for "
        AddItems "      the supplied backdrops by clicking "
        AddItems "      on the background then selecting "
        AddItems "      an appropriate image file stored "
        AddItems "      in your computer. Remember to use "
        AddItems "      only images that are at least  "
        AddItems "      210 pixels wide x 200 pixels high."
        AddItems ""
        AddItems "  »  You can put Days always on top "
        AddItems "      by clicking on the green backdrop "
        AddItems "      on the right."
        AddItems ""
        AddItems "  »  Days remembers your preferences--"
        AddItems "      no need to readjust your settings "
        AddItems "      each time you use it."
        AddItems ""
        AddItems "  »  Click the round depression at the"
        AddItems "      bottom of the left panel to access"
        AddItems "      Days' perpetual calendar."
        AddItems ""
        AddItems "  »  Using the calendar is straightforward."
        AddItems "      To change the month, click on the "
        AddItems "      Month panel, then select the month. "
        AddItems "      To change the year, select the Year"
        AddItems "      panel, then type in the new year."
        AddItems "      Or you can use the arrow-left or"
        AddItems "      arrow-right button to change the"
        AddItems "      year entry one year at a time."
        AddItems "      To change the day, simply click on"
        AddItems "      the appropriate button."
        AddItems ""
        AddItems "Programming"
        AddItems "  »  Days was written in Rapid-Q, a"
        AddItems "      computer language developed by "
        AddItems "      William Yu. It's also freeware at"
        AddItems "      www.basicguru.com/abc/rapidq."
       END CREATE
       CREATE NotesP0 AS QLABEL
        Top = 3
        Left = 255
        Width = 84
        Font = Arial10B
        CAPTION = "Days 2.61"
        Alignment = taCenter
        Layout = -1
        LabelStyle = 1
        OnClick = SendMe
        Hint = "Click to go to website"
        ShowHint = 1
       END CREATE
       CREATE NotesP1 AS QLABEL
        Top = 85
        Left = 235
        CAPTION = "  Copyright (c) 2001\n    Achilles B. Mina\n\nThis is FREEWARE.\n Not for commercial\n       distribution."
       END CREATE
      END CREATE
      CREATE CalendarForm AS QFORM
       Visible = 0
       CAPTION = "Days"
       Width = 216
       Height = 224
       Center
       BorderStyle = 1
       FormStyle = fsStayOnTop
       DelBorderIcons(biMaximize)
       DelBorderIcons(biMinimize)
       Hint = "Click background to look for a new backdrop image file."
       ShowHint = 1
       OnClose = CloseCalendar
    'CREATE Backglass AS QIMAGE
      'Autosize = 1
      'Align = alClient
      'OnClick = ImageFiles
    'END CREATE
       CREATE CDay1 AS QCOOLBTN
        CAPTION = "1"
        Left = 7
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay8 AS QCOOLBTN
        CAPTION = "8"
        Left = 7
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay15 AS QCOOLBTN
        CAPTION = "15"
        Left = 7
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay29 AS QCOOLBTN
        CAPTION = "29"
        Left = 7
        Top = 169
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay22 AS QCOOLBTN
        CAPTION = "22"
        Left = 7
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay9 AS QCOOLBTN
        CAPTION = "9"
        Left = 35
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay2 AS QCOOLBTN
        CAPTION = "2"
        Left = 35
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay16 AS QCOOLBTN
        CAPTION = "16"
        Left = 35
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay30 AS QCOOLBTN
        CAPTION = "30"
        Left = 35
        Top = 169
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay23 AS QCOOLBTN
        CAPTION = "23"
        Left = 35
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay10 AS QCOOLBTN
        CAPTION = "10"
        Left = 63
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay3 AS QCOOLBTN
        CAPTION = "3"
        Left = 63
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay17 AS QCOOLBTN
        CAPTION = "17"
        Left = 63
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay31 AS QCOOLBTN
        CAPTION = "31"
        Left = 63
        Top = 169
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay24 AS QCOOLBTN
        CAPTION = "24"
        Left = 63
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay11 AS QCOOLBTN
        CAPTION = "11"
        Left = 91
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay4 AS QCOOLBTN
        CAPTION = "4"
        Left = 91
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay18 AS QCOOLBTN
        CAPTION = "18"
        Left = 91
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay25 AS QCOOLBTN
        CAPTION = "25"
        Left = 91
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay12 AS QCOOLBTN
        CAPTION = "12"
        Left = 119
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay5 AS QCOOLBTN
        CAPTION = "5"
        Left = 119
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay19 AS QCOOLBTN
        CAPTION = "19"
        Left = 119
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay26 AS QCOOLBTN
        CAPTION = "26"
        Left = 119
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay13 AS QCOOLBTN
        CAPTION = "13"
        Left = 147
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay6 AS QCOOLBTN
        CAPTION = "6"
        Left = 147
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay20 AS QCOOLBTN
        CAPTION = "20"
        Left = 147
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay27 AS QCOOLBTN
        CAPTION = "27"
        Left = 147
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay14 AS QCOOLBTN
        CAPTION = "14"
        Left = 175
        Top = 96
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay7 AS QCOOLBTN
        CAPTION = "7"
        Left = 175
        Top = 71
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay21 AS QCOOLBTN
        CAPTION = "21"
        Left = 175
        Top = 120
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE CDay28 AS QCOOLBTN
        CAPTION = "28"
        Left = 175
        Top = 144
        Width = 27
        Flat = 1
        OnClick = DayChanged
       END CREATE
       CREATE BackdropButt AS QOVALBTN
        CAPTION = "B"
        Left = 175
        Top = 169
        Height = 25
        Width = 27
        Flat = 1
        Layout = -1
        Font = Arial8B
        Hint = "Click to change the backdrop."
        ShowHint = 1
        OnClick = CalendarColor
       END CREATE
       CREATE ColorButt AS QOVALBTN
        CAPTION = "C"
        Left = 147
        Top = 169
        Height = 25
        Width = 27
        Flat = 1
        Layout = -1
        Font = Arial8B
        Hint = "Click to change dates color."
        ShowHint = 1
        OnClick = ButtonColor
       END CREATE
       CREATE DayButt AS QOVALBTN
        Left = 147
        Top = 144
        Height = 25
        Width = 27
        COLOR = clGreen
        Flat = 1
        Layout = -1
        Hint = "Click to switch on/off blinking highlight."
        ShowHint = 1
        OnClick = Blink
       END CREATE
       CREATE MonthsPop AS QPOPUPMENU
        CREATE Jan AS QMENUITEM
         CAPTION = "January"
         OnClick = MonthChanged
        END CREATE
        CREATE Feb AS QMENUITEM
         CAPTION = "February"
         OnClick = MonthChanged
        END CREATE
        CREATE Mar AS QMENUITEM
         CAPTION = "March"
         OnClick = MonthChanged
        END CREATE
        CREATE Apr AS QMENUITEM
         CAPTION = "April"
         OnClick = MonthChanged
        END CREATE
        CREATE May AS QMENUITEM
         CAPTION = "May"
         OnClick = MonthChanged
        END CREATE
        CREATE Jun AS QMENUITEM
         CAPTION = "June"
         OnClick = MonthChanged
        END CREATE
        CREATE Jul AS QMENUITEM
         CAPTION = "July"
         OnClick = MonthChanged
        END CREATE
        CREATE Aug AS QMENUITEM
         CAPTION = "August"
         OnClick = MonthChanged
        END CREATE
        CREATE Sep AS QMENUITEM
         CAPTION = "September"
         OnClick = MonthChanged
        END CREATE
        CREATE Oct AS QMENUITEM
         CAPTION = "October"
         OnClick = MonthChanged
        END CREATE
        CREATE Nov AS QMENUITEM
         CAPTION = "November"
         OnClick = MonthChanged
        END CREATE
        CREATE Dece AS QMENUITEM
         CAPTION = "December"
         OnClick = MonthChanged
        END CREATE
       END CREATE
       CREATE MoYe AS QPANEL
        Left = 6
        Top = 4
        Width = 197
        Height = 34
        BevelInner = 1
        BorderStyle = 0
        CREATE CMonth AS QPANEL
         Top = 5
         Left = 4
         Height = 24
         Width = 95
         COLOR = &H00FF00
         Font = Arial9B
         BevelOuter = bvNone
         BevelInner = bvLowered
         Alignment = taLeft
         Hint = "Click then select month of choice."
         ShowHint = 1
         OnClick = PopMonths
        END CREATE
      'CREATE Increase AS QCOOLBTN
      '  Top = 5
      '  Left = 100
      '  Width = 26
      '  Height = 12
      '  Flat = 1
      '  Font = Arial9B
      '  Caption = ">"
      '  Hint = "Go up one year."
      '  ShowHint = 1
      '  OnClick = UpdownYear
      'END CREATE
      'CREATE Decrease AS QCOOLBTN
      '  Top = 17
      '  Left = 100
      '  Width = 26
      '  Height = 12
      '  Flat = 1
      '  Font = Arial9B
      '  Caption = "<"
      '  Hint = "Go down one year."
      '  ShowHint = 1
      '  OnClick = UpdownYear
      'END CREATE
        CREATE UpDownYr AS QSCROLLBAR
         Kind = 0
         Top = 5
         Left = 101
         Width = 24
         Height = 24
         Hint = "Click left or right to change years."
         ShowHint = 1
         Min = 0
         Max = 65000
         Position = VAL(Year.Text)
         OnChange = UpDownYear
        END CREATE
        CREATE CYear AS QEDIT
         Top = 5
         Left = 126
         Height = 24
         Width = 66
         Autosize = 0
         COLOR = &H00FF00
         Font = Arial9B
         Hint = "Click then type in new year."
         ShowHint = 1
         OnKeyPress = YearChanged
        END CREATE
       END CREATE
       CREATE One AS QPANEL
        Left = 7
        Top = 42
        CAPTION = "Sun"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
       CREATE Two AS QPANEL
        Left = 35
        Top = 42
        CAPTION = "Mon"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
       CREATE Three AS QPANEL
        Left = 63
        Top = 42
        CAPTION = "Tue"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
       CREATE Four AS QPANEL
        Left = 91
        Top = 42
        CAPTION = "Wed"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
       CREATE Five AS QPANEL
        Left = 119
        Top = 42
        CAPTION = "Thu"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
       CREATE Six AS QPANEL
        Left = 147
        Top = 42
        CAPTION = "Fri"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
       CREATE Seven AS QPANEL
        Left = 175
        Top = 42
        CAPTION = "Sat"
        Width = 27
        Height = 25
        BevelOuter = 1
        Hint = "Click to show today's date"
        Showhint = 1
        OnClick = Today
       END CREATE
      END CREATE
     END CREATE

     SUB Initialize
      RANDOMIZE
      IF FILEEXISTS("days.ini") <> 0 THEN
       DIM File AS QFILESTREAM
       File.OPEN("days.ini",fmOpenReadWrite)
       inifile = File.ReadStr(File.Size)
       File.CLOSE
      END IF
      colorcount = VAL(LEFT$(inifile,1))
      always = VAL(MID$(inifile,2,1))
      soundoff = VAL(MID$(inifile,3,1))
      blinking = VAL(MID$(inifile,4,1))
      ccolorcount = VAL(MID$(inifile,5,1))
      buttcolor = VAL(MID$(inifile,6,1))
      whereC = INSTR(7,inifile,CHR$(13))
      DayButt.COLOR = VAL(MID$(inifile,7,(whereC-1)-6))
      where0 = INSTR(inifile,"0 =")
      where0E = INSTR(where0,inifile,CHR$(13))
      image0 = MID$(inifile,where0+3,(where0E-1)-(where0+2))
      where1 = INSTR(inifile,"1 =")
      where1E = INSTR(where1,inifile,CHR$(13))
      image1 = MID$(inifile,where1+3,(where1E-1)-(where1+2))
      where2 = INSTR(inifile,"2 =")
      where2E = INSTR(where2,inifile,CHR$(13))
      image2 = MID$(inifile,where2+3,(where2E-1)-(where2+2))
      where3 = INSTR(inifile,"3 =")
      where3E = INSTR(where3,inifile,CHR$(13))
      image3 = MID$(inifile,where3+3,(where3E-1)-(where3+2))
      where4 = INSTR(inifile,"4 =")
      where4E = INSTR(where4,inifile,CHR$(13))
      image4 = MID$(inifile,where4+3,(where4E-1)-(where4+2))
      where5 = INSTR(inifile,"5 =")
      where5E = INSTR(where5,inifile,CHR$(13))
      image5 = MID$(inifile,where5+3,(where5E-1)-(where5+2))
      IF RTRIM$(image0) = "" THEN image0 = "00.bmp"
      IF RTRIM$(image1) = "" THEN image1 = "10.bmp"
      IF RTRIM$(image2) = "" THEN image2 = "20.bmp"
      IF RTRIM$(image3) = "" THEN image3 = "30.bmp"
      IF RTRIM$(image4) = "" THEN image4 = "40.bmp"
      IF RTRIM$(image5) = "" THEN image5 = "50.bmp"
      IF soundoff = 0 THEN PLAYWAV(clocktow,1)
  'Application.IcoHandle = DaysIco
      Application.HintShortPause = 25
      Application.HintPause = 25
      Application.HintHidePause = 12000
      PanelColors
      ButtonColor
      CalendarColor
      juston = 1
  'DayTodayLt
      New_Date(13)
      dayname$ = "(" + wday$ - "!" + ")"
      thedate$ = month$ + " " + STR$(fday) + ", " + STR$(fyear) + " " + dayname$ + " "
      Time
     END SUB

     SUB Time
      DEFINT milhour, hour, min
      hour =  VAL(LEFT$(TIME$,2))
      min = VAL(MID$(TIME$,4,2))
      milhour = hour
      IF hour >= 12 AND hour < 24 THEN
       hour = hour - 12
       IF hour = 0 THEN hour = 12
       ampm$ = " PM"
      ELSEIF hour = 0 THEN
       hour = 12
       ampm$ = " AM"
      ELSE
       ampm$ = " AM"
      END IF
      IF min < 10 THEN
       IF military = 1 THEN
        DaysDates.CAPTION = thedate$ + STR$(milhour) + ":0" + STR$(min) + RIGHT$(TIME$,3)
       ELSE
        thetime$ = STR$(hour) + ":0" + STR$(min) + RIGHT$(TIME$,3) + ampm$
        spaceCap$ = SPACE$((64 - LEN("Days" + thedate$ + thetime$))*.875)
        DaysDates.CAPTION = "Days" + spaceCap$ + thedate$ + thetime$
       END IF
      ELSE
       IF military = 1 THEN
        DaysDates.CAPTION = thedate$ + TIME$
       ELSE
        thetime$ = STR$(hour) + ":" + STR$(min) + RIGHT$(TIME$,3) + ampm$
        spaceCap$ = SPACE$((64 - LEN("Days" + thedate$ + thetime$))*.875)
        DaysDates.CAPTION = "Days" + spaceCap$ + thedate$ + thetime$
       END IF
      END IF
     END SUB

     SUB preNew_Date
      New_Date(13)
     END SUB

     SUB New_Date(key AS BYTE)
      IF key <> 13 THEN EXIT SUB
      IF soundoff = 0 THEN PLAYWAV(whoosh,1)
      byear = VAL(REPLACESUBSTR$(Year.Text,",",""))
      GetMonth(Month.Text)
      bmonth = monthchecked
      bday = VAL(Day.Text)
      dayshence = VAL(REPLACESUBSTR$(DayHence.Text,",",""))
      daysthence = VAL(REPLACESUBSTR$(DayThence.Text,",",""))
      IF daysthence = 0 THEN
       eday = bday
       eyear = byear
       emonth = bmonth
       SELECT CASE emonth
       CASE 1,3,5,7,8,10,12
        monthdays = 31
       CASE 4,6,9,11
        monthdays = 30
       CASE 2
        IF eyear MOD 4 = 0 THEN
         leapday = 1
         IF eyear MOD 100 = 0 AND eyear MOD 400 <> 0 THEN leapday = 0
        ELSE
         leapday = 0
        END IF
        monthdays = 28 + leapday
       END SELECT
       totdays = eday + dayshence
       IF monthdays >= totdays THEN
        fday = totdays
       ELSE
        neweday = monthdays
        DO
         INC emonth
         IF emonth = 13 THEN
          emonth = 1
          INC eyear
         END IF
         SELECT CASE emonth
         CASE 1,3,5,7,8,10,12
          monthdays = 31
         CASE 4,6,9,11
          monthdays = 30
         CASE 2
          IF eyear MOD 4 = 0 THEN
           leapday = 1
           IF eyear MOD 100 = 0 AND eyear MOD 400 <> 0 THEN leapday = 0
          ELSE
           leapday = 0
          END IF
          monthdays = 28 + leapday
         END SELECT
         neweday = neweday + monthdays
        LOOP UNTIL neweday > totdays
        DEC neweday,monthdays
        fday = totdays - neweday
       END IF
       fmonth = emonth
       fyear = eyear
      ELSE
       pday = bday
       pyear = byear
       pmonth = bmonth
       IF daysthence < pday THEN
        fday = pday - daysthence
       ELSE
        monthdays = 0
        newpday = pday
        DO
         DEC pmonth
         IF pmonth = 0 THEN
          pmonth = 12
          DEC pyear
         END IF
         SELECT CASE pmonth
         CASE 1,3,5,7,8,10,12
          monthdays = 31
         CASE 4,6,9,11
          monthdays = 30
         CASE 2
          IF pyear MOD 4 = 0 THEN
           leapday = 1
           IF pyear MOD 100 = 0 AND pyear MOD 400 <> 0 THEN leapday = 0
          ELSE
           leapday = 0
          END IF
          monthdays = 28 + leapday
         END SELECT
         newpday = newpday + monthdays
        LOOP UNTIL newpday > daysthence
        fday = newpday - daysthence
       END IF
       fmonth = pmonth
       fyear = pyear
      END IF
      IF fday = 0 THEN
       SELECT CASE fmonth
       CASE 5,7,8,10,12
        fday = 30
        DEC fmonth
       CASE 1
        fday = 31
        fmonth = 12
       CASE 2,4,6,9,11
        fday = 31
        DEC fmonth
       CASE 3
        fmonth = 2
        fday = 28
        IF fyear MOD 4 = 0 THEN
         fday = 29
         IF fyear MOD 100 = 0 AND fyear MOD 400 <> 0 THEN fday = 28
        END IF
       END SELECT
      END IF
      SELECT CASE fmonth
      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 fyear = 0 THEN
       fyear = 1
       DatePanel.CAPTION = STR$(fyear) + " BC"
      ELSEIF fyear < 0 THEN
       fyear = ABS(fyear) + 1
       DatePanel.CAPTION = STR$(fyear) + " BC"
      ELSE
       IF month$ = "December" AND fday = 31 THEN
        IF daysthence = 0 AND dayshence <> 0 THEN DEC fyear
       END IF
       IF thedate$ <> "" THEN DatePanel.CAPTION = month$ + " " + STR$(fday) + ", " + STR$(fyear)
       circa = 1
       DaysDifference(13)
      END IF
     END SUB

     SUB preDaysDifference
      DaysDifference(13)
     END SUB

     SUB DaysDifference(key AS BYTE)
      IF key <> 13 THEN EXIT SUB
      IF circa = 0 THEN
       IF soundoff = 0 THEN PLAYWAV(whoosh,1)
       GetMonth(Month2.text)
       monthnow = monthchecked
       daynow = VAL(Day2.text)
       yearnow = VAL(Year2.text)
       GetMonth(Month1.text)
       monththen = monthchecked
       daythen = VAL(Day1.text)
       yearthen = VAL(Year1.text)
      ELSEIF circa = 1 THEN
       monthnow = fmonth
       yearnow = fyear
       daynow = fday
       monththen = 1
       yearthen = 1900 'arbitrary but don't change; day-of-week algorithm uses it
       daythen = 1
      END IF
      IF yearnow < yearthen THEN
       SWAP(yearnow,yearthen)
       SWAP(monthnow,monththen)
       SWAP(daynow,daythen)
      END IF
      AOyears = yearnow - yearthen
      betyears = AOyears - 1
      IF AOyears = 0 THEN
       IF monthnow = monththen THEN
        diffdays = daynow - daythen
       ELSE
        IF yearthen MOD 4 = 0 THEN
         leapthen = 1
         IF yearthen MOD 100 = 0 AND yearthen MOD 400 <> 0 THEN leapthen = 0
        ELSE
         leapthen = 0
        END IF
        IF yearnow MOD 4 = 0 THEN
         leapnow = 1
         IF yearnow MOD 100 = 0 AND yearnow MOD 400 <> 0 THEN leapnow = 0
        ELSE
         leapnow = 0
        END IF
        SELECT CASE monththen
        CASE 1
         Adays = daythen
        CASE 2
         Adays = 31 + daythen
        CASE 3
         Adays = 59 + daythen + leapthen
        CASE 4
         Adays = 90 + daythen + leapthen
        CASE 5
         Adays = 120 + daythen + leapthen
        CASE 6
         Adays = 151 + daythen + leapthen
        CASE 7
         Adays = 181 + daythen + leapthen
        CASE 8
         Adays = 212 + daythen + leapthen
        CASE 9
         Adays = 243 + daythen + leapthen
        CASE 10
         Adays = 273 + daythen + leapthen
        CASE 11
         Adays = 304 + daythen + leapthen
        CASE 12
         Adays = 334 + daythen + leapthen
        END SELECT
        diffdays = GetOdays - Adays
       END IF
      ELSEIF AOyears = 1 THEN
       diffdays = GetAOdays
      ELSE
       betleaps = 0 'betyears \ 4
       trialyear = yearthen + 1
       DO
        IF trialyear MOD 4 = 0 THEN
         INC betleaps
         IF trialyear MOD 100 = 0 AND trialyear MOD 400 <> 0 THEN DEC betleaps
        END IF
        INC trialyear
       LOOP UNTIL trialyear = yearnow
       diffdays = (betyears*365) + GetAOdays + betleaps
    'showmessage(str$((betyears*365)) + " " + str$(GetAOdays) +" " + str$(betleaps))
      END IF
      IF circa = 1 THEN
       circa = 0
       IF fday = 0 OR fmonth = 0 OR fyear = 0 THEN
        todate = 8
       ELSE
        todate = diffdays MOD 7
       END IF
       IF fyear < VAL(RIGHT$(DATE$,4)) THEN
        past = 1
       ELSEIF fyear = VAL(RIGHT$(DATE$,4)) THEN
        IF fmonth < VAL(LEFT$(DATE$,2)) THEN
         past = 1
        ELSEIF fmonth = VAL(LEFT$(DATE$,2)) THEN
         IF fday < VAL(MID$(DATE$,4,2)) THEN past = 1
        END IF
       END IF
       SELECT CASE todate
       CASE 0
        wday$ = "Monday!"
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Monday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Monday!"
        END IF
       CASE 1
        IF fyear < 1900 THEN
         wday$ = "Sunday!"
        ELSE
         wday$ = "Tuesday!"
        END IF
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a " + wday$
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a " + wday$
        END IF
       CASE 2
        IF fyear < 1900 THEN
         wday$ = "Saturday!"
        ELSE
         wday$ = "Wednesday!"
        END IF
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a " + wday$
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a " + wday$
        END IF
       CASE 3
        IF fyear < 1900 THEN
         wday$ = "Friday!"
        ELSE
         wday$ = "Thursday!"
        END IF
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a " + wday$
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a " + wday$
        END IF
       CASE 4
        IF fyear < 1900 THEN
         wday$ = "Thursday!"
        ELSE
         wday$ = "Friday!"
        END IF
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a " + wday$
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a " + wday$
        END IF
       CASE 5
        IF fyear < 1900 THEN
         wday$ = "Wednesday!"
        ELSE
         wday$ = "Saturday!"
        END IF
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a " + wday$
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a " + wday$
        END IF
       CASE 6
        IF fyear < 1900 THEN
         wday$ = "Tuesday!"
        ELSE
         wday$ = "Sunday!"
        END IF
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a " + wday$
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a " + wday$
        END IF
       CASE ELSE
        weekday$ = "Error. Check date entry."
       END SELECT
       IF thedate$ <> "" THEN WeekDayPanel.CAPTION = weekday$
      ELSE
       IF ABS(diffdays) = 1 THEN
        days$ = " day"
       ELSE
        days$ = " days"
       END IF
       DaysPanel.CAPTION = FORMAT$("%.0n",diffdays) + days$
       diffdays = ABS(diffdays)
       remaindays = diffdays MOD 7
       IF remaindays = 1 THEN
        remaindays$ = " " + STR$(remaindays) + " day)"
       ELSEIF remaindays > 1 THEN
        remaindays$ = " " + STR$(remaindays) + " days)"
       ELSEIF remaindays = 0 THEN
        remaindays$ = ")"
       ELSE
        diffdays = 0
        remaindays$ = ")"
       END IF
       IF ABS(diffdays\7) = 1 THEN
        weeks$ = " week"
       ELSE
        weeks$ = " weeks"
       END IF
       WeeksPanel.CAPTION = "(" + STR$(diffdays\7) + weeks$ + remaindays$
       PreWeeksPanel$ = WeeksPanel.CAPTION
      END IF
     END SUB

     FUNCTION GetAOdays
      IF yearthen MOD 4 = 0 THEN
       leapthen = 1
       IF yearthen MOD 100 = 0 AND yearthen MOD 400 <> 0 THEN leapthen = 0
      ELSE
       leapthen = 0
      END IF
      SELECT CASE monththen
      CASE 1
       Adays = 365 - daythen + leapthen
      CASE 2
       Adays = 334 - daythen + leapthen
      CASE 3
       Adays = 306 - daythen
      CASE 4
       Adays = 275 - daythen
      CASE 5
       Adays = 245 - daythen
      CASE 6
       Adays = 214 - daythen
      CASE 7
       Adays = 184 - daythen
      CASE 8
       Adays = 153 - daythen
      CASE 9
       Adays = 122 - daythen
      CASE 10
       Adays = 92 - daythen
      CASE 11
       Adays = 61 - daythen
      CASE 12
       Adays = 31 - daythen
      END SELECT
      GetAOdays = Adays + GetOdays
     END FUNCTION

     FUNCTION GetOdays
      IF yearnow MOD 4 = 0 THEN
       leapnow = 1
       IF yearnow MOD 100 = 0 AND yearnow MOD 400 <> 0 THEN leapnow = 0
      ELSE
       leapnow = 0
      END IF
      SELECT CASE monthnow
      CASE 1
       Odays = daynow
      CASE 2
       Odays = 31 + daynow
      CASE 3
       Odays = 59 + daynow + leapnow
      CASE 4
       Odays = 90 + daynow + leapnow
      CASE 5
       Odays = 120 + daynow + leapnow
      CASE 6
       Odays = 151 + daynow + leapnow
      CASE 7
       Odays = 181 + daynow + leapnow
      CASE 8
       Odays = 212 + daynow + leapnow
      CASE 9
       Odays = 243 + daynow + leapnow
      CASE 10
       Odays = 273 + daynow + leapnow
      CASE 11
       Odays = 304 + daynow + leapnow
      CASE 12
       Odays = 334 + daynow + leapnow
      END SELECT
      RESULT = Odays
     END FUNCTION

     SUB GetMonth
      validmonth = VAL(monthtocheck)
      IF validmonth > 12 THEN monthtocheck = STR$(validmonth MOD 12)
      SELECT CASE LCASE$(monthtocheck)
      CASE "1","01","jan","jan.","january"
       monthchecked = 1
      CASE "2","02","feb","feb.","february"
       monthchecked = 2
      CASE "3","03","mar","mar.","march"
       monthchecked = 3
      CASE "4","04","apr","apr.","april"
       monthchecked = 4
      CASE "5","05","may.","may"
       monthchecked = 5
      CASE "6","06","jun","jun.","june"
       monthchecked = 6
      CASE "7","07","jul","jul.","july"
       monthchecked = 7
      CASE "8","08","aug","aug.","august"
       monthchecked = 8
      CASE "9","09","sep","sep.","sept","sept.","september"
       monthchecked = 9
      CASE "10","oct","oct.","october"
       monthchecked = 10
      CASE "11","nov","nov.","november"
       monthchecked = 11
      CASE "12","dec","dec.","december"
       monthchecked = 12
      END SELECT
     END SUB

     SUB TopMost
      IF always = 0 THEN
       always = 1
      ELSEIF always = 1 THEN
       always = 0
      END IF
     END SUB

     SUB ShowNotes
      IF soundoff = 0 THEN PLAYWAV(cuckoo,1)
      Timer2.Enabled = 1
      Animate(NoteProductForm.Handle)
      NoteProductForm.Visible = 1
     END SUB

     SUB NotesShow
      DEFSHORT y
      DXNotes.FillRect(0,0,84,63,0)
      INC y
      IF y > 84 THEN y = 1
      IF y < 11 THEN b$ = RIGHT$("wasaywasay",y)
      IF y < 8 THEN a$ = RIGHT$(".com.ph",y)
      DXNotes.TextOut(y,y+2,a$,clGreen,clBlack)
      DXNotes.TextOut(y+2,2,b$,clWhite,clBlack)
      DXNotes.TextOut(1,y+16,"@i-manila",&HDDCE,clBlack)
     END SUB

     SUB SendMe
      IF soundoff = 0 THEN PLAYWAV(camera,1)
      dummy = SHELL ("start http://pages.zdnet.com/wasaywasay/wasaywasay", SW_HIDE)
      IF dummy = 0 THEN
       dummy = SHELL ("start http://pages.zdnet.com/wasaywasay/wasaywasay", SW_HIDE)
       IF dummy = 0 THEN
        SHOWMESSAGE "Can't find your Start program. \nPlease go to http://pages.zdnet.com/wasaywasay/wasaywasay manually."
       END IF
      END IF
     END SUB

     SUB EMailMe
      IF soundoff = 0 THEN PLAYWAV(camera,1)
      dummy = SHELL("c:\windows\command\Start mailto:wasaywasay@i-manila.com.ph?Subject=Attention_Days_croaks",0)
      IF dummy = 0 THEN
       dummy = SHELL("Start mailto:wasaywasay@i-manila.com.ph?Subject=Attention_Days_croaks",0)
       IF dummy = 0 THEN
        SHOWMESSAGE "Can't find your Start program. Please do manual email instead."
       END IF
      END IF
     END SUB

     SUB TransDaysLeft
  'DayThence.Text = STR$(diffdays) - diffdays has an intermediate value
      DayThence.Text = LEFT$(DaysPanel.CAPTION,INSTR(DaysPanel.CAPTION," ")-1)
      Clipboard.Text = DayThence.Text
     END SUB

     SUB TransDaysRight
  'DayHence.Text = STR$(diffdays) - diffdays has an intermediate value
      DayHence.Text = LEFT$(DaysPanel.CAPTION,INSTR(DaysPanel.CAPTION," ")-1)
     END  SUB

     SUB TransDateUp
      Day1.Text = STR$(fday)
      Month1.Text = STR$(fmonth)
      Year1.Text = STR$(fyear)
     END SUB

     SUB TransDateDn
      Day2.Text = STR$(fday)
      Month2.Text = STR$(fmonth)
      Year2.Text = STR$(fyear)
      Clipboard.Text = DatePanel.CAPTION
     END SUB

     SUB DayTodayLt
      Day.Text = MID$(DATE$,4,2)
      Month.Text = LEFT$(DATE$,2)
      Year.Text = RIGHT$(DATE$,4)
     END SUB

'SUB DayTodayRt
'  Day1.Text = MID$(DATE$,4,2)
'  Month1.Text = LEFT$(DATE$,2)
'  Year1.Text = RIGHT$(DATE$,4)
'END SUB

     SUB YearsMonths
      totweeks = INT(diffdays/7)
      inttotyears = (diffdays - 366*betleaps)/365 + 366*betleaps/366
      totyears = FIX(inttotyears)
      totmonths = 12*FIX(inttotyears) + CEIL(12*FRAC(inttotyears))
      INC countyrsmos
      IF countyrsmos = 5 THEN countyrsmos = 1
      SELECT CASE countyrsmos
      CASE 1
       yrsmos$ = STR$(totmonths)
       unit$ = " months"
      CASE 2
       yrsmos$ = STR$(totyears)
       unit$ = " years"
      CASE 3
       yrsmos$ = STR$(totweeks)
       unit$ = " weeks"
      END SELECT
      IF countyrsmos = 4 THEN
       WeeksPanel.CAPTION = PreWeeksPanel$
      ELSE
       IF VAL(yrsmos$) <= 1 THEN unit$ = unit$ - "s"
       WeeksPanel.CAPTION = "(" + yrsmos$ + unit$ + ")"
      END IF
     END SUB

     SUB CloseNoteProductForm
      Deanimate(NoteProductForm.Handle)
      NoteProductForm.Visible = 0
     END SUB

     SUB Nights
      DIM File AS QFILESTREAM
      IF soundoff = 0 THEN PLAYWAV(gong,1)
      IF iDir = "" THEN
       where$ = "days.ini"
      ELSE
       where$ = iDir + "\\" + "days.ini"
      END IF
      File.OPEN(where$,fmCreate)
      inifile = STR$(colorcount) + STR$(always) + STR$(soundoff)_
       + STR$(blinking) + STR$(ccolorcount) + STR$(buttcolor)_
       + STR$(DayButt.COLOR) + CHR$(13)_
       + "0 =" + image0 + CHR$(13)_
       + "1 =" + image1 + CHR$(13)_
       + "2 =" + image2 + CHR$(13)_
       + "3 =" + image3 + CHR$(13)_
       + "4 =" + image4 + CHR$(13)_
       + "5 =" + image5 + CHR$(13)
      File.WriteStr(inifile,LEN(inifile))
      File.CLOSE
     END SUB

     SUB Noisemaker
      IF soundoff = 0 THEN
       Noise.Hint = "Click to turn on sound effects."
       soundoff = 1
      ELSE
       PLAYWAV(handbell,1)
       Noise.Hint = "Click to turn off sound effects."
       soundoff = 0
      END IF
     END SUB

     SUB MonthChanged(Sender AS QMENUITEM)
      Month.Text = Sender.CAPTION
      New_Date(13)
      Calendar
     END SUB

     SUB YearChanged(key AS BYTE)
      IF key <> 13 THEN EXIT SUB
      Year.Text = CYear.Text
      DayThence.Text = "0"
      DayHence.Text = "0"
      New_Date(13)
      UpDownYr.Position = fyear
      Calendar
     END SUB

     SUB DayChanged(Sender AS QCOOLBTN)
      Day.Text = Sender.CAPTION
      Daythence.Text = ""
      Dayhence.Text = ""
      New_Date(13)
      Calendar
     END SUB

     SUB Calendar
      CalendarForm.Visible = 1
      IF soundoff = 0 THEN PLAYWAV(handbell,1)
      CYear.Text = STR$(fyear)
      CMonth.CAPTION = month$
      One.COLOR = -2147483633
      Two.COLOR = -2147483633
      Three.COLOR = -2147483633
      Four.COLOR = -2147483633
      Five.COLOR = -2147483633
      Six.COLOR = -2147483633
      Seven.COLOR = -2147483633
      CDay1.Visible = 1
      CDay2.Visible = 1
      CDay3.Visible = 1
      CDay4.Visible = 1
      CDay5.Visible = 1
      CDay6.Visible = 1
      CDay7.Visible = 1
      CDay8.Visible = 1
      CDay9.Visible = 1
      CDay10.Visible = 1
      CDay11.Visible = 1
      CDay12.Visible = 1
      CDay13.Visible = 1
      CDay14.Visible = 1
      CDay15.Visible = 1
      CDay16.Visible = 1
      CDay17.Visible = 1
      CDay18.Visible = 1
      CDay19.Visible = 1
      CDay20.Visible = 1
      CDay21.Visible = 1
      CDay22.Visible = 1
      CDay23.Visible = 1
      CDay24.Visible = 1
      CDay25.Visible = 1
      CDay26.Visible = 1
      CDay27.Visible = 1
      CDay28.Visible = 1
      SELECT CASE fmonth
      CASE 1,3,5,7,8,10,12
       CDay29.Visible = 1
       CDay30.Visible = 1
       CDay31.Visible = 1
      CASE 4,6,9,11
       CDay29.Visible = 1
       CDay30.Visible = 1
       CDay31.Visible = 0
      CASE 2
       IF leapthen = 1 OR leapnow = 1 THEN
        CDay29.Visible = 1
       ELSE
        CDay29.Visible = 0
       END IF
       CDay30.Visible = 0
       CDay31.Visible = 0
      END SELECT
      SELECT CASE fday
      CASE 1,8,15,22,29
       One.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Sun"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       CASE "Monday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       CASE "Tuesday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       CASE "Wednesday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       CASE "Thursday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       CASE "Friday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       CASE "Saturday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       END SELECT
      CASE 2,9,16,23,30
       Two.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       CASE "Monday!"
        One.CAPTION = "Sun"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       CASE "Tuesday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       CASE "Wednesday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       CASE "Thursday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       CASE "Friday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       CASE "Saturday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       END SELECT
      CASE 3,10,17,24,31
       Three.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       CASE "Monday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       CASE "Tuesday!"
        One.CAPTION = "Sun"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       CASE "Wednesday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       CASE "Thursday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       CASE "Friday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       CASE "Saturday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       END SELECT
      CASE 4,11,18,25
       Four.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       CASE "Monday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       CASE "Tuesday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       CASE "Wednesday!"
        One.CAPTION = "Sun"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       CASE "Thursday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       CASE "Friday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       CASE "Saturday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       END SELECT
      CASE 5,12,19,26
       Five.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       CASE "Monday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       CASE "Tuesday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       CASE "Wednesday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       CASE "Thursday!"
        One.CAPTION = "Sun"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       CASE "Friday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       CASE "Saturday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       END SELECT
      CASE 6,13,20,27
       Six.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       CASE "Monday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       CASE "Tuesday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       CASE "Wednesday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       CASE "Thursday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       CASE "Friday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       CASE "Saturday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       END SELECT
      CASE 7,14,21,28
       Seven.COLOR = &HEEFAFA
       SELECT CASE wday$
       CASE "Sunday!"
        One.CAPTION = "Mon"
        Two.CAPTION = "Tue"
        Three.CAPTION = "Wed"
        Four.CAPTION = "Thu"
        Five.CAPTION = "Fri"
        Six.CAPTION = "Sat"
        Seven.CAPTION = "Sun"
       CASE "Monday!"
        One.CAPTION = "Tue"
        Two.CAPTION = "Wed"
        Three.CAPTION = "Thu"
        Four.CAPTION = "Fri"
        Five.CAPTION = "Sat"
        Six.CAPTION = "Sun"
        Seven.CAPTION = "Mon"
       CASE "Tuesday!"
        One.CAPTION = "Wed"
        Two.CAPTION = "Thu"
        Three.CAPTION = "Fri"
        Four.CAPTION = "Sat"
        Five.CAPTION = "Sun"
        Six.CAPTION = "Mon"
        Seven.CAPTION = "Tue"
       CASE "Wednesday!"
        One.CAPTION = "Thu"
        Two.CAPTION = "Fri"
        Three.CAPTION = "Sat"
        Four.CAPTION = "Sun"
        Five.CAPTION = "Mon"
        Six.CAPTION = "Tue"
        Seven.CAPTION = "Wed"
       CASE "Thursday!"
        One.CAPTION = "Fri"
        Two.CAPTION = "Sat"
        Three.CAPTION = "Sun"
        Four.CAPTION = "Mon"
        Five.CAPTION = "Tue"
        Six.CAPTION = "Wed"
        Seven.CAPTION = "Thu"
       CASE "Friday!"
        One.CAPTION = "Sat"
        Two.CAPTION = "Sun"
        Three.CAPTION = "Mon"
        Four.CAPTION = "Tue"
        Five.CAPTION = "Wed"
        Six.CAPTION = "Thu"
        Seven.CAPTION = "Fri"
       CASE "Saturday!"
        One.CAPTION = "Sun"
        Two.CAPTION = "Mon"
        Three.CAPTION = "Tue"
        Four.CAPTION = "Wed"
        Five.CAPTION = "Thu"
        Six.CAPTION = "Fri"
        Seven.CAPTION = "Sat"
       END SELECT
      END SELECT
      SELECT CASE fday
      CASE 1
       CDay1.Visible = 0
       DayButt.Top = CDay1.Top
       DayButt.Left = CDay1.Left
      CASE 2
       CDay2.Visible = 0
       DayButt.Top = CDay2.Top
       DayButt.Left = CDay2.Left
      CASE 3
       CDay3.Visible = 0
       DayButt.Top = CDay3.Top
       DayButt.Left = CDay3.Left
      CASE 4
       CDay4.Visible = 0
       DayButt.Top = CDay4.Top
       DayButt.Left = CDay4.Left
      CASE 5
       CDay5.Visible = 0
       DayButt.Top = CDay5.Top
       DayButt.Left = CDay5.Left
      CASE 6
       CDay6.Visible = 0
       DayButt.Top = CDay6.Top
       DayButt.Left = CDay6.Left
      CASE 7
       CDay7.Visible = 0
       DayButt.Top = CDay7.Top
       DayButt.Left = CDay7.Left
      CASE 8
       CDay8.Visible = 0
       DayButt.Top = CDay8.Top
       DayButt.Left = CDay8.Left
      CASE 9
       CDay9.Visible = 0
       DayButt.Top = CDay9.Top
       DayButt.Left = CDay9.Left
      CASE 10
       CDay10.Visible = 0
       DayButt.Top = CDay10.Top
       DayButt.Left = CDay10.Left
      CASE 11
       CDay11.Visible = 0
       DayButt.Top = CDay11.Top
       DayButt.Left = CDay11.Left
      CASE 12
       CDay12.Visible = 0
       DayButt.Top = CDay12.Top
       DayButt.Left = CDay12.Left
      CASE 13
       CDay13.Visible = 0
       DayButt.Top = CDay13.Top
       DayButt.Left = CDay13.Left
      CASE 14
       CDay14.Visible = 0
       DayButt.Top = CDay14.Top
       DayButt.Left = CDay14.Left
      CASE 15
       CDay15.Visible = 0
       DayButt.Top = CDay15.Top
       DayButt.Left = CDay15.Left
      CASE 16
       CDay16.Visible = 0
       DayButt.Top = CDay16.Top
       DayButt.Left = CDay16.Left
      CASE 17
       CDay17.Visible = 0
       DayButt.Top = CDay17.Top
       DayButt.Left = CDay17.Left
      CASE 18
       CDay18.Visible = 0
       DayButt.Top = CDay18.Top
       DayButt.Left = CDay18.Left
      CASE 19
       CDay19.Visible = 0
       DayButt.Top = CDay19.Top
       DayButt.Left = CDay19.Left
      CASE 20
       CDay20.Visible = 0
       DayButt.Top = CDay20.Top
       DayButt.Left = CDay20.Left
      CASE 21
       CDay21.Visible = 0
       DayButt.Top = CDay21.Top
       DayButt.Left = CDay21.Left
      CASE 22
       CDay22.Visible = 0
       DayButt.Top = CDay22.Top
       DayButt.Left = CDay22.Left
      CASE 23
       CDay23.Visible = 0
       DayButt.Top = CDay23.Top
       DayButt.Left = CDay23.Left
      CASE 24
       CDay24.Visible = 0
       DayButt.Top = CDay24.Top
       DayButt.Left = CDay24.Left
      CASE 25
       CDay25.Visible = 0
       DayButt.Top = CDay25.Top
       DayButt.Left = CDay25.Left
      CASE 26
       CDay26.Visible = 0
       DayButt.Top = CDay26.Top
       DayButt.Left = CDay26.Left
      CASE 27
       CDay27.Visible = 0
       DayButt.Top = CDay27.Top
       DayButt.Left = CDay27.Left
      CASE 28
       CDay28.Visible = 0
       DayButt.Top = CDay28.Top
       DayButt.Left = CDay28.Left
      CASE 29
       CDay29.Visible = 0
       DayButt.Top = CDay29.Top
       DayButt.Left = CDay29.Left
      CASE 30
       CDay30.Visible = 0
       DayButt.Top = CDay30.Top
       DayButt.Left = CDay30.Left
      CASE 31
       CDay31.Visible = 0
       DayButt.Top = CDay31.Top
       DayButt.Left = CDay31.Left
      END SELECT
      DayButt.CAPTION = STR$(fday)
     END SUB

     SUB PopMonths
      MonthsPop.PopUp(Screen.MOUSEX,Screen.MOUSEY)
     END SUB

     SUB Blink
      IF blinking = 0 THEN
       blinking = 1
      ELSE
       blinking = 0
      END IF
     END SUB

     SUB LoopColor
      IF blinking = 0 THEN DayButt.COLOR = 15661818*(1+RND*(5))
     END SUB

     SUB PanelColors
      IF DaysDates.Visible = 1 THEN INC colorcount
      IF colorcount = 6 THEN colorcount = 0
      SELECT CASE colorcount
      CASE 0
       NewDForm.COLOR = &HBCCAAA
      CASE 1
       NewDForm.COLOR =  &HEEFAFA
      CASE 2
       NewDForm.COLOR = &HCCC000
      CASE 3
       NewDForm.COLOR = &HGCCC
      CASE 4
       NewDForm.COLOR = &HA000
      CASE 5
       NewDForm.COLOR = &HEFFF '&HBB00CC
      END SELECT
      DaysDForm.COLOR = NewDForm.COLOR
     END SUB

     SUB CalendarColor
      IF juston = 1 THEN INC ccolorcount
      IF ccolorcount = 6 THEN ccolorcount = 0
      SELECT CASE ccolorcount
      CASE 0
      'Backglass.BMP = image0
      'NewDImage.BMP = image0
      'DaysDImage.BMP = image0
       CalendarForm.COLOR = &HBCCAAA
      CASE 1
      'Backglass.BMP = image1
      'NewDImage.BMP = image1
      'DaysDImage.BMP = image1
       CalendarForm.COLOR = &HEEFAFA
      CASE 2
      'Backglass.BMP = image2
      'NewDImage.BMP = image2
      'DaysDImage.BMP = image2
       CalendarForm.COLOR = &HCCC000
      CASE 3
      'Backglass.BMP = image3
      'NewDImage.BMP = image3
      'DaysDImage.BMP = image3
       CalendarForm.COLOR = &HGCCC
      CASE 4
      'Backglass.BMP = image4
      'NewDImage.BMP = image4
      'DaysDImage.BMP = image4
       CalendarForm.COLOR = &HA000
      CASE 5
      'Backglass.BMP = image5
      'NewDImage.BMP = image5
      'DaysDImage.BMP = image5
       CalendarForm.COLOR = &HBCCC '&HBB00CC
      END SELECT
      MoYe.COLOR = CalendarForm.COLOR
      NoteProductForm.COLOR = CalendarForm.COLOR
      PanelColors
     END SUB

     SUB UpdownYear
      CYear.Text = STR$(UpDownYr.Position)
      Year.Text = CYear.Text
      New_Date(13)
      Calendar
     END SUB

     SUB CloseCalendar
      IF soundoff = 0 THEN PLAYWAV(whoosh,1)
      Deanimate(CalendarForm.Handle)
      CalendarForm.Visible = 0
     END SUB

     SUB PaintForm
      PaintDesktop GetDC(DaysDates.Handle)
     END SUB

     SUB Animate(Handle AS INTEGER)
      AnimateWindow Handle, 300, AW_CENTER
      SELECT CASE Handle
      CASE NoteProductForm.Handle
       NoteProductForm.Repaint
      CASE CalendarForm.Handle
       CalendarForm.Repaint
       SetFocus(CalendarForm.Handle)
      END SELECT
     END SUB

     SUB Deanimate(Handle AS INTEGER)
      AnimateWindow Handle, 300, AW_CENTER OR AW_HIDE
     END SUB

     SUB Today
      Day.Text = MID$(DATE$,4,2)
      Month.Text = LEFT$(DATE$,2)
      Year.Text = "20" + RIGHT$(DATE$,2)
      Daythence.Text = ""
      Dayhence.Text = ""
      New_Date(13)
      UpDownYr.Position = fyear
      Calendar
     END SUB

     SUB ButtonColor
      IF CalendarForm.Visible = 1 THEN INC buttcolor
      IF buttcolor = 4 THEN buttcolor = 0
      SELECT CASE buttcolor
      CASE 0
       DayButt.Font = ArialY10
       CDay1.Font = ArialY10
       CDay2.Font = ArialY10
       CDay3.Font = ArialY10
       CDay4.Font = ArialY10
       CDay5.Font = ArialY10
       CDay6.Font = ArialY10
       CDay7.Font = ArialY10
       CDay8.Font = ArialY10
       CDay9.Font = ArialY10
       CDay10.Font = ArialY10
       CDay11.Font = ArialY10
       CDay12.Font = ArialY10
       CDay13.Font = ArialY10
       CDay14.Font = ArialY10
       CDay15.Font = ArialY10
       CDay16.Font = ArialY10
       CDay17.Font = ArialY10
       CDay18.Font = ArialY10
       CDay19.Font = ArialY10
       CDay20.Font = ArialY10
       CDay21.Font = ArialY10
       CDay22.Font = ArialY10
       CDay23.Font = ArialY10
       CDay24.Font = ArialY10
       CDay25.Font = ArialY10
       CDay26.Font = ArialY10
       CDay27.Font = ArialY10
       CDay28.Font = ArialY10
       CDay29.Font = ArialY10
       CDay30.Font = ArialY10
       CDay31.Font = ArialY10
      CASE 1
       DayButt.Font = ArialB10
       CDay1.Font = ArialB10
       CDay2.Font = ArialB10
       CDay3.Font = ArialB10
       CDay4.Font = ArialB10
       CDay5.Font = ArialB10
       CDay6.Font = ArialB10
       CDay7.Font = ArialB10
       CDay8.Font = ArialB10
       CDay9.Font = ArialB10
       CDay10.Font = ArialB10
       CDay11.Font = ArialB10
       CDay12.Font = ArialB10
       CDay13.Font = ArialB10
       CDay14.Font = ArialB10
       CDay15.Font = ArialB10
       CDay16.Font = ArialB10
       CDay17.Font = ArialB10
       CDay18.Font = ArialB10
       CDay19.Font = ArialB10
       CDay20.Font = ArialB10
       CDay21.Font = ArialB10
       CDay22.Font = ArialB10
       CDay23.Font = ArialB10
       CDay24.Font = ArialB10
       CDay25.Font = ArialB10
       CDay26.Font = ArialB10
       CDay27.Font = ArialB10
       CDay28.Font = ArialB10
       CDay29.Font = ArialB10
       CDay30.Font = ArialB10
       CDay31.Font = ArialB10
      CASE 2
       DayButt.Font = ArialG10
       CDay1.Font = ArialG10
       CDay2.Font = ArialG10
       CDay3.Font = ArialG10
       CDay4.Font = ArialG10
       CDay5.Font = ArialG10
       CDay6.Font = ArialG10
       CDay7.Font = ArialG10
       CDay8.Font = ArialG10
       CDay9.Font = ArialG10
       CDay10.Font = ArialG10
       CDay11.Font = ArialG10
       CDay12.Font = ArialG10
       CDay13.Font = ArialG10
       CDay14.Font = ArialG10
       CDay15.Font = ArialG10
       CDay16.Font = ArialG10
       CDay17.Font = ArialG10
       CDay18.Font = ArialG10
       CDay19.Font = ArialG10
       CDay20.Font = ArialG10
       CDay21.Font = ArialG10
       CDay22.Font = ArialG10
       CDay23.Font = ArialG10
       CDay24.Font = ArialG10
       CDay25.Font = ArialG10
       CDay26.Font = ArialG10
       CDay27.Font = ArialG10
       CDay28.Font = ArialG10
       CDay29.Font = ArialG10
       CDay30.Font = ArialG10
       CDay31.Font = ArialG10
      CASE 3
       DayButt.Font = ArialP10
       CDay1.Font = ArialP10
       CDay2.Font = ArialP10
       CDay3.Font = ArialP10
       CDay4.Font = ArialP10
       CDay5.Font = ArialP10
       CDay6.Font = ArialP10
       CDay7.Font = ArialP10
       CDay8.Font = ArialP10
       CDay9.Font = ArialP10
       CDay10.Font = ArialP10
       CDay11.Font = ArialP10
       CDay12.Font = ArialP10
       CDay13.Font = ArialP10
       CDay14.Font = ArialP10
       CDay15.Font = ArialP10
       CDay16.Font = ArialP10
       CDay17.Font = ArialP10
       CDay18.Font = ArialP10
       CDay19.Font = ArialP10
       CDay20.Font = ArialP10
       CDay21.Font = ArialP10
       CDay22.Font = ArialP10
       CDay23.Font = ArialP10
       CDay24.Font = ArialP10
       CDay25.Font = ArialP10
       CDay26.Font = ArialP10
       CDay27.Font = ArialP10
       CDay28.Font = ArialP10
       CDay29.Font = ArialP10
       CDay30.Font = ArialP10
       CDay31.Font = ArialP10
      END SELECT
     END SUB

     SUB ImageFiles
      CREATE NewImages AS QOPENDIALOG
       InitialDir = CURDIR$
       Filter = "Bitmap image files|*.BMP|All Files|*.*"
       FilterIndex = 1
      END CREATE
      iDir = NewImages.InitialDir
      IF NewImages.EXECUTE THEN
       SELECT CASE ccolorcount
       CASE 0
        image0 = NewImages.FileName
       CASE 1
        image1 = NewImages.FileName
       CASE 2
        image2 = NewImages.FileName
       CASE 3
        image3 = NewImages.FileName
       CASE 4
        image4 = NewImages.FileName
       CASE 5
        image5 = NewImages.FileName
       END SELECT
       DEC ccolorcount
       CalendarColor
      END IF
     END SUB

     SUB CloseDays
      IF soundoff = 0 THEN PLAYWAV(whoosh,1)
      Deanimate(DaysDates.Handle)
     END SUB

     Initialize
'IF soundoff = 0 THEN PLAYWAV(clocktow,1)
     DaysDates.SHOWMODAL
     Nights
     Application.Terminate

'DO
'  IF always = 1 THEN SetWindowPos(DaysDates.Handle, -1, 0, 0, 0, 0,SWP_NOMOVE OR SWP_NOSIZE)
'  DOEVENTS
'LOOP UNTIL DaysDates.Visible = 0
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Sun 2022-9-25  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2002-09-21 20:53:08