Koodit: QB: CLOCK$:n käyttö

DECLARE FUNCTION Paivaykseksi$ (paivat AS INTEGER)
DECLARE FUNCTION MJ$ (L AS INTEGER, N AS INTEGER)
DECLARE FUNCTION Paiviksi% (pvm AS STRING)

TYPE TKELLO
   paivat AS INTEGER         '1.1.1980:sta kuluneet päivät
   minuutit AS STRING * 1
   tunnit AS STRING * 1
   sadasosat AS STRING * 1
   sekunnit AS STRING * 1
END TYPE

DIM kello AS TKELLO, vara AS TKELLO

'luetaan tämänhetkinen aika ja pistetään se talteen
OPEN "CLOCK$" FOR BINARY AS #1
GET #1, , kello
CLOSE #1
vara = kello

GOSUB NaytaTiedot
SLEEP

'muodostetaan päiväys 01.01.2000 12:34:56,00
kello.paivat = Paiviksi("01.01.2000")
kello.tunnit = CHR$(12)
kello.minuutit = CHR$(34)
kello.sekunnit = CHR$(56)
kello.sadasosat = CHR$(0)

'laitetaan uusi päiväys voimaan
OPEN "CLOCK$" FOR BINARY AS #1
PUT #1, , kello
CLOSE #1

GOSUB NaytaTiedot
SLEEP

'palautetaan vanha päiväys ja luetaan se uudelleen
OPEN "CLOCK$" FOR BINARY AS #1
PUT #1, , vara
CLOSE #1
OPEN "CLOCK$" FOR BINARY AS #1
GET #1, , kello
CLOSE #1

GOSUB NaytaTiedot
END

'näyttää päivämäärän ja kellonajan kunnolla muotoiltuna
NaytaTiedot:
PRINT "Nyt on " + Paivaykseksi(kello.paivat)
PRINT "Kello on " + MJ$(ASC(kello.tunnit), 1) + ":";
PRINT MJ$(ASC(kello.minuutit), 1) + ":";
PRINT MJ$(ASC(kello.sekunnit), 1) + ",";
PRINT MJ$(ASC(kello.sadasosat), 1)
RETURN

'palauttaa luvun merkkijonona, tarvittaessa etunollan kanssa
FUNCTION MJ$ (L AS INTEGER, N AS INTEGER)
   IF N THEN
      MJ$ = RIGHT$("0" + LTRIM$(STR$(L)), 2)
   ELSE
      MJ$ = LTRIM$(STR$(L))
   END IF
END FUNCTION

'muuttaa päivien määrän päiväykseksi, esim. 8863 -> 07.04.2004
FUNCTION Paivaykseksi$ (paivat AS INTEGER)
   DIM v AS INTEGER, k AS INTEGER, p AS INTEGER
   v = 1980
   k = 1
   'lasketaan kokonaiset vuodet
   DO
      IF v MOD 4 = 0 THEN
         IF paivat < 366 THEN
            EXIT DO
         END IF
         paivat = paivat - 366
      ELSE
         IF paivat < 365 THEN
            EXIT DO
         END IF
         paivat = paivat - 365
      END IF
      v = v + 1
   LOOP
   'lasketaan kuukaudet
   DO
      SELECT CASE k
         CASE 4, 6, 9, 11 '30 päivää
            IF paivat < 31 THEN
               EXIT DO
            END IF
            paivat = paivat - 30
         CASE 2           '28 tai 29 päivää
            IF v MOD 4 = 0 THEN
               IF paivat < 30 THEN
                  EXIT DO
               END IF
               paivat = paivat - 29
            ELSE
               IF paivat < 29 THEN
                  EXIT DO
               END IF
               paivat = paivat - 28
            END IF
         CASE ELSE        '31 päivää
            IF paivat < 32 THEN
               EXIT DO
            END IF
            paivat = paivat - 31
         END SELECT
      k = k + 1
   LOOP
   'päivät jää jäljelle
   p = paivat + 1
   Paivaykseksi$ = MJ$(p, 1) + "." + MJ$(k, 1) + "." + MJ$(v, 0)
END FUNCTION

'muuttaa päiväyksen päivien määräksi, esim. 07.04.2004 -> 8863
FUNCTION Paiviksi% (pvm AS STRING)
   DIM paivat AS INTEGER, i AS INTEGER
   DIM v AS INTEGER, k AS INTEGER, p AS INTEGER
   v = VAL(RIGHT$(pvm, 4))
   k = VAL(MID$(pvm, 4, 2))
   p = VAL(LEFT$(pvm, 2))
   'lasketaan vuosien tuottama päivien määrä
   FOR i = 1981 TO v
      IF i MOD 4 = 0 THEN  'karkausvuosi
         paivat = paivat + 366
      ELSE                 'tavallinen vuosi
         paivat = paivat + 365
      END IF
   NEXT
   'lasketaan kuukausien tuottama päivien määrä
   FOR i = 1 TO k - 1
      SELECT CASE i
         CASE 4, 6, 9, 11  '30 päivää
            paivat = paivat + 30
         CASE 2            '28 tai 29 päivää
            IF v MOD 4 = 0 THEN
               paivat = paivat + 29
            ELSE
               paivat = paivat + 28
            END IF
         CASE ELSE         '31 päivää
            paivat = paivat + 31
      END SELECT
   NEXT
   'lisätään vielä jäljellejääneet päivät
   paivat = paivat + p
   '"stemmataan" päivien määrä
   IF v = 1980 OR v >= 2000 THEN
      paivat = paivat - 1
   END IF
   Paiviksi% = paivat
END FUNCTION