2003-09-10 21:14

     $OPTION EXPLICIT
     $INCLUDE "Rapidq.inc"
     $ESCAPECHARS ON

     REM

     DECLARE FUNCTION mciGetErrorString LIB "winmm.dll" ALIAS "mciGetErrorStringA" (BYVAL dwError AS LONG, BYVAL lpstrBuffer AS STRING, BYVAL uLength AS LONG) AS LONG
     DECLARE FUNCTION sndPlaySound LIB "winmm.dll" ALIAS "sndPlaySoundA" (BYVAL LpszSoundName AS STRING, BYVAL Uflags AS LONG) AS LONG
     DECLARE FUNCTION mciExecute LIB "WINMM.DLL" ALIAS "mciExecute" (StrCommand AS STRING) AS INTEGER
     DECLARE FUNCTION mciSendString LIB "WINMM.DLL" ALIAS "mciSendStringA" _
      (StrCommand AS STRING, ReturnString AS STRING, _
      ReturnLength AS LONG, hwndCallBack AS LONG) AS INTEGER
     DECLARE SUB StartPlay()
     DECLARE SUB CurrentTimer_Timer()
     DECLARE SUB Speak()
     DECLARE SUB Quit
     DECLARE SUB Silent()
     DECLARE SUB ProgQuit()
     DECLARE FUNCTION MediaLength() AS LONG
     DECLARE FUNCTION CurrentPos() AS LONG
     DECLARE FUNCTION MediaStatus() AS STRING
     DECLARE FUNCTION IsValidState() AS INTEGER
     DECLARE FUNCTION TitleFix(F AS STRING) AS STRING
     CREATE Clock AS QFORM
      CAPTION = ""
      Width = 372
      Height = 389
      Center
      CREATE Pico AS QIMAGE
       BMP = "Clock1.bmp"
       Left = 0
       Top = 0
       Width = 364
       Height = 355
      END CREATE
      CREATE DigitHolder AS QLABEL
       CAPTION = "00:00:00"
       Left = 102
       Top = 74
       Width = 298
       Height = 37
       COLOR = QbColor(14)
       Font.Name="MS SANS SERIF"
       font.size=24
       font.bold = True
       Transparent = false
       Enabled=True
      END CREATE
      CREATE Sensor AS QBUTTON
       CAPTION = ""
       BMP = "Wizard34.bmp"
       Left = 24
       Top = 265
       Width = 84
       Height = 84
       Hint = "Make Speaking Time"
       ShowHint=true
       OnClick=Speak
      END CREATE
      CREATE Music AS QBUTTON
       CAPTION = ""
       BMP = "FormD.bmp"
       Left = 300
       Top = 165
       Width = 37
       Height = 37
       ShowHint = 1
       Hint = "Play a Simple Melody"
       OnClick=StartPlay
       TabOrder = 1
      END CREATE
'    CREATE Holiday AS QBUTTON
'	Caption = ""
'	BMP = "FormB.bmp"
'	Left = 300
'	Top = 212
'	Width = 37
'	Height = 37
'	ShowHint = 1
'	Hint = "Silent The Music"
'	OnClick=Silent
'	TabOrder = 2
'    END CREATE
      CREATE QuitNow AS QBUTTON
       CAPTION = ""
       BMP = "FormC.bmp"
       Left = 300
       Top = 258
       Width = 37
       Height = 37
       ShowHint = 1
       Hint = "Exit The Program"
       OnClick=ProgQuit
       TabOrder = 3
      END CREATE
     END CREATE

     CREATE Mytimer AS QTIMER
      Enabled=True'
      Interval=1000
      OnTimer=CurrentTimer_Timer
     END CREATE


'Const Path=CurDir$+"\"
     CONST Inled$="A_THETIM.WAV
Const Prefix1$="A_PM.WAV
     CONST Prefix2$="A_AM.WAV
