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

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

  
'CalendriX (prototype), a virtually perpetual calendar
'By Achilles B. Mina
'Updated: Oct. 8, 2001

'This utility is based on Days, a dates-days calculator. Days is
'downloadable from ZDNet, CNET, Tucows, RocketDownload and other freeware sites, and at my
'website at http://pages.zdnet.com/wasaywasay/wasaywasay/

'Nota bene: the algorithms below use the date format mm:dd:yyyy. Also
'since this is just an outtake from a larger program, some variables and,
'quite possibly, even a few routines are superfluous. Sorry.

'You can do as you please with this code.

     $INCLUDE "RAPIDQ.INC"
     $ESCAPECHARS ON

'$RESOURCE CalendriXIco AS "Calendrix.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"
'$RESOURCE whoosh AS "wipe.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.
     CONST HWND_TOPMOST = -1
     CONST HWND_NOTOPMOST = -2
     CONST SWP_NOSIZE = &H1
     CONST SWP_NOMOVE = &H2
     CONST SWP_NOACTIVATE = &H10
     CONST SWP_SHOWWINDOW = &H40

     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 FUNCTION Setfocus LIB "user32" ALIAS "SetFocus"(hwnd AS LONG) AS LONG
     DECLARE FUNCTION AnimateWindow LIB "user32" ALIAS "AnimateWindow"(BYVAL hwnd AS LONG, BYVAL dwTime AS LONG, BYVAL dwFlags AS LONG) AS INTEGER
     DECLARE SUB Animate(Handle AS INTEGER)
     DECLARE SUB Deanimate(Handle AS INTEGER)
     DECLARE SUB CloseCalendar
     DECLARE SUB CloseNoteProductForm
     DECLARE SUB ShowNotes
     DECLARE SUB NotesShow
     DECLARE SUB EMailMe
     DECLARE SUB SendMe
     DECLARE SUB New_Date
     DECLARE SUB DaysDifference
     DECLARE FUNCTION GetAOdays AS INTEGER
     DECLARE FUNCTION GetOdays AS INTEGER
     DECLARE SUB DayTodayLt
     DECLARE SUB Initialize
     DECLARE SUB OnTop
     DECLARE SUB Time
     DECLARE SUB Nights
     DECLARE SUB Noisemaker
     DECLARE SUB Calendar
     DECLARE SUB PopMonths
     DECLARE SUB MonthChanged(Sender AS QMENUITEM)
     DECLARE SUB YearChanged
     DECLARE SUB DayChanged(Sender AS QCOOLBTN)
     DECLARE SUB LoopColor
     DECLARE SUB UpdownYear(Sender AS QCOOLBTN)
     DECLARE SUB Blink
     DECLARE SUB CalendarColor
     DECLARE SUB ButtonColor
     DECLARE SUB Today
     DECLARE SUB Minimize
     DECLARE SUB ImageFiles

     DEFWORD monthnow, monththen, monthchecked, yearnow, yearthen, betyears
     DEFBYTE ccolorcount, buttcolor, blinking,always,soundoff,juston,colorcount,countyrsmos,leapnow, leapthen, bleap, circa, weekday, fmonth, emonth, pmonth, todate
     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

     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 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 CalendarForm AS QFORM
      CAPTION = "CalendriX"
      Width = 215
      Height = 225
      COLOR = &HEEFAFA
      BorderStyle = 1
      DelBorderIcons(biMaximize)
    'DelBorderIcons(biMinimize)
      Hint = "Click background to look for a new backdrop image file."
      ShowHint = 1
      Center
    'Show
      Visible = 0
      OnClose = CloseCalendar
      Wndproc = Minimize
    '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 ColorButt AS QOVALBTN
       CAPTION = "C"
       Left = 91
       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 ImagesButt AS QOVALBTN
       CAPTION = "B"
       Left = 119
       Top = 169
       Height = 25
       Width = 27
       Flat = 1
       Layout = -1
       Font = Arial8B
       Hint = "Click to change backdrop."
       ShowHint = 1
       OnClick = CalendarColor
      END CREATE
    'CREATE OnTopButt AS QOVALBTN
      'Caption = "A"
      'Left = 119
      'Top = 169
      'Height = 25
      'Width = 27
      'Flat = 1
      'Layout = -1
      'Hint = "Click to toggle-switch between \ntopmost and normal."
      'ShowHint = 1
      'OnClick = OnTop
    'END CREATE
      CREATE NoiseButt AS QOVALBTN
       CAPTION = "S"
       Left = 147
       Top = 169
       Height = 25
       Width = 27
       Flat = 1
       Layout = -1
       Font = Arial8B
       Hint = "Click to turn off sound effects."
       ShowHint = 1
       OnClick = NoiseMaker
      END CREATE
      CREATE NotesButt AS QOVALBTN
       CAPTION = "?"
       Left = 175
       Top = 169
       Height = 25
       Width = 27
       Flat = 1
       Layout = -1
       Font = Arial8B
       Hint = "Click to know more about CalendriX."
       ShowHint = 1
       OnClick = ShowNotes
      END CREATE
      CREATE DayButt AS QOVALBTN
       Left = 175
       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 = 100
        Width = 25
        Height = 25
        Hint = "Click left or right to change years."
        ShowHint = 1
        Min = 0
        Max = 65000
        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
        OnChange = YearChanged
       END CREATE
      END CREATE
      CREATE One AS QPANEL
       Left = 7
       Top = 42
       CAPTION = "Sun"
       Width = 27
       Height = 25
       BevelOuter = 1
       Hint = "Click here to get 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 here to get 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 here to get 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 here to get 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 here to get 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 here to get 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 here to get today's date"
       ShowHint = 1
       OnClick = Today
      END CREATE
      CREATE NoteProductForm AS QFORM
       Top = Screen.Height/2 + 25
       Left = Screen.Width/2 - 170
       Width = 340 '320
       Height = 205
       COLOR = CalendarForm.COLOR '&HCC000 '&HABC777
       DelBorderIcons(biMaximize)
       DelBorderIcons(biMinimize)
       BorderStyle = bsSingle
       FormStyle = fsStayOnTop
       CAPTION = "Notes on CalendriX"
       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 "  »  CalendriX 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 "  »  USING CalendriX 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 "  »  Theoretically, CalendriX can display
        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 "  »  Nota bene: this prototype uses the
        AddItems "      date format mm:dd:yyyy. If you have
      AddItems "      SET your date format differently,
        AddItems "      CalendriX will display the wrong
      AddItems "      the dates.
        AddItems ""
        AddItems "  »  CalendriX remembers your settings,
      AddItems "      so there's no need to reset them
        AddItems "      each time you run CalendriX.
      AddItems ""
      AddItems ""Programming
      AddItems "  »  CalendriX was written in Rapid-Q,"
      AddItems "      a 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 = "CalendriX"
        Alignment = taCenter
        Layout = -1
        LabelStyle = 1
        Hint = "Click to visit website"
        ShowHint = 1
        OnClick = SendMe
       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

     END CREATE


     SUB Initialize
      RANDOMIZE
      IF FILEEXISTS("calendrix.ini") <> 0 THEN
       DIM File AS QFILESTREAM
       File.OPEN("calendrix.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))
      buttcolor = VAL(MID$(inifile,5,1))
      ccolorcount = 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"
      ButtonColor
      CalendarColor
      IF soundoff = 0 THEN PLAYWAV(clocktow,1)
  'Application.IcoHandle = CalendriXIco
      Application.HintShortPause = 25
      Application.HintPause = 25
      Application.HintHidePause = 12000
      DayTodayLt
      New_Date
      UpDownYr.Position = fyear
      Time
      Calendar
     END SUB

     SUB OnTop
      IF soundoff = 0 THEN PLAYWAV(gong,1)
      IF always = 0 THEN
       always = 1
      ELSE
       always = 0
      END IF
     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
       thetime$ = STR$(hour) + ":0" + STR$(min) + RIGHT$(TIME$,3) + ampm$
      ELSE
       thetime$ = STR$(hour) + ":" + STR$(min) + RIGHT$(TIME$,3) + ampm$
      END IF
      CalendarForm.CAPTION = "CalendriX" + "  " + thetime$
     END SUB


     SUB New_Date
      IF soundoff = 0 THEN PLAYWAV(whoosh,1)
      byear = VAL(REPLACESUBSTR$(CYear.Text,",",""))
      fday = bday
      fyear = byear
      fmonth = bmonth
      IF fyear = 0 THEN
       fyear = 1
      ELSEIF fyear < 0 THEN
       fyear = ABS(fyear) + 1
      ELSE
       DaysDifference
      END IF
     END SUB

     SUB DaysDifference

      monthnow = fmonth
      yearnow = fyear
      daynow = fday
      monththen = 1
      yearthen = 1900 'arbitrary but don't change; day-of-week algorithm uses it
      daythen = 1

      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
      END IF

      todate = diffdays MOD 7
      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!"
      CASE 1
       IF fyear < 1900 THEN
        wday$ = "Sunday!"
       ELSE
        wday$ = "Tuesday!"
       END IF
      CASE 2
       IF fyear < 1900 THEN
        wday$ = "Saturday!"
       ELSE
        wday$ = "Wednesday!"
       END IF
      CASE 3
       IF fyear < 1900 THEN
        wday$ = "Friday!"
       ELSE
        wday$ = "Thursday!"
       END IF
      CASE 4
       IF fyear < 1900 THEN
        wday$ = "Thursday!"
       ELSE
        wday$ = "Friday!"
       END IF
      CASE 5
       IF fyear < 1900 THEN
        wday$ = "Wednesday!"
       ELSE
        wday$ = "Saturday!"
       END IF
      CASE 6
       IF fyear < 1900 THEN
        wday$ = "Tuesday!"
       ELSE
        wday$ = "Sunday!"
       END IF
      END SELECT
     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 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=About_CalendriX",0)
       IF dummy = 0 THEN
        SHOWMESSAGE "Can't find your Start program. Please do manual email instead."
       END IF
      END IF
     END SUB

     SUB DayTodayLt
      bday = VAL(MID$(DATE$,4,2))
      bmonth = VAL(LEFT$(DATE$,2))
      CYear.Text = RIGHT$(DATE$,4)
      SELECT CASE bmonth
      CASE 1
       CMonth.CAPTION = "January"
      CASE 2
       CMonth.CAPTION = "February"
      CASE 3
       CMonth.CAPTION = "March"
      CASE 4
       CMonth.CAPTION = "April"
      CASE 5
       CMonth.CAPTION = "May"
      CASE 6
       CMonth.CAPTION = "June"
      CASE 7
       CMonth.CAPTION = "July"
      CASE 8
       CMonth.CAPTION = "August"
      CASE 9
       CMonth.CAPTION = "September"
      CASE 10
       CMonth.CAPTION = "October"
      CASE 11
       CMonth.CAPTION = "November"
      CASE 12
       CMonth.CAPTION = "December"
      END SELECT
     END SUB

     SUB CloseNoteProductForm
      IF soundoff = 0 THEN PLAYWAV(whoosh,1)
      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$ = "calendrix.ini"
      ELSE
       where$ = iDir + "\\" + "calendrix.ini"
      END IF
      File.OPEN(where$,fmCreate)
      inifile = STR$(colorcount) + STR$(always) + STR$(soundoff)_
       + STR$(blinking) + STR$(buttcolor) + STR$(ccolorcount)_
       + 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
      CalendarForm.CLOSE
  'Application.Terminate
     END SUB

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

     SUB DayChanged(Sender AS QCOOLBTN)
      bday = VAL(Sender.CAPTION)
      New_Date
      Calendar
     END SUB

     SUB MonthChanged(Sender AS QMENUITEM)
      CMonth.CAPTION = Sender.CAPTION
      SELECT CASE CMonth.CAPTION
      CASE "January"
       bmonth = 1
      CASE "February"
       bmonth = 2
      CASE "March"
       bmonth = 3
      CASE "April"
       bmonth = 4
      CASE "May"
       bmonth = 5
      CASE "June"
       bmonth = 6
      CASE "July"
       bmonth = 7
      CASE "August"
       bmonth = 8
      CASE "September"
       bmonth = 9
      CASE "October"
       bmonth = 10
      CASE "November"
       bmonth = 11
      CASE "December"
       bmonth = 12
      END SELECT
      New_Date
      Calendar
     END SUB

     SUB YearChanged
      New_Date
      UpDownYr.Position = VAL(CYear.Text)
      Calendar
     END SUB

     SUB Calendar
      IF soundoff = 0 THEN PLAYWAV(handbell,1)
      CYear.Text = STR$(fyear)

      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)
  'SetFocus(DayButt.Handle)
     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 Today
      DayTodayLt
      New_Date
      Calendar
     END SUB

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

     SUB UpdownYear
      CYear.Text = STR$(UpDownYr.Position)
     END SUB

     SUB CalendarColor
      IF CalendarForm.Visible = 1 THEN INC ccolorcount
      IF ccolorcount = 6 THEN ccolorcount = 0
      SELECT CASE ccolorcount
      CASE 0
      'Backglass.BMP = image0
       CalendarForm.COLOR = &HBCCAAA
      CASE 1
      'Backglass.BMP = image1
       CalendarForm.COLOR = &HEEFAFA
      CASE 2
      'Backglass.BMP = image2
       CalendarForm.COLOR = &HCCC000
      CASE 3
      'Backglass.BMP = image3
       CalendarForm.COLOR = &HGCCC
      CASE 4
      'Backglass.BMP = image4
       CalendarForm.COLOR = &HA000
      CASE 5
      'Backglass.BMP = image5
       CalendarForm.COLOR = &HBCCC '&HBB00CC
      END SELECT
      MoYe.COLOR = CalendarForm.COLOR
      NoteProductForm.COLOR = CalendarForm.COLOR
     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 Animate(Handle AS INTEGER)
  AnimateWindow Handle, 300, AW_CENTER
  SELECT CASE Handle
    CASE NoteProductForm.Handle
      NoteProductForm.Repaint
    CASE CalendarForm.Handle
      CalendarForm.Repaint
  END SELECT
END SUB

SUB CloseCalendar
  Deanimate(CalendarForm.Handle)
END SUB

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

Initialize
CalendarForm.ShowModal

'Animate(CalendarForm.Handle)
'CalendarForm.Visible = 1
'DO
'  SetWindowPos(CalendarForm.Handle,-1,0,0,0,0,SWP_NOMOVE OR SWP_NOSIZE)
'  DOEVENTS
'LOOP UNTIL CalendarForm.Visible = 0

Nights
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Sun 2022-9-25  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2001-10-08 20:21:34