QBasic & Borland Pascal & C

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

/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Samples / VB_SMPL / VB_SMPL.ZIP / CDPLAY.EXE / CDPLAYER.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1994-04-01 | 19.0 KB | 557 lines

VERSION 2.00 Begin Form CDForm BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "CD Player" ClientHeight = 2400 ClientLeft = 2745 ClientTop = 2070 ClientWidth = 7185 FontBold = -1 'True FontItalic = -1 'True FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FFFFFF& Height = 3090 Icon = CDPLAYER.FRX:0000 Left = 2685 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 2400 ScaleWidth = 7185 Top = 1440 Width = 7305 Begin SSPanel TrackPanel3D Alignment = 2 'Left Justify - BOTTOM BackColor = &H00C0C0C0& Font3D = 0 'None Height = 1440 Left = 60 TabIndex = 15 Top = 45 Width = 7095 Begin SSPanel frmDisabledCD Alignment = 8 'Center - BOTTOM BackColor = &H00C0C0C0& BevelOuter = 0 'None Caption = "Please Wait. . ." Font3D = 0 'None Height = 1320 Left = 120 TabIndex = 2 Top = 45 Width = 6855 Begin PictureBox picLogo AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 615 Left = 2205 ScaleHeight = 615 ScaleWidth = 2535 TabIndex = 3 Top = 120 Width = 2535 Begin Label lblLogo AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "CD Player" FontBold = -1 'True FontItalic = -1 'True FontName = "MS Serif" FontSize = 24 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00C00000& Height = 525 Index = 2 Left = -30 TabIndex = 4 Top = 0 Width = 2445 End Begin Label lblLogo AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "CD Player" FontBold = -1 'True FontItalic = -1 'True FontName = "MS Serif" FontSize = 24 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FFFFFF& Height = 525 Index = 3 Left = 0 TabIndex = 5 Top = 30 Width = 2415 End End End Begin PictureBox minipicLogo AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 210 Left = 3045 ScaleHeight = 210 ScaleWidth = 1095 TabIndex = 10 Top = 60 Width = 1095 Begin Label lblminiLogo AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "CD Player" FontBold = -1 'True FontItalic = -1 'True FontName = "MS Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00C00000& Height = 195 Index = 0 Left = 120 TabIndex = 11 Top = -15 Width = 900 End Begin Label lblminiLogo AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "CD Player" FontBold = -1 'True FontItalic = -1 'True FontName = "MS Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00FFFFFF& Height = 195 Index = 1 Left = 120 TabIndex = 12 Top = 0 Width = 900 End End Begin SSPanel DisplayTracks BackColor = &H00C0C0C0& BevelInner = 1 'Inset BevelOuter = 0 'None Font3D = 0 'None Height = 855 Left = 105 TabIndex = 18 Top = 225 Width = 6855 Begin SSOption TrackNum Font3D = 0 'None FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 9.75 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 0 Left = 240 TabIndex = 13 Top = 105 Visible = 0 'False Width = 200 End Begin Label TrackLabel BackStyle = 0 'Transparent Caption = "1" Height = 255 Index = 0 Left = 240 TabIndex = 14 Top = 345 Visible = 0 'False Width = 135 End End Begin SSCheck Repeat Caption = "&Repeat" Font3D = 0 'None Height = 255 Left = 6030 TabIndex = 17 Top = 1095 Width = 975 End Begin PictureBox PicTotalTime AutoRedraw = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None Height = 255 Left = 135 ScaleHeight = 255 ScaleWidth = 3015 TabIndex = 16 Top = 1095 Width = 3015 End End Begin SSPanel CDButton3DPanel BackColor = &H00C0C0C0& BevelInner = 1 'Inset Font3D = 0 'None Height = 855 Left = 45 TabIndex = 6 Top = 1530 Width = 7095 Begin MMControl MMControl1 BackVisible = 0 'False BorderStyle = 0 'None DeviceType = "CDAudio" Height = 615 Left = 150 RecordVisible = 0 'False StepVisible = 0 'False TabIndex = 9 Top = 120 Width = 2640 End Begin SSPanel Status BackColor = &H00C0C0C0& BevelInner = 1 'Inset BevelOuter = 0 'None Font3D = 0 'None Height = 495 Left = 3000 TabIndex = 8 Top = 120 Width = 3975 End Begin SSPanel CDStatusBar BackColor = &H00C0C0C0& BevelInner = 1 'Inset BevelOuter = 0 'None FloodShowPct = 0 'False FloodType = 1 'Left To Right Font3D = 0 'None FontBold = -1 'True FontItalic = 0 'False FontName = "MS Serif" FontSize = 6 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 200 Left = 3000 TabIndex = 7 Top = 575 Width = 3975 End End Begin PictureBox CDPicture AutoRedraw = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None DragIcon = CDPLAYER.FRX:0302 DrawMode = 4 'Not Copy Pen FillStyle = 0 'Solid ForeColor = &H00000000& Height = 480 Left = 150 Picture = CDPLAYER.FRX:0604 ScaleHeight = 32 ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 1 TabStop = 0 'False Tag = "9130" Top = 2505 Width = 480 End Begin TextBox txtFloatTitle BackColor = &H00E0FFFF& FontBold = -1 'True FontItalic = -1 'True FontName = "MS Sans Serif" FontSize = 8.25 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 285 Left = 1260 TabIndex = 0 Text = "Text1" Top = 2655 Visible = 0 'False Width = 735 End Begin Timer Timer1 Left = 795 Top = 2520 End Begin Menu mnuExit Caption = "E&xit" End Begin Menu mnuOptions Caption = "&Options" Begin Menu mnuOptionsItem Caption = "&Display Track Time In Icon" Index = 0 End Begin Menu mnuOptionsItem Caption = "-" Index = 1 End Begin Menu mnuOptionsItem Caption = "Alway on &Top" Index = 2 End Begin Menu mnuOptionsItem Caption = "&Floating Titles" Index = 3 End End Begin Menu mnuCDInfo Caption = "&CD Info" Begin Menu mnuCDInfoItem Caption = "A&dd To/Edit CD Database" Index = 0 End Begin Menu mnuCDInfoItem Caption = "About This &CD" Index = 1 End Begin Menu mnuCDInfoItem Caption = "-" Index = 2 End Begin Menu mnuCDInfoItem Caption = "&About CD Player" Index = 3 End End Option Explicit Sub CDStatusBar_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) Call UpdateSeek(CDTime(TrackIndex), X) End Sub Sub Form_Load () ' Initialize some variables to default values CRLF = Chr$(13) & Chr$(10) NumOfTracks = 1 AppPath = App.Path CenterLogo Me, frmDisabledCD CenterForm CDForm, True ' Check for CD Installed If MMInstalled() = True Then InitMMControl ' Check to see if In Play Mode If CDForm.MMControl1.Mode = 526 Then MMControl1_PlayClick 0 End If ' Get Option Settings GetOptionSettings End Sub Sub Form_Resize () If CDForm.WindowState <= 1 And CDForm.mnuOptionsItem(2).Checked = True Then ' Because of the way VB is handling the ICON Window, it destroys ' the old window and creates a new one, thus totally screwing up Alway On Top! OnTop Me ' Call to turn check off OnTop Me ' Turn back on new Window End If If CDForm.WindowState = 1 And CDForm.mnuOptionsItem(0).Checked = True Then ' Turn on an Icon if not checked CDForm.Icon = LoadPicture() Else CDForm.Icon = CDForm.CDPicture.Picture End If End Sub Sub Form_Unload (Cancel As Integer) Dim Answer As Integer If MMControl1.Mode = MCI_MODE_PLAY Then Answer = MsgBox(CDInfo.CDTitle & " is still playing!" & CRLF & "Are you sure you want to Exit?", 4, "Attention") If Answer = 6 Then ' Yes ' Save Option Settings SaveOptionSettings MMControl1.Command = "Close" Else ' No Cancel = True End If Else ' Save Option Settings SaveOptionSettings MMControl1.Command = "Close" End If End Sub Sub MMControl1_EjectClick (Cancel As Integer) MMControl1.Command = "Eject" MMControl1.Command = "Close" UpdateCaption 0, "None" CDForm.txtFloatTitle.Visible = False Timer_Control True End Sub Sub MMControl1_PauseClick (Cancel As Integer) CDForm.Caption = CDInfo.CDTitle & " (Paused)" End Sub Sub MMControl1_PlayClick (Cancel As Integer) Dim I As Integer MMControl1.UpdateInterval = 1000 MMControl1.From = TrackIndex If CDForm.Caption = CDInfo.CDTitle & " (Paused)" Then MMControl1.Command = "Seek" End If End Sub Sub MMControl1_PlayCompleted (ErrorCode As Long) If ErrorCode = 262 Then MMControl1.Command = "Close" Timer_Control True End If End Sub Sub MMControl1_StatusUpdate () Static Stopped As Integer If MMControl1.Mode = MCI_MODE_STOP And CDForm.Caption <> CDInfo.CDTitle & "(Paused)" Then ' Repeat If Repeat.Value = True And MMControl1.NotifyValue = 1 Then Call UpdateCaption(1, "Rewinding") MMControl1.From = "1" MMControl1.Command = "Play" Exit Sub End If If Stopped = True Then Exit Sub ' Update Form Caption Call UpdateCaption(CDInfo.CDTrack, "Stopped") ' Update CD Info Call UpdateCDInfo(0, "00:00") ' Set Icon Timer to 00:00 If CDForm.mnuOptionsItem(0).Checked = True Then CDForm.Cls CDForm.Print "00:00" End If ' Set Stopped Flag Stopped = True ElseIf MMControl1.Mode = MCI_MODE_PLAY Then If CDForm.WindowState = 0 Then ' Clear Form and Reset Flags CDForm.Cls Stopped = False ' Get CD Track, Minute and Second Info CDInfo.CDTrack = GetCDTrack() ' Update Form Caption Call UpdateCaption(CDInfo.CDTrack, "Play") ' Update CD Info Call UpdateCDInfo(CInt(CDInfo.CDTrack), GetCDTime()) ' Floating Titles If mnuOptionsItem(3).Checked = True Then FloatingTitle ElseIf CDForm.WindowState = 1 Then If mnuOptionsItem(0).Checked = True Then AnimateIcon GetCDTime() ' Update Form Caption Call UpdateCaption(GetCDTrack(), "Play") End If ElseIf MMControl1.Mode = MCI_MODE_READY Then MMControl1.Command = "Close" UpdateCaption 0, "None" CDForm.txtFloatTitle.Visible = False Timer_Control True End If End Sub Sub MMControl1_StopClick (Cancel As Integer) ' Update Form Caption Call UpdateCaption(CDInfo.CDTrack, "Stopped") ' Update CD Info CDForm.Status.Caption = "Length: -None- Time: -None-" End Sub Sub mnuCDInfoItem_Click (Index As Integer) Select Case Index Case 0 ' Add CD Info CDEntry.Show 1 Case 1 ' About The CD CDAbout.Show 1 Case 3 ' About CDPlayer About.Show 1 End Select End Sub Sub mnuExit_Click () Unload Me End Sub Sub mnuOptionsItem_Click (Index As Integer) Select Case Index Case 0 ' Animation mnuOptionsItem(0).Checked = Not mnuOptionsItem(0).Checked Case 1 ' Bar Case 2 ' Always On Top OnTop Me Case 3 mnuOptionsItem(Index).Checked = Not mnuOptionsItem(Index).Checked End Select End Sub Sub Timer1_Timer () Dim I As Integer MMControl1.Command = "Open" If MMControl1.Error = 266 Then ' Control Disabled! No CD Present CDForm.frmDisabledCD.Caption = "Please Insert A CD!" frmDisabledCD.Visible = True ChangeMenuStatus False If Tracks_Loaded = True Then Call LoadTracks(NumOfTracks, False) PicTotalTime.Cls ReDim CDTracks(0) Else ' Initialize the control If Tracks_Loaded = True Then Call LoadTracks(NumOfTracks, False) InitMMControl ChangeMenuStatus True CDStatusBar.FloodPercent = 0 Call Timer_Control(False) End If End Sub Sub TrackLabel_Click (Index As Integer) ' Seek to Track TrackNum(Index).Value = True TrackPanel3D.Refresh End Sub Sub TrackNum_Click (Index As Integer, Value As Integer) TrackIndex = Index ' Check if just Setting Option If TrackNumChange = True Then Exit Sub ' Seek to Track MMControl1.To = TrackIndex MMControl1.Command = "Seek" MMControl1.Track = TrackIndex MMControl1.SetFocus End Sub Sub TrackNum_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) Static SavedIndex As Integer If SavedIndex = Index Then Exit Sub If mnuOptionsItem(3).Checked = True Then MouseX = X MouseY = Y txtFloatTitle.Visible = False txtFloatTitle = (Mid$(CDTrackNo(Index), 5, (Len(CDTrackNo(Index)) - 5))) txtFloatTitle.Width = CDForm.TextWidth(txtFloatTitle) + 100 txtFloatTitle.Height = CDForm.TextHeight(txtFloatTitle) txtFloatTitle.ZOrder 0 txtFloatTitle.Left = TrackNum(Index).Left If (txtFloatTitle.Left + txtFloatTitle.Width) > (TrackPanel3D.Left + TrackPanel3D.Width) Then txtFloatTitle.Left = TrackNum(Index).Left + ((TrackPanel3D.Left + TrackPanel3D.Width) - (txtFloatTitle.Left + txtFloatTitle.Width)) End If txtFloatTitle.Top = TrackNum(Index).Top txtFloatTitle.Tag = Index SavedIndex = Index txtFloatTitle.Visible = True End If End Sub