Const Prefix3$="A_MIDNIT.WAV
     DIM LpszSoundName AS STRING
     DIM MusicFile AS STRING
     DIM MFile(0 TO 6) AS STRING

     MFile(0)="De_sista_ljuva_åren.mid"
     MFile(1)="En_clown_i_mina_kläder.mid"
     MFile(2)="En_gång_är_ingen_gång.mid"
     MFile(3)="En_prästkrage_i_min_hand.mid"
     MFile(4)="Ett_Gammalt_Dragspel.mid"
     MFile(5)="Ett_fång_med_röda_rosor.Mid"
     MFile(6)="Ett_litet_hus_nedvid_stranden.Mid"
     DIM NonPlaying AS INTEGER
     DIM nCounter AS INTEGER
     MusicFile =MFile(0)
     DIM American(0 TO 71) AS STRING
     American( 0)="A_ZERO.WAV"
     American( 1)="A_1CLO.WAV"
     American( 2)="A_2CLO.WAV"
     American( 3)="A_3CLO.WAV"
     American( 4)="A_4CLO.WAV"
     American( 5)="A_5CLO.WAV"
     American( 6)="A_6CLO.WAV"
     American( 7)="A_7CLO.WAV"
     American( 8)="A_8CLO.WAV"
     American( 9)="A_9CLO.WAV"
     American(10)="A_10CLO.WAV"
     American(11)="A_11CLO.WAV"
     American(12)="A_12CLO.WAV"
     American(13)="A_13.WAV"
     American(14)="A_14.WAV"
     American(15)="A_15.WAV"
     American(16)="A_16.WAV"
     American(17)="A_17.WAV"
     American(18)="A_18.WAV"
     American(19)="A_19.WAV"
     American(20)="A_20.WAV"
     American(21)="A_21.WAV"
     American(22)="A_22.WAV"
     American(23)="A_23.WAV"
     American(24)="A_24.WAV"
     American(25)="A_25.WAV"
     American(26)="A_26.WAV"
     American(27)="A_27.WAV"
     American(28)="A_28.WAV"
     American(29)="A_29.WAV"
     American(30)="A_30.WAV"
     American(31)="A_31.WAV"
     American(32)="A_32.WAV"
     American(33)="A_33.WAV"
     American(34)="A_34.WAV"
     American(35)="A_35.WAV"
     American(36)="A_36.WAV"
     American(37)="A_37.WAV"
     American(38)="A_38.WAV"
     American(39)="A_39.WAV"
     American(40)="A_40.WAV"
     American(41)="A_41.WAV"
     American(42)="A_42.WAV"
     American(43)="A_43.WAV"
     American(44)="A_44.WAV"
     American(45)="A_45.WAV"
     American(46)="A_46.WAV"
     American(47)="A_47.WAV"
     American(48)="A_48.WAV"
     American(49)="A_49.WAV"
     American(50)="A_50.WAV"
     American(51)="A_51.WAV"
     American(52)="A_52.WAV"
     American(53)="A_53.WAV"
     American(54)="A_54.WAV"
     American(55)="A_55.WAV"
     American(56)="A_56.WAV"
     American(57)="A_57.WAV"
     American(58)="A_58.WAV"
     American(59)="A_59.WAV"
     American(60)="A_1.WAV"
     American(61)="A_2.WAV"
     American(62)="A_3.WAV"
     American(63)="A_4.WAV"
     American(64)="A_5.WAV"
     American(65)="A_6.WAV"
     American(66)="A_7.WAV"
     American(67)="A_8.WAV"
     American(68)="A_9.WAV"
     American(69)="A_10.WAV"
     American(70)="A_11.WAV"
     American(71)="A_12.WAV"

     DIM MediaLong AS LONG
     DIM PlayerIsPlaying AS INTEGER

     DIM Font AS QFONT
     DigitHolder.Font.name="MS Sans Serif"
     DigitHolder.Font.size=24

     DIM Uflags AS LONG

     SUB CurrentTimer_Timer()
      STATIC OldTime$
      IF OldTime$<>TIME$ THEN
       DigitHolder.CAPTION = TIME$
       OldTime$=TIME$
      END IF
     END SUB



     SUB Speak()
      DIM D AS STRING
      DIM nHour   AS INTEGER
      DIM nMinute AS INTEGER
      DIM nSecond AS INTEGER
      D=TIME$
      nHour=VAL(LEFT$(D,2))
      nMinute=VAL(MID$(D,4,2))
      nSecond =VAL(RIGHT$(D,2))


      DOEVENTS
      LpszSoundName = Inled$
      PLAYWAV(LpszSoundName,0)
      LpszSoundName =American(nHour)
      PLAYWAV(LpszSoundName,0)
      LpszSoundName =American(nMinute)
      PLAYWAV(LpszSoundName,0)
      LpszSoundName =American(nSecond)
      PLAYWAV(LpszSoundName,0)
      SELECT CASE nHour
      CASE 0
       LpszSoundName =Prefix3$
       PLAYWAV(LpszSoundName,0)
      CASE 1 TO 12
       LpszSoundName =Prefix2$
       PLAYWAV(LpszSoundName,0)
       LpszSoundName =Prefix1$
       PLAYWAV(LpszSoundName,0)
      CASE 13 TO 24
      CASE ELSE
      END SELECT
     END SUB



     SUB ProgQuit()
      IF MediaStatus = "PLAYING" OR MediaStatus = "PAUSED" THEN
       mciSendString "close Clock", "", 0, 0
      END IF
      Clock.CLOSE
      END
     END SUB

     SUB Silent()
