Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mtc / mtc.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-05-07 | 19.2 KB | 596 lines

VERSION 2.00 Begin Form MTCForm BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "SMPTE : 25 Fr/s" ClientHeight = 2550 ClientLeft = 3030 ClientTop = 2775 ClientWidth = 2985 ControlBox = 0 'False Height = 3240 Icon = MTC.FRX:0000 KeyPreview = -1 'True Left = 2970 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 2550 ScaleWidth = 2985 Top = 2145 Width = 3105 Begin Timer Timer1 Interval = 500 Left = 870 Top = 2610 End Begin PictureBox Z BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 2235 Index = 1 Left = 180 ScaleHeight = 2205 ScaleWidth = 2625 TabIndex = 14 Top = 180 Width = 2655 Begin PictureBox Z BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 195 Index = 2 Left = 2160 ScaleHeight = 165 ScaleWidth = 345 TabIndex = 21 Top = 60 Width = 375 End Begin PictureBox Z BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 195 Index = 0 Left = 150 ScaleHeight = 165 ScaleWidth = 285 TabIndex = 20 Top = 90 Width = 315 End Begin PictureBox OutShow BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 255 Left = 2220 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 19 Top = 270 Width = 255 End Begin PictureBox InShow BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 255 Left = 180 ScaleHeight = 225 ScaleWidth = 225 TabIndex = 18 Top = 270 Width = 255 End Begin PictureBox Z BackColor = &H00C0C0C0& Height = 525 Index = 5 Left = 570 ScaleHeight = 495 ScaleWidth = 1470 TabIndex = 0 Top = 240 Width = 1500 Begin PictureBox Z BackColor = &H00C0C0C0& Height = 330 Index = 4 Left = 90 ScaleHeight = 300 ScaleWidth = 1305 TabIndex = 1 Top = 90 Width = 1335 Begin Label ZZ Alignment = 2 'Center BackColor = &H00000000& Caption = ":" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Index = 2 Left = 945 TabIndex = 2 Top = 30 Width = 105 End Begin Label ZZ Alignment = 2 'Center BackColor = &H00000000& Caption = ":" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Index = 1 Left = 610 TabIndex = 3 Top = 30 Width = 105 End Begin Label ZZ Alignment = 2 'Center BackColor = &H00000000& Caption = ":" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Index = 0 Left = 300 TabIndex = 4 Top = 30 Width = 90 End Begin Label txtFrames Alignment = 1 'Right Justify BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 1020 TabIndex = 5 Top = 30 Width = 270 End Begin Label txtSeconds Alignment = 2 'Center BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 720 TabIndex = 6 Top = 30 Width = 225 End Begin Label txtMinutes Alignment = 2 'Center BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 390 TabIndex = 7 Top = 30 Width = 225 End Begin Label txtHours Alignment = 1 'Right Justify BackColor = &H00000000& Caption = "00" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H0000FFFF& Height = 240 Left = 52 TabIndex = 8 Top = 30 Width = 255 End End End Begin PictureBox BotonsBox BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 675 Left = 210 ScaleHeight = 645 ScaleWidth = 2205 TabIndex = 9 Top = 1410 Width = 2235 Begin PictureBox cmdRewind Height = 495 Left = 90 Picture = MTC.FRX:0302 ScaleHeight = 465 ScaleWidth = 465 TabIndex = 10 Top = 90 Width = 495 End Begin PictureBox cmdForward Height = 495 Left = 1620 Picture = MTC.FRX:0604 ScaleHeight = 465 ScaleWidth = 465 TabIndex = 11 Top = 90 Width = 495 End Begin PictureBox cmdPlay Height = 495 Left = 600 Picture = MTC.FRX:0906 ScaleHeight = 465 ScaleWidth = 465 TabIndex = 12 Top = 90 Width = 495 End Begin PictureBox cmdStop Height = 495 Left = 1110 Picture = MTC.FRX:0C08 ScaleHeight = 465 ScaleWidth = 465 TabIndex = 13 Top = 90 Width = 495 End End Begin PictureBox Z BackColor = &H00C0C0C0& ForeColor = &H00FF0000& Height = 405 Index = 10 Left = 210 ScaleHeight = 375 ScaleWidth = 2205 TabIndex = 15 Top = 870 Width = 2235 Begin PictureBox optWrite ForeColor = &H00FF0000& Height = 210 Left = 180 ScaleHeight = 180 ScaleWidth = 675 TabIndex = 17 Top = 100 Width = 705 End Begin PictureBox optRead ForeColor = &H00FF0000& Height = 195 Left = 1170 ScaleHeight = 165 ScaleWidth = 705 TabIndex = 16 TabStop = 0 'False Top = 100 Width = 735 End End End Begin PictureBox MidiHook Height = 480 Left = 390 ScaleHeight = 450 ScaleWidth = 1170 TabIndex = 22 Top = 2610 Width = 1200 End Begin Menu mnuSetup Caption = "&Setup" Begin Menu SetupMidi Caption = "&Midi Devices..." End Begin Menu SetupFrameMode Caption = "&Frame Mode..." End End Begin Menu mnuOptions Caption = "&Options" Begin Menu OptionsMidiThru Caption = "&Midi Thru" End Begin Menu OptionsOnlyMTC Caption = "&Only MTC" Checked = -1 'True End End Begin Menu mnuExit Caption = "&Exit" Begin Menu ExitYes Caption = "&Yes" End Begin Menu ExitNo Caption = "&No" End End Option Explicit Sub cmdForward_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim p As Integer flgDown = True p = True Do While flgDown = True Select Case Shift Case 0: fff = fff + 1 disp_fff = disp_fff + 1 Case ALT_MASK: sss = sss + 1 disp_sss = disp_sss + 1 Case CTRL_MASK: mmm = mmm + 1 disp_mmm = disp_mmm + 1 Case SHIFT_MASK: hhh = hhh + 1 disp_hhh = disp_hhh + 1 End Select Display_Adjust SMPTE_Adjust DoEvents If p = True Then 'Primer click Wait (300) 'el que sigui (s'ha de graduar) p = False Else 'aguanta Wait (30) 'tamb s'ha de graduar End If DoEvents 'per llegir MouseUp que fa flgDown=False Loop End Sub Sub cmdForward_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) flgDown = False End Sub Sub cmdPlay_Click () Dim st As String Dim CurrentTime As Long, OldTime As Long If disp_hhh >= 24 Or disp_mmm >= 60 Or disp_sss >= 60 Or disp_fff >= Frame_Mode Then Dlg_Alert "SMPTE incorrect!" Exit Sub End If MTC_Write End Sub Sub cmdRewind_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim p As Integer flgDown = True p = True Do While flgDown = True Select Case Shift Case 0: fff = fff - 1 disp_fff = disp_fff - 1 Case ALT_MASK: sss = sss - 1 disp_sss = disp_sss - 1 Case CTRL_MASK: mmm = mmm - 1 disp_mmm = disp_mmm - 1 Case SHIFT_MASK: hhh = hhh - 1 disp_hhh = disp_hhh - 1 End Select Display_Adjust SMPTE_Adjust DoEvents If p = True Then 'Primer click Wait (300) 'el que sigui (s'ha de graduar) p = False Else 'aguanta Wait (30) 'tamb s'ha de graduar End If DoEvents 'per llegir MouseUp que fa flgDown=False Loop End Sub Sub cmdRewind_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) flgDown = False End Sub Sub cmdStop_Click () flgStop = True End Sub Sub ExitYes_Click () MidiOut_Close MidiIn_Close If NumErrors <> 0 Then Dlg_Alert CStr(NumErrors) & " MIDI Messages Lost!" End If End End Sub Sub Form_Activate () Dim msg As Long Do msg = MidiIn_Read() 'Empty InBuffer DoEvents Loop End Sub Sub Form_KeyDown (KeyCode As Integer, Shift As Integer) Dim h As String, m As String, s As String, f As String Dim i As Integer If KeyCode = KEY_ESCAPE Then txtHours = "00" txtMinutes = "00" txtSeconds = "00" txtFrames = "00" ElseIf IsNumber(KeyCode) = True Then h = txtHours.Caption m = txtMinutes.Caption s = txtSeconds.Caption f = txtFrames.Caption Mid$(h, 1, 1) = Mid$(h, 2, 1)'00 00 00 00 Mid$(h, 2, 1) = Mid$(m, 1, 1) Mid$(m, 1, 1) = Mid$(m, 2, 1) Mid$(m, 2, 1) = Mid$(s, 1, 1) Mid$(s, 1, 1) = Mid$(s, 2, 1) Mid$(s, 2, 1) = Mid$(f, 1, 1) Mid$(f, 1, 1) = Mid$(f, 2, 1) Mid$(f, 2, 1) = CStr(KeyToNumber(KeyCode)) txtHours.Caption = h disp_hhh = Val(h) txtMinutes.Caption = m disp_mmm = Val(m) txtSeconds.Caption = s disp_sss = Val(s) txtFrames.Caption = f disp_fff = Val(f) End If KeyCode = 0 End Sub Sub Form_Load () Dim nDevices As Integer Dim i As Integer Dim InCaps As MidiInCaps Dim OutCaps As MidiOutCaps Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2 nDevices = midiInGetNumDevs() If nDevices = 0 Then Dlg_Alert "No Midi In Device!" Else For i = 0 To nDevices - 1 ret = midiInGetDevCaps(i, InCaps, Len(InCaps)) If ret <> 0 Then Alerta_MidiError (ret) Exit For End If MidiForm.InList.List(i) = InCaps.szPname Next i End If nDevices = midiOutGetNumDevs() If nDevices = 0 Then Dlg_Alert "No Midi Out Device!" Else MidiForm.OutList.List(0) = "MS MIDI Mapper" 'Midi Mapper=possible MIDI OUT For i = 0 To nDevices - 1 ret = midiOutGetDevCaps(i, OutCaps, Len(OutCaps)) If ret <> 0 Then Alerta_MidiError (ret) Exit For End If MidiForm.OutList.List(i + 1) = OutCaps.szPname Next i End If Reset_BufferIn hMidiIn = NO_HANDLE hMidiOut = NO_HANDLE TC_Type = 1 Frame_Mode = 25 Ms_per_QF = 10 QF_Counter = 0 MTC_Time = 0 NumErrors = 0 flgChangeIt = True hhh = 0 mmm = 0 sss = 0 fff = 0 disp_hhh = 0 disp_mmm = 0 disp_sss = 0 disp_fff = 0 OutShow.Caption = "" InShow.Caption = "" MidiForm.Show 1 End Sub Sub MidiHook_Message (msg As Integer, wParam As Integer, lParam As Long, action As Integer, result As Long) If OptionsOnlyMTC.Checked = True Then If (lParam And &HFF) <> &HF1 Then Exit Sub 'Accept only MTC messages End If If OptionsMidiThru.Checked = True Then If hMidiOut <> NO_HANDLE Then ret = midiOutShortMsg(hMidiOut, lParam) OutShow.Caption = "u" End If End If If BuffCounter = BUFFSIZE Then NumErrors = NumErrors + 1& Exit Sub End If While flgChangeIt = False DoEvents Wend flgChangeIt = False InBuffer(WriteIndex) = lParam WriteIndex = WriteIndex + 1 If WriteIndex = BUFFSIZE Then WriteIndex = 0 BuffCounter = BuffCounter + 1 flgChangeIt = True InShow.Caption = "u" End Sub Sub OptionsMidiThru_Click () OptionsMidiThru.Checked = Not OptionsMidiThru.Checked End Sub Sub OptionsOnlyMTC_Click () OptionsOnlyMTC.Checked = Not OptionsOnlyMTC.Checked End Sub Sub optRead_Click (Value As Integer) If Value = True Then BotonsBox.Visible = False MTC_Read Else BotonsBox.Visible = True flgReadStop = True End If End Sub Sub optWrite_Click (Value As Integer) If Value = True Then BotonsBox.Visible = True flgReadStop = True Display_Adjust Else BotonsBox.Visible = False flgReadStop = False End If End Sub Sub SetupFrameMode_Click () FrameForm.Show 1 End Sub Sub SetupMidi_Click () MidiForm.Show 1 End Sub Sub Timer1_Timer () OutShow.Caption = "" InShow.Caption = "" End Sub