'Dim D as string
'D=MediaStatus
'Select Case D
'Case "STOPPED":	mciSendString "play Clock", "", 0, 0
'Case "PAUSED" :	mciSendString "resume Clock", "", 0, 0
'Case "PLAYING": mciSendString "pause Clock", "", 0, 0
'Case else
'end select
'mciSendString "Pause Clock", "", 0, 0
      mciSendString "Close Clock", "", 0, 0
      NonPlaying=False
     END SUB

     SUB StartPlay ()
      STATIC Index
      DO
       DOEVENTS
       MusicFile=MFile(Index)

       DOEVENTS
       IndeX=Index+1
       IF Index >6 THEN
        Index=0
       END IF

       IF mciExecute("Open "+MusicFile) THEN
        Clock.CAPTION ="  Playing "+TitleFix(MusicFile)
        PlayerIsPlaying = True             'We are playing
        MediaLong=MediaLength
        DOEVENTS
        REM mciSendString("Play "+MusicFile +" wait ","",0,0)
        mciSendString("Play "+MusicFile ,"",0,0)
        NonPlaying=True
       END IF

       DO
        DOEVENTS
        IF MediaStatus = "stopped" THEN EXIT DO
        IF NonPlaying=False THEN EXIT SUB
        CurrentTimer_Timer()
'DigitHolder.Caption = Time$
       LOOP
       mciExecute("Close "+MusicFile)
      LOOP
     END SUB


     FUNCTION MediaLength() AS LONG
      DIM sLength AS STRING * 255, lNullChar AS LONG
      mciSendString "status Clock length", sLength, 255, 0

    'To find the null character position
      lNullChar = INSTR(sLength, CHR$(0))

    'Return the length of the media
      MediaLength = CLNG(VAL(LEFT$(sLength, lNullChar - 1)))
     END FUNCTION


     FUNCTION CurrentPos() AS LONG
      DIM lNullChar AS LONG, sCurPos AS STRING * 255
      mciSendString "status Clock position", sCurPos, 255, 0
      lNullChar = INSTR(sCurPos, CHR$(0))
      CurrentPos = CLNG(VAL(LEFT$(sCurPos, lNullChar - 1)))
     END FUNCTION


     FUNCTION MediaStatus() AS STRING
      DIM lNullChar AS INTEGER, sStatus AS STRING * 255
      mciSendString "status Clock mode", sStatus, 255, 0
      lNullChar = INSTR(sStatus, CHR$(0))
      MediaStatus = UCASE$(LEFT$(sStatus, lNullChar - 1))
     END FUNCTION


     FUNCTION IsValidState() AS INTEGER
      IF MediaStatus = "PLAYING" OR MediaStatus = "PAUSED" OR MediaStatus = "STOPPED" THEN
       IsValidState = True
      ELSE
       IsValidState = False
      END IF
     END FUNCTION

     FUNCTION TitleFix(F AS STRING) AS STRING
      IF LEN(F) THEN
       DIM L AS INTEGER
       DIM D AS STRING
       DIM B AS STRING
       DIM I AS INTEGER

       FOR I=1 TO LEN(F)-4
        B= MID$(F,I,1)
        SELECT CASE B
        CASE "_"
         D=D+" "
        CASE ELSE
         D=D+B
        END SELECT
       NEXT

       TitleFix=D
      END IF
     END FUNCTION

     Clock.SHOWMODAL

2003-09-10 21:14