VERSION 5.00 Object = "{0791F269-FBBF-46AD-B5A6-78DB890BFA5F}#2.0#0"; "VolumeCtrl.ocx" Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.Ocx" Object = "{E3583FCE-0595-4681-9ACD-48F7805DEFE1}#1.0#0"; "glxpbuttonz.ocx" Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX" Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx" Begin VB.Form frmDMDrums AutoRedraw = -1 'True BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "DMDrums" ClientHeight = 6285 ClientLeft = -885 ClientTop = 5190 ClientWidth = 5790 FillStyle = 0 'Solid BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Icon = "frmDMDrums.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6285 ScaleWidth = 5790 Begin RichTextLib.RichTextBox rWinampPlaylist Height = 750 Left = 6045 TabIndex = 95 Top = 2385 Visible = 0 'False Width = 1500 _ExtentX = 2646 _ExtentY = 1323 _Version = 393217 RightMargin = 1.50000e5 TextRTF = $"frmDMDrums.frx":014A End Begin VB.PictureBox frmPicture1 BackColor = &H80000001& BorderStyle = 0 'None Height = 3000 Index = 1 Left = 45 ScaleHeight = 3000 ScaleWidth = 5745 TabIndex = 30 Top = 3225 Width = 5745 Begin VB.CommandButton cmdExternalHelper BackColor = &H80000001& Caption = "Caruso" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 1 Left = 1005 Style = 1 'Graphical TabIndex = 43 ToolTipText = """Caruso interprets sLastLockFilename on Gemini - Edge"" Opp.click for Green toggle, Mid.Click or (CtrlShift+Opp.Click) for swotGPT" Top = 1200 Visible = 0 'False Width = 765 End Begin MSComctlLib.Slider VolSlider1 Height = 1545 Left = 1755 TabIndex = 77 ToolTipText = "Mid.Click to Blank Screen. Opp.Click to reset InitialVolume or LowerVolume or UpperVolume" Top = 435 Width = 225 _ExtentX = 397 _ExtentY = 2725 _Version = 393216 Orientation = 1 Min = -100 Max = 0 SelStart = -100 TickFrequency = 15 Value = -100 TextPosition = 1 End Begin VB.CommandButton cmdPlayPause BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 1 Left = 15 Picture = "frmDMDrums.frx":01D3 Style = 1 'Graphical TabIndex = 91 ToolTipText = "Left.Click toggles/holds Winamp on/off. Mid.Click starts Winamp and Direct Music Drums." Top = 885 UseMaskColor = -1 'True Width = 390 End Begin MSComCtl2.MonthView MonthView1 Height = 2070 Left = 2910 TabIndex = 78 Top = 360 Visible = 0 'False Width = 2625 _ExtentX = 4630 _ExtentY = 3651 _Version = 393216 ForeColor = -2147483630 BackColor = -2147483647 BorderStyle = 1 Appearance = 1 OLEDropMode = 1 MultiSelect = -1 'True ScrollRate = 1 ShowWeekNumbers = -1 'True StartOfWeek = 313851905 CurrentDate = 38028 End Begin VB.CommandButton cmdBeatmix BackColor = &H80000001& Caption = "&MixInGrid" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 1005 Style = 1 'Graphical TabIndex = 36 ToolTipText = "Click to swap DRUMPADSIZE. Opp.Click to try to IngridMixSync or (Mid.Click) to start Beatmixing 'temposync' instance" Top = 885 Visible = 0 'False Width = 765 End Begin VB.CommandButton CommandGridArt BackColor = &H80000001& Caption = "^Grid&Art" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 1005 Style = 1 'Graphical TabIndex = 45 ToolTipText = $"frmDMDrums.frx":0536 Top = 420 UseMaskColor = -1 'True Width = 765 End Begin VB.CommandButton cmdPlayPause BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 0 Left = 15 Picture = "frmDMDrums.frx":0609 Style = 1 'Graphical TabIndex = 50 ToolTipText = "Left.Click starts Winamp and Direct Music Drums. Mid.Click toggles/holds Winamp on/off." Top = 885 UseMaskColor = -1 'True Width = 390 End Begin VB.CommandButton cmdHaltPlay BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 420 Picture = "frmDMDrums.frx":064B Style = 1 'Graphical TabIndex = 51 ToolTipText = "Mid.Click to start recording Mouse Macro. Click to stop." Top = 885 UseMaskColor = -1 'True Width = 390 End Begin VB.CommandButton cmdPlayMotif BackColor = &H80000001& Caption = "Plugin" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 6005 Style = 1 'Graphical TabIndex = 79 Top = 450 Visible = 0 'False Width = 765 End Begin VB.ListBox Genre BackColor = &H80000001& Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 285 ItemData = "frmDMDrums.frx":0B01 Left = 0 List = "frmDMDrums.frx":0D88 Style = 1 'Checkbox TabIndex = 34 ToolTipText = "deSelect to skip. Opp.Click for menu. Mid.Click to Explorer & File Info." Top = 135 Width = 1350 End Begin VB.Frame ManualGearing BackColor = &H80000001& Caption = "¼ ½ 1 2x " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 420 Left = 15 TabIndex = 37 ToolTipText = "Click toggles Automatic Tempo gearing. " Top = 435 Width = 1005 Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "2x" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 3 Left = 705 Style = 1 'Graphical TabIndex = 41 Top = 180 Width = 285 End Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "1" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 2 Left = 465 Style = 1 'Graphical TabIndex = 40 Top = 180 Value = -1 'True Width = 285 End Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "½" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 1 Left = 240 Style = 1 'Graphical TabIndex = 39 Top = 180 Width = 285 End Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "¼" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 0 Left = 0 Style = 1 'Graphical TabIndex = 38 Top = 180 Width = 285 End End Begin VB.CheckBox chkLoop BackColor = &H80000001& Caption = "&Loop Segment" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 30 TabIndex = 80 ToolTipText = "When Grayed will not randomly play and Play plays system MIDI" Top = 2340 Value = 2 'Grayed Width = 1350 End Begin VB.CommandButton cmdStop BackColor = &H80000001& Caption = "RadioOff" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 1005 Style = 1 'Graphical TabIndex = 47 ToolTipText = "Mid.Click to close all and Shutdown Windows" Top = 435 UseMaskColor = -1 'True Width = 765 End Begin VB.CommandButton cmdSegment BackColor = &H80000001& Caption = "Segment &File" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 270 Left = 0 Style = 1 'Graphical TabIndex = 87 Top = 2610 UseMaskColor = -1 'True Width = 1140 End Begin VB.CommandButton cmdSave BackColor = &H80000001& Caption = "&sort^>>|" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 0 Style = 1 'Graphical TabIndex = 49 ToolTipText = $"frmDMDrums.frx":1547 Top = 1215 UseMaskColor = -1 'True Visible = 0 'False Width = 795 End Begin VB.OptionButton optMeasure BackColor = &H80000001& Caption = "Measure" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 4620 Style = 1 'Graphical TabIndex = 85 Top = 2325 Width = 990 End Begin VB.OptionButton optBeat BackColor = &H80000001& Caption = "Beat" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 3945 Style = 1 'Graphical TabIndex = 84 Top = 2325 Width = 675 End Begin VB.OptionButton optGrid BackColor = &H80000001& Caption = "Grid" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 3240 Style = 1 'Graphical TabIndex = 83 Top = 2325 Width = 690 End Begin VB.OptionButton optImmediate BackColor = &H80000001& Caption = "Learning" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2220 Style = 1 'Graphical TabIndex = 82 Top = 2325 Width = 1035 End Begin VB.TextBox txtSegment BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1170 Locked = -1 'True TabIndex = 86 Top = 2595 Width = 4455 End Begin VB.OptionButton optDefault BackColor = &H80000001& Caption = "Default" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1395 Style = 1 'Graphical TabIndex = 81 Top = 2325 Value = -1 'True Width = 855 End Begin MSComctlLib.ProgressBar CPUUsage Height = 645 Left = 810 TabIndex = 44 Tag = "progressbar.htm" ToolTipText = "Click to toggles Fps" Top = 885 WhatsThisHelpID = 20510 Width = 150 _ExtentX = 265 _ExtentY = 1138 _Version = 393216 Appearance = 1 Orientation = 1 End Begin MSComCtl2.UpDown UpDown_Volume Height = 510 Left = 15 TabIndex = 54 Top = 1545 Width = 240 _ExtentX = 423 _ExtentY = 900 _Version = 393216 Value = 100 Max = 100 Enabled = -1 'True End Begin MSComCtl2.UpDown UpDown_Fine_Tempo Height = 435 Left = 0 TabIndex = 55 TabStop = 0 'False ToolTipText = "Change Fine_Tempo - Opp.click for Tempo" Top = 1545 Visible = 0 'False Width = 300 _ExtentX = 529 _ExtentY = 767 _Version = 393216 Value = 2 Max = 500 Min = -500 Enabled = -1 'True End Begin VB.Frame Frame2 BackColor = &H80000001& BorderStyle = 0 'None BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2160 Left = 1815 TabIndex = 59 Top = 135 Visible = 0 'False Width = 3780 Begin VB.PictureBox BongoMan AutoRedraw = -1 'True BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1800 Left = 720 Picture = "frmDMDrums.frx":15CF ScaleHeight = 116 ScaleMode = 3 'Pixel ScaleWidth = 53 TabIndex = 73 TabStop = 0 'False ToolTipText = $"frmDMDrums.frx":2301 Top = 315 Width = 855 End Begin VB.CheckBox chkMute BackColor = &H80000001& Caption = "&Mute" ForeColor = &H000080FF& Height = 240 Left = 0 TabIndex = 76 ToolTipText = $"frmDMDrums.frx":23A5 Top = 1890 Width = 690 End Begin VB.Frame Frame1 BackColor = &H80000001& BorderStyle = 0 'None Height = 1620 Left = 100 TabIndex = 63 Top = 270 Width = 585 Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Line" ForeColor = &H000080FF& Height = 255 Index = 1 Left = 120 Style = 1 'Graphical TabIndex = 65 Top = 240 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Aux" ForeColor = &H000080FF& Height = 225 Index = 6 Left = 120 Style = 1 'Graphical TabIndex = 70 Top = 1350 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Wav" ForeColor = &H000080FF& Height = 255 Index = 5 Left = 120 Style = 1 'Graphical TabIndex = 69 Top = 1125 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "CD" ForeColor = &H000080FF& Height = 255 Index = 4 Left = 120 Style = 1 'Graphical TabIndex = 68 Top = 915 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Syn" ForeColor = &H000080FF& Height = 255 Index = 3 Left = 120 Style = 1 'Graphical TabIndex = 67 Top = 690 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Mic" ForeColor = &H000080FF& Height = 255 Index = 2 Left = 120 Style = 1 'Graphical TabIndex = 66 Top = 465 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Main" ForeColor = &H000080FF& Height = 255 Index = 0 Left = 120 Style = 1 'Graphical TabIndex = 64 Top = 30 Width = 450 End End Begin VB.ListBox AutoTempo BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1815 ItemData = "frmDMDrums.frx":2442 Left = 705 List = "frmDMDrums.frx":2444 Sorted = -1 'True TabIndex = 71 ToolTipText = $"frmDMDrums.frx":2446 Top = 300 Width = 885 End Begin VB.TextBox txtMotifStatus BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 1590 Locked = -1 'True MultiLine = -1 'True OLEDragMode = 1 'Automatic OLEDropMode = 2 'Automatic TabIndex = 72 ToolTipText = "Mid.Click to call up a menu for text handling of the current song" Top = 300 Width = 2175 End Begin VB.ListBox lstMotif BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1620 Left = 1590 TabIndex = 75 Top = 510 Width = 2175 End Begin MSComctlLib.Slider Slider2 Height = 1755 Left = 930 TabIndex = 74 Top = 360 Visible = 0 'False Width = 435 _ExtentX = 767 _ExtentY = 3096 _Version = 393216 Enabled = 0 'False Orientation = 1 Min = -1 Max = 0 End Begin MSComCtl2.DTPicker DTPicker1 Height = 255 Left = 690 TabIndex = 92 ToolTipText = $"frmDMDrums.frx":24CD Top = 15 Width = 2235 _ExtentX = 3942 _ExtentY = 450 _Version = 393216 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Tahoma" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty CustomFormat = "ddd dd MMM yyyy HH:mm:ss" Format = 313851907 UpDown = -1 'True CurrentDate = 38200 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C0C0C0& Height = 480 Index = 5 Left = -345 TabIndex = 61 Top = -105 Width = 120 End Begin VB.Label lblDTStatus Alignment = 1 'Right Justify BackColor = &H80000001& Caption = "No Active Schedule" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 225 Left = 1005 TabIndex = 93 Top = 45 Width = 1695 End Begin VB.Label lblClose BackColor = &H008080FF& Caption = " +" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 200 Index = 1 Left = 3600 TabIndex = 60 ToolTipText = "Click again to abort Closing..." Top = -120 Visible = 0 'False Width = 280 End Begin VB.Label lblStatus BackColor = &H80000001& Caption = "Switch" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 3060 TabIndex = 62 ToolTipText = "Click or Opp.click to add or subtrack 30 ExtraSeconds before next play. Mid.Click to SetGenreEnabled" Top = 60 Width = 705 End End Begin VB.CommandButton cmdExternalHelper BackColor = &H80000001& Caption = "swotGPT" CausesValidation= 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 0 Left = 1005 Style = 1 'Graphical TabIndex = 104 ToolTipText = $"frmDMDrums.frx":255C Top = 1200 Width = 765 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C000C0& Height = 555 Index = 4 Left = 1050 TabIndex = 48 Top = 395 Width = 105 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000C000& Height = 555 Index = 3 Left = 1005 TabIndex = 46 Top = 350 Width = 105 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "HI DJ" BeginProperty Font Name = "Arial" Size = 14.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 315 Index = 2 Left = 1020 TabIndex = 42 Top = 885 Width = 705 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 480 Index = 1 Left = 1470 TabIndex = 32 Top = 0 Width = 120 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0080C0FF& Height = 480 Index = 0 Left = 1485 TabIndex = 35 Top = 15 Width = 120 End Begin VB.Label LabelGrooves BackStyle = 0 'Transparent Caption = "+ grooves" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Index = 1 Left = 0 TabIndex = 102 Top = 135 Width = 1350 End Begin VB.Label LabelVol Alignment = 2 'Center BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "VOL" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Left = 15 TabIndex = 57 ToolTipText = "Winamp Click VolUp Opp.Click VolDn Mid.Click (cross)fades Winamp for beatmiixing, etc." Top = 2085 Width = 510 End Begin VB.Label LabelKey Alignment = 2 'Center BackColor = &H00000000& Caption = "G#m" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 225 Left = 255 TabIndex = 94 Top = 1830 Width = 600 End Begin VB.Label EDIT_Tempo Alignment = 2 'Center BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "255" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 900 TabIndex = 53 ToolTipText = "Punch the Mouse Wheel to retrieve the Tempo from either the MP3 Comment or do a Screen Scrape of the AtomixMP3 BPM calculator" Top = 1515 Width = 855 End Begin VB.Label EDIT_Volume Alignment = 2 'Center BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "50" BeginProperty Font Name = "Microsoft Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 255 TabIndex = 52 ToolTipText = $"frmDMDrums.frx":2619 Top = 1515 Width = 615 WordWrap = -1 'True End Begin VB.Label LabelBPM Alignment = 1 'Right Justify BackColor = &H00000000& Caption = "BPM" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 225 Left = 840 TabIndex = 56 ToolTipText = $"frmDMDrums.frx":26F7 Top = 1830 Width = 900 End Begin VB.Label lblClose BackColor = &H008080FF& Caption = " +" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 195 Index = 0 Left = 5415 TabIndex = 33 ToolTipText = "Click again to abort Closing..." Top = 15 Visible = 0 'False Width = 285 End Begin VB.Label lblDrumSize BackStyle = 0 'Transparent Caption = "- drums ^" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Left = 15 TabIndex = 31 Top = -30 Width = 930 End Begin VB.Label LabelAlign Alignment = 2 'Center AutoSize = -1 'True BackColor = &H00000000& BorderStyle = 1 'Fixed Single Caption = "List Advance" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Left = 525 TabIndex = 58 ToolTipText = $"frmDMDrums.frx":27B4 Top = 2085 Width = 1230 End Begin VB.Image imgLogo Appearance = 0 'Flat BorderStyle = 1 'Fixed Single Height = 2175 Left = 1815 OLEDropMode = 1 'Manual Picture = "frmDMDrums.frx":284C Stretch = -1 'True Top = 105 Width = 3780 End End Begin VB.PictureBox frmPicture1 AutoRedraw = -1 'True BackColor = &H80000001& BorderStyle = 0 'None Height = 3270 Index = 0 Left = 60 ScaleHeight = 3270 ScaleWidth = 5700 TabIndex = 0 Top = 0 Width = 5700 Begin VB.OptionButton optStation Caption = "R" Height = 210 Index = 6 Left = 2985 Style = 1 'Graphical TabIndex = 100 ToolTipText = $"frmDMDrums.frx":8DA6 Top = 3015 Width = 225 End Begin VB.OptionButton optStation Caption = "A" Height = 210 Index = 1 Left = 2970 Style = 1 'Graphical TabIndex = 101 ToolTipText = "Acoustic, Classical, Easy_Listening, Jazz, Musicals, New_Age, Opera, Swing, Vocal" Top = 15 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "E" Height = 210 Index = 5 Left = 2985 Style = 1 'Graphical TabIndex = 99 ToolTipText = "Folk, Oldies, Pop, Rock _Roll, Soft_Rock" Top = 2430 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "D" Height = 210 Index = 4 Left = 2985 Style = 1 'Graphical TabIndex = 98 ToolTipText = "BlueGrass, Blues, Celtic, Country, Ethnic, Funk, Latin, R _B, Reggae, Soul, Soundtrack" Top = 1815 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "C" Height = 210 Index = 3 Left = 2985 Style = 1 'Graphical TabIndex = 97 ToolTipText = "Alternative, Hard_Rock, Metal, New_Wave, Psychedelic_Rock, Punk" Top = 1200 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "B" Height = 210 Index = 2 Left = 2985 Style = 1 'Graphical TabIndex = 96 ToolTipText = "Dance, Disco, Drum _Bass, Electronica, Hip_Hop, House, Rap, Techno, Trance" Top = 615 Width = 225 End Begin VB.CheckBox chkReverb BackColor = &H80000001& Caption = "&Environmental reverb" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 3435 TabIndex = 90 ToolTipText = "When Grayed will not randomly stop and Play must be manual" Top = 3015 Value = 2 'Grayed Width = 2220 End Begin VB.ListBox LIST_Bands BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1185 ItemData = "frmDMDrums.frx":8E48 Left = -15 List = "frmDMDrums.frx":8E4A Style = 1 'Checkbox TabIndex = 24 Top = 2045 Width = 1350 End Begin glxpbuttonz.UserButtonz UserButtonz Height = 435 Left = 1485 TabIndex = 103 Top = 495 Visible = 0 'False Width = 690 _ExtentX = 1217 _ExtentY = 767 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Tahoma" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Caption = "Kick" IconHighLite = -1 'True IconHighLiteColor= 0 CaptionHighLite = -1 'True CaptionHighLiteColor= 0 Style = 1 Checked = 0 'False ColorButtonHover= 160 ColorButtonUp = 128 ColorButtonDown = 240 BorderBrightness= 2 ColorBright = 255 DisplayHand = -1 'True ColorScheme = 3 End Begin VB.CommandButton Drum BackColor = &H00EBEB75& Caption = "Sticks" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 22 Left = 3165 Style = 1 'Graphical TabIndex = 27 ToolTipText = "Physical Proximity Alert" Top = 2595 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00F7D46D& Caption = "Hand Clap" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 21 Left = 2340 Style = 1 'Graphical TabIndex = 26 ToolTipText = "Public Interface Mask" Top = 2595 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FFE1AA& Caption = "Tamb- orine" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 20 Left = 1485 Style = 1 'Graphical TabIndex = 25 ToolTipText = "Resource Cache Defense" Top = 2595 Width = 690 End Begin VB.CommandButton Drum Appearance = 0 'Flat BackColor = &H00FFADA5& Caption = "Jingle Bells" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 19 Left = 4845 Style = 1 'Graphical TabIndex = 23 ToolTipText = "Outer Ledger Sentry" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FFCCC9& Caption = "Cast- anets" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 18 Left = 4005 Style = 1 'Graphical TabIndex = 22 ToolTipText = "LOGISTICS" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FF83CD& Caption = "Shaker" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 17 Left = 3165 Style = 1 'Graphical TabIndex = 21 ToolTipText = "OPERATIONS" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FEACE1& Caption = "Triangle" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 16 Left = 2325 Style = 1 'Graphical TabIndex = 20 ToolTipText = "INTELLIGENCE" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00D778E7& Caption = "Cuica" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 15 Left = 1485 Style = 1 'Graphical TabIndex = 19 ToolTipText = "Drive Offline Isolation Node" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00EDA8EB& Caption = "High Block" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 14 Left = 4845 Style = 1 'Graphical TabIndex = 17 ToolTipText = "Outbound Exfiltration Sentry" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00B27DF6& Caption = "Low Block" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 13 Left = 4005 Style = 1 'Graphical TabIndex = 16 ToolTipText = "PLANS" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00CEAAF7& Caption = "Guiro" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 12 Left = 3150 Style = 1 'Graphical TabIndex = 15 ToolTipText = "GUERRILLA Command" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H009186F4& Caption = "Agogo" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 11 Left = 2325 Style = 1 'Graphical TabIndex = 14 ToolTipText = "PERSONNEL" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00BDABF8& Caption = "Timbale" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 10 Left = 1485 Style = 1 'Graphical TabIndex = 13 ToolTipText = "Infiltration Detection Buffer" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H007C9DF3& Caption = "High Conga" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 9 Left = 4830 Style = 1 'Graphical TabIndex = 12 ToolTipText = "Safehouse Perimeter Node" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00AAC5F7& Caption = "Low Conga" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 8 Left = 4005 Style = 1 'Graphical TabIndex = 11 ToolTipText = "COMMS" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H006ECAD5& Caption = "Crash" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 7 Left = 3165 Style = 1 'Graphical TabIndex = 10 ToolTipText = "Medical" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00A2E2DD& Caption = "Splash" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 6 Left = 2325 Style = 1 'Graphical TabIndex = 9 ToolTipText = "UNDERGROUND" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H0049F585& Caption = "Ride" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 5 Left = 1485 Style = 1 'Graphical TabIndex = 8 ToolTipText = "External Boundary Monitor" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H0082F6B0& Caption = "High Tom" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 4 Left = 4845 Style = 1 'Graphical TabIndex = 7 ToolTipText = "Propaganda/Information " Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H007EF14D& Caption = " Mid Tom" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 3 Left = 4005 Style = 1 'Graphical TabIndex = 6 ToolTipText = "Sabotage Prevention Check" Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H009BF296& Caption = "Low Tom" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 2 Left = 3165 Style = 1 'Graphical TabIndex = 5 ToolTipText = "Inbound Data Sieve" Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00C6EC4D& Caption = "Snare" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 1 Left = 2325 Style = 1 'Graphical TabIndex = 4 ToolTipText = $"frmDMDrums.frx":8E4C Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00CCED84& Caption = "Kick" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 0 Left = 1485 Style = 1 'Graphical TabIndex = 3 ToolTipText = $"frmDMDrums.frx":8EE2 Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00E7E753& Caption = "Scratch" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 23 Left = 4005 Style = 1 'Graphical TabIndex = 28 ToolTipText = "Ordnance/Supply Logistics Edge" Top = 2595 Width = 690 End Begin VB.CommandButton Drum BackColor = &H80000001& Caption = " High Q" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 24 Left = 4845 Style = 1 'Graphical TabIndex = 29 ToolTipText = "Final Exit Gateway / Air-Gap Severance" Top = 2595 Width = 690 End Begin MSComctlLib.Slider Slider1 Height = 1770 Left = 405 TabIndex = 2 Top = 60 Visible = 0 'False Width = 480 _ExtentX = 847 _ExtentY = 3122 _Version = 393216 Orientation = 1 Min = -1 End Begin VB.ListBox LIST_Grooves BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1860 ItemData = "frmDMDrums.frx":8F7D Left = -15 List = "frmDMDrums.frx":8F7F Style = 1 'Checkbox TabIndex = 1 Top = 15 Width = 1350 End Begin VolumeCtrl.VolumeControl VolumeControl1 Left = 0 Top = 0 _ExtentX = 1296 _ExtentY = 873 End Begin VB.Label LabelGrooves BackStyle = 0 'Transparent Caption = "+ grooves" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Index = 0 Left = -15 TabIndex = 18 ToolTipText = "Click togles GenreEnabled. Opp.Click Toggles TOH Recording." Top = 1845 Width = 3015 End End Begin VB.CommandButton StopCmd BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 390 Left = 3300 Picture = "frmDMDrums.frx":8F81 Style = 1 'Graphical TabIndex = 88 Top = 6525 Width = 390 End Begin VB.CommandButton Play BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 390 Left = 2805 Picture = "frmDMDrums.frx":9437 Style = 1 'Graphical TabIndex = 89 Top = 6540 Visible = 0 'False Width = 390 End End Attribute VB_Name = "frmDMDrums" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '\\ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '\\ '\\ Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved. '\\ '\\ File: frmPlayMotif.frm '\\ '\\ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Implements DirectXEvent8 Public cdlOpen As New frmCommonDialog Public AutoTempo_Visible As Boolean Public OnTop As Boolean Public Allmusic As String Public GenreEnabled As Long Public MovingPicturesXMLEnabled As Long Private p_DJReady As Boolean Private p_LabelBPM_ForeColor As Long Private Const DRUMPADSIZE As Long = 3240 Private m_bLabelBPM_Enabled As Boolean Public Property Get LabelBPM_ForeColor() As Long LabelBPM_ForeColor = p_LabelBPM_ForeColor End Property Public Property Let LabelBPM_ForeColor(ByVal LabelBPM_ForeColorObj As Long) If p_LabelBPM_ForeColor = LabelBPM_ForeColorObj Then Exit Property 'Or (p_LabelBPM_ForeColor = vbCyan And LabelBPM_ForeColorObj <> vbBlack) p_LabelBPM_ForeColor = LabelBPM_ForeColorObj Me.LabelBPM.ForeColor = LabelBPM_ForeColorObj ' Me.LabelBPM.BackColor = vbWhite - LabelBPM_ForeColorObj ' Me.LabelKey.BackColor = vbWhite - LabelBPM_ForeColorObj If Me.LabelBPM_ForeColor >= vbBlue Then '\\ see PreparingNextTrack If WA_GetShuffle = Zero Then WA_SetShuffle One End If ElseIf ListAdvanceColor <> vbYellow Then 'fixes m_bBeatmixer bug If WA_GetShuffle = One Then WA_SetShuffle Zero End If End If End Property Public Property Get DJReady() As Boolean DJReady = p_DJReady End Property Public Property Let DJReady(ByVal DJReadyObj As Boolean) p_DJReady = DJReadyObj Me.cmdSave.Visible = p_DJReady If p_DJReady = False And Not PF_Quiting Then SpeakThis "No DJ Helper Ready?" End If End Property Function BPMcolor(ByVal Difference As Single) As Long Select Case Abs(Difference) Case Is < Deci '\\ near Zero BPMcolor = vbBlack Case Is < One BPMcolor = vbRed Case Is < Two BPMcolor = vbOrange Case Is < Three BPMcolor = vbYellow Case Is < Four BPMcolor = vbGreen Case Is < Five BPMcolor = vbBlue Case Is < Six BPMcolor = vbMagenta Case Is < Seven BPMcolor = vbCyan Case Else BPMcolor = vbWhite End Select End Function Public Sub MouseupFormDrumColor(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Dim Color As Long Color = Int(((GetPixel(Me.hdc, x / xPixel, y / yPixel) - vbBlue) Mod vbGreen) / Eight) If Color <= 31 And Color >= Zero Then If Color < Two Then Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") Else Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") If Color <= ScheduleCol + One Then Color = Color - One End If End If fDoc(ScheduleMth).ZOrder fDoc(ScheduleMth).Visible = True ScheduleSync Color, (x - (Me.Drum((Color - Three) Mod Seven).Left - Sixty)) / Me.Drum(Zero).Width * TwentyFour End If End If End Sub Sub SetAutoTempoListIndex(ByVal Index As Long) Dim lWork As Long, Before As Single, After As Single AutoTempo.ListIndex = Index Before = EDIT_Tempo.Caption After = AutoTempo.list(AutoTempo.ListIndex) lWork = BPMcolor(Before - After) If lWork = vbRed And Int(Before) = Int(After) And Abs(Before - After) < Half Then lWork = Abs(Before - After) End If EDIT_Tempo.ForeColor = lWork EDIT_Tempo.BackColor = vbWhite - lWork End Sub Sub SetStation() Dim i As Long, J As Long, k As Long, l As Long J = Zero k = Six If optStation(k).value <> True Then 'UCase(Mid(m_CurrentGenreSorting, k, One)) <> "R" And For i = One To Five workbuffer = Mid(m_CurrentGenreSorting, i, One) If Asc(workbuffer) > 128 Then optStation(i).ForeColor = vbRed workbuffer = Chr$(Asc(workbuffer) Mod 128) Else optStation(i).ForeColor = vbBlack End If optStation(i).Caption = workbuffer l = Asc(UCase(optStation(i).Caption)) If l > J Then J = l k = i End If Next End If optStation(k).value = True optStation(k).BackColor = vbWhite Call SettingsSave(iniName, "Preferences", "GenreYearSortMask", m_CurrentGenreSorting) If m_TempoSelector <> -One Then Call SettingsSave(iniName, "Preferences", "GenreSortMask" & m_TempoSelector, m_CurrentGenreSorting) End Sub Public Sub TestForZeroVol() ' If VolSlider1.value = Zero Then ' QuitReader True ' here because no sound, even though this is done in HIDJOut ' Label3(One).ForeColor = vbBlue ' OneBell ' Else Label3(One).ForeColor = dmDrums.LabelVol.ForeColor '\\ vbBlue ' End If End Sub Private Sub chkMute_GotFocus() SetStatus chkMute End Sub Private Sub chkMute_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton Then Select Case chkMute.ForeColor Case vbRed '\\ LowerVolume VolSlider1.value = -InitialVolume chkMute.ForeColor = vbOrange Case vbCyan '\\ UpperVolume VolSlider1.value = -LowerVolume chkMute.ForeColor = vbRed Case Else '\\ vbOrange, vbGreen '\\ InitialVolume VolSlider1.value = -UpperVolume chkMute.ForeColor = vbCyan End Select ElseIf Button = vbLeftButton Then chkMute.value = Abs(One - chkMute.value) If chkMute.value = vbChecked Then VolumeControl1.Mute = True Else VolumeControl1.Mute = False End If End If End Sub Private Sub cmdBeatmix_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'Click to swap DRUMPADSIZE. Opp.Click to try to IngridMixSync or (Mid.Click) to start Beatmixing 'temposync' instance If Button = vbRightButton Then If m_bBeatmixer Then fHIDJ.IngridMixSync True Else SpeechThing = "Agent" frmTempoSync.Show vbModal End If ElseIf (Not m_bBeatmixer Or ListAdvanceColor = vbGreen) And (Button = vbMiddleButton Or (Shift = vbShiftMask And Button = vbLeftButton)) Then SpeechThing = "Agent" frmTempoSync.Show frmTempoSync.cmdOK = True Trickle.TrafficTimer.Interval = 30000 ElseIf Button = vbLeftButton Then With Me cmdPlayMotif = True If .frmPicture1(One).Top = Zero Then .lblDrumSize.Caption = "- drums ^" .frmPicture1(One).Top = DRUMPADSIZE If Abs(.Height - (.LabelVol.Top + .LabelVol.Height + 430)) < Sixty Then .Height = 6615 Else .Height = .Height + DRUMPADSIZE '+ 430 End If .Top = .Top - DRUMPADSIZE ' Fix the "Mist" from the CPU Freeze Drum(0).ToolTipText = "Intelligence" Drum(1).ToolTipText = "Counter-Intel" Drum(2).ToolTipText = "Logistics" Drum(3).ToolTipText = "Sabotage" Drum(4).ToolTipText = "Propaganda" Drum(5).ToolTipText = "Recruitment" Drum(6).ToolTipText = "Training" ' Drum(7) and (8) are already handled Drum(9).ToolTipText = "Safehouse" Drum(10).ToolTipText = "Infiltration" Drum(11).ToolTipText = "Exfiltration" ' ... and indices 21-24 for the remaining ROC layers ' SE Quadrant Triage Logic ' 20260209 ' Assuming Index 17 or 18 is your "Logistics" Triage Node Drum(18).ToolTipText = "Inner Triage: Logistics (ROC SE)" ' The two "expertise" drums it supports on the outer ring: Drum(4).ToolTipText = "Expertise: Finance / Resource Cache" Drum(23).ToolTipText = "Expertise: Ordnance / Supply" Else .lblDrumSize.Caption = "+ drums ^" .frmPicture1(One).Top = Zero If .Height = 6615 Then .Height = .LabelVol.Top + .LabelVol.Height + 430 Else .Height = .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height + 430 '\\ .Height - DRUMPADSIZE End If .Top = .Top + DRUMPADSIZE End If End With End If End Sub Private Sub cmdExternalHelper_Click(Index As Integer) If Index = Zero Then 'This function plays on a called shutdown and also on the hour of schedule entry. Opp.Click to play the whole Midi. or Reset Ingrid to stop, Mid.Click or (CtrlShift+Opp.Click) for Caruso If MsgBoxEx("This will rebuild the grid called MovingPicturesXML.ing", vbOKCancel) = vbCancel Then Exit Sub If chkLoop.value <> vbUnchecked Then dmSegMotif.SetRepeats INFINITE Else '\\ If chkLoop.value = vbUnchecked Then dmSegMotif.SetRepeats Zero End If perf.PlaySegmentEx dmSegMotif, Zero, Zero EnablePlayUI False DocSetupMovingPicturesXML MovingPicturesXMLPlay Else '"Caruso interprets sLastLockFilename on Gemini - Edge" Opp.click for Green toggle, Mid.Click or (CtrlShift+Opp.Click) for swotGPT Static CarusoTargetTitle As String Dim sCleanName As String Dim sYearMode As String ' 1. The Track: Identify the "Last Lock" sCleanName = sLastLockFilename ' Clean the path using the logic found in frmHIDJmain If InStrRev(sCleanName, "\") > 0 Then sCleanName = Mid$(sCleanName, InStrRev(sCleanName, "\") + 1) If InStrRev(sCleanName, ".") > 0 Then sCleanName = Left$(sCleanName, InStrRev(sCleanName, ".") - 1) GetCarusoSongData (sLastLockFilename) ' 2. The Marshalling: Check the "Car Radio" optStation(6) ' This reflects the [0-9]YYYY[0-9] vs [0-9][0-9]YYYY cold war If optStation(6).value = True Then sYearMode = "Strict-Y" Else sYearMode = "Relaxed-Y" End If ' 3. The sCamelot Key: Get the harmonic coordinate ' 4. Update the Sliver Monitor (frmPicture1) ' Hover over the sliver on your bike to see this: frmPicture1(One).ZOrder 0 ' Ensure it's in front of occluding controls frmPicture1(One).ToolTipText = "CUE: " & sCleanName & " | " & sYearMode & " | Key: " & sCamelot If SecondHand < -Twenty Then If iniName = vbNullString Then workbuffer = App.Title Else workbuffer = iniName End If workbuffer = "Readying " & workbuffer & " at " & Format(DateAdd("s", -SecondHand + Two, Now), "HH:MM:SS") Mid(workbuffer, Len(workbuffer)) = "0" Else workbuffer = SpokenTime End If workbuffer = workbuffer & Label3(One).Caption & " - Caruso interprets: '" & sCleanName & "' (" & sYearMode & ") Genre/Key: " & sGenre & "/" & sCamelot & ASpace & LabelBPM.Caption & ASpace & EDIT_Tempo.Caption & " ExternalHelper " & sCurrentDuration & "[Dur]" Debug.Print workbuffer If m_lAtenGreen Then workbuffer = workbuffer & vbCrLf & "CARUSO PROTOCOL ACTIVATED" & vbCrLf & _ "Node: 5700G" & vbCrLf & _ "Status: " & IIf(m_lAtenGreen, "LOCKED", "OPEN") & vbCrLf & _ "Gear: " & frmTrickle.TrafficTimer.Interval & vbCrLf & _ "Veneer: Edge/Matrix Bridge" Call SendMatrixPulse(workbuffer) Exit Sub Else Clipboard.Clear Clipboard.SetText workbuffer ' The train has its fangs; proceed with PushKeys to hCarusoHelper ' Call ExecuteAutomatedPushKeys(hCarusoHelper) SixorSeven9Smith = True ' Manual CNT, or Auto Notepad, or Edge If Caruso2NotePad2Edge(CarusoTargetTitle) Then ' // Only now do the PushKeys fire PushKeys "^{end}+{enter}", hCarusoHelper PushKeys "^v<[systime=", hCarusoHelper Delay Half PushKeys "%+{F12}" ', hCarusoHelper ' changing the order from +% to %+ fixed an earlier character drop Delay Half ' delay includes a doevents PushKeys "]+{enter}", hCarusoHelper Sleep Two PushKeys "{enter}", hCarusoHelper End If Exit Sub End If On Error Resume Next AppActivate "Edge" 'Google Gemini - Microsoft If Err.number = 0 Then ' 5. The Handoff to Edge (Silent DJ Mode) 'I set the color to green only mouse down and the final {Enter} 'WinampPlay will only send If .LowerVolPreset 'will only when GetToolbox says all on many-chat turned to green 'should the final {Enter} be sent. So, several layers of protection and 'you don't need to worry about getting flooded. Else ' Log if the browser is closed or renamed OneBell "Edge Island Disconnected: " & time cmdExternalHelper(Zero).BackColor = vbRed End If End If End Sub Private Sub cmdPlayPause_Click(ByRef Index As Integer) Dim lWork As Long ' Left.Click toggles/holds Winamp on/off. Mid.Click starts Winamp and Direct Music Drums. If Index = One Then ' If Button = vbRightButton Then ' UpDown_Volume.Tag = Timer ' GlobalPlayPause If DMStatus = One Then WA_Pause If Me.UpDown_Volume.value > One Then SetReaderVolume = Me.UpDown_Volume.value Me.UpDown_Volume.value = One Else '\\ If Me.UpDown_Volume.value <= One Then HIDJPlay If SecondsLeft > Ten Then 'Thirty 20120803 prevent global pause anomaly Me.UpDown_Volume.value = SetReaderVolume End If End If ' PlayStateChange = Billion 'this flag is to enable a global play/pause facility - 20120803 ' FreshPlot "Perturbate", , True ElseIf IngridLoaded Then '20120813 bug If inGrid.mnuViewDMDrums.Checked = False Or DJReady = False Or cmdSave.Enabled = False Then DJReady = True cmdPlayMotif.Visible = False Ingrid_mnuViewDMDrums_Checked True cmdSave.Enabled = True lWork = StartingHeyIngridDJ cmdPlayMotif.Visible = True '\\ just in case turned off while doevents Ingrid_mnuViewDMDrums_Checked True 'why twice? DJReady = True hWndWinamp = Zero '\\ incase -1 closed If fHIDJ.CheckWinamp(True) Then DJHelper 1, True End If End If If DMStatus <> One Or LowerVolPreset Or TrackSelected = True Then HIDJPlay If Me.UpDown_Volume.value <= One And SetReaderVolume <> Zero Then Me.UpDown_Volume.value = SetReaderVolume End If Else ScreenOff If GridOut.Timer1.Interval > Zero Then GridOut.Timer1.Enabled = False GridOut.Timer1.Interval = One GridOut.Timer1.Enabled = True SendSound "hyoshigi1.wav", , True If Abs(CycleZ) < Half Then spin End If Me.Play = True End If TrackSelected = False End If ' GlobalPlayPause Exit Sub errorline: ' stop DJHandle = -One End Sub Private Sub CommandGridArt_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'Right.Click Perturbates the whole system and sets Winamp Shuffle ON+Auto Advance. Left.Click (or Left+mask) toggles the KarmaGun (+shift=FullScreen or x&y<100). (Mid.Click a title in HeyIngridDJ = JumpToFile) If Button = vbMiddleButton And Shift = Zero Then '20241121 because of dead MiddleButton Button = vbLeftButton ElseIf Button = vbLeftButton And Shift = Zero Then Button = vbMiddleButton End If Call MouseUp_CommandGridArt(Button, Shift, x, y) End Sub Private Sub EDIT_Tempo_Change() EDIT_Tempo.ForeColor = vbRed EDIT_Tempo.BackColor = RGB(31, Zero, 15) Call ChangeTempo(EDIT_Tempo.Caption) '\\ SongTempo End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If PF_Ending Then Exit Sub Cancel = True Close_MouseUp One End Sub Private Sub Form_Resize() ' If Me.WindowState = vbMinimized And inGrid.mnuViewDMDrums.Checked = True Then ' Me.WindowState = vbNormal ' End If End Sub Private Sub imgLogo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton Then Dim Color As Long Dim lWork As Long, nVal As Long With frmDrumDown .SetDrumDownPictures .Show End With ' Me.AutoRedraw = False '' Me.Frame2.Visible = False ' Me.Refresh ' Color = GetPixel(Me.hdc, (x + imgLogo.Left) / xPixel, (y + imgLogo.Top) / yPixel) '' Me.Frame2.Visible = True ' Me.AutoRedraw = True ' ' Do While True ' For lWork = One To Two ' For nVal = One To Twelve ' If Color = g_arCamelotRGB(nVal, lWork) Then Exit Do ' Next ' Next ' ' Exit Sub ' Loop ' Me.LabelKey.ForeColor = Color ' Me.LabelKey.Caption = format(nVal, "00") & Chr$(64 + lWork) ElseIf Button = vbLeftButton Then Me.Frame2.Visible = True Me.imgLogo.Visible = False End If End Sub Private Sub Label3_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) ForceForegroundWindow Me.hwnd End Sub Private Sub LabelAlign_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then EnqueuedAt = Val(InputBox("EnqueuedAt", "Set value higher than zero to play to end of playlist", EnqueuedAt)) Call SettingsSave(iniName, "Music", "EnqueuedAt", EnqueuedAt) Exit Sub ElseIf Button = vbMiddleButton Then Select Case ListAdvanceColor Case vbGreen ListAdvanceColor = vbRed Case vbOrange ListAdvanceColor = vbYellow End Select PlaylistAdvance True ElseIf Button = vbRightButton Then If HIDJLoaded Then fHIDJ.PopupMenu fHIDJ.mnuPopupListAdvance End If End If 'to manually sever beatmixing If ListAdvanceColor = vbGreen Then dmDrums.LabelAlign.ForeColor = &H80FF80 Call SettingsSave(iniName, "Music", "ListAdvanceColor", vbBlack) 'black is the new green startup condition End If End Sub Private Sub lblDrumSize_Click() OnTop = Not OnTop If OnTop Then FrontFalseMe = True lblDrumSize = "on top" If TrickleLoaded Then Trickle.Visible = True End If Else FrontTrueMe = True lblDrumSize = "+ drums ^" If TrickleLoaded Then Trickle.Visible = False End If End If End Sub Private Sub lblDrumSize_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If Me.Height <> Me.frmPicture1(One).Top + Me.cmdBeatmix.Top + Me.cmdBeatmix.Height Then Me.lblDrumSize.Caption = "+ drums ^" Me.Height = Me.frmPicture1(One).Top + Me.cmdBeatmix.Top + Me.cmdBeatmix.Height + 430 '\\ 2790 End If End Sub Private Sub lblDTStatus_Click() SetTrickle Trickle.RunAsScr = vbChecked dmDrums.DTPicker1.Visible = True End Sub Private Sub Option1_Click(Index As Integer) VolumeControl1.DeviceToControl = Index If VolumeControl1.Mute = True Then chkMute.value = vbChecked Else chkMute.value = vbUnchecked End If End Sub Private Sub optStation_GotFocus(Index As Integer) SetStatus optStation(Index) End Sub Private Sub optStation_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) optStation(Index).SetFocus End Sub Private Sub optStation_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) ' Opp.Click toggles upper/Lowercase for strict Year sort or not Call MouseUp_optStation(Index, Button) End Sub Private Sub UserButtonz_Click() UserButtonz.ForeColor = vbYellow End Sub Private Sub UserButtonz_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Call GetCursorPos(MousePos) ButtonzLastTop = MousePos.y * Screen.TwipsPerPixelY ButtonzLastLeft = MousePos.x * Screen.TwipsPerPixelX End Sub Private Sub UserButtonz_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Call GetCursorPos(MousePos) If ButtonzLastTop > Zero Then UserButtonz.Top = UserButtonz.Top - ButtonzLastTop + MousePos.y * Screen.TwipsPerPixelY If Me.Height - UserButtonz.Height > UserButtonz.Top Then ButtonzLastTop = UserButtonz.Top If ButtonzLastLeft > Zero Then UserButtonz.Left = UserButtonz.Left - ButtonzLastLeft + MousePos.x * Screen.TwipsPerPixelX If Me.Left - UserButtonz.Width > UserButtonz.Left Then ButtonzLastLeft = UserButtonz.Left End Sub Private Sub VolSlider1_Change() VolumeControl1.Volume = -VolSlider1.value TestForZeroVol End Sub Private Sub VolSlider1_GotFocus() SetStatus VolSlider1 End Sub Private Sub VolSlider1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If VolSlider1.Top = Zero Then Exit Sub '\\ i.e., parent not set to vbMaximized frmDocument ForceForegroundWindow Me.hwnd If Me.Height <> Me.frmPicture1(One).Top + Me.cmdBeatmix.Top + Me.cmdBeatmix.Height + 430 Then ElseIf Me.frmPicture1(One).Top = Zero Then Me.lblDrumSize.Caption = "- drums ^" Me.Height = 2790 Else Me.lblDrumSize.Caption = "- drums ^" Me.Height = 6615 End If Me.VolSlider1.SetFocus End Sub Private Sub VolSlider1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbMiddleButton Then SetMonitorPower mpOff, True ElseIf Button = vbRightButton Then Select Case chkMute.ForeColor Case vbRed '\\ LowerVolume LowerVolume = VolumeControl1.Volume Case vbOrange, vbGreen '\\ InitialVolume InitialVolume = VolumeControl1.Volume Case vbCyan '\\ UpperVolume UpperVolume = VolumeControl1.Volume End Select End If End Sub Private Sub VolSlider1_Scroll() VolumeControl1.Volume = -VolSlider1.value TestForZeroVol End Sub Private Sub VolumeControl1_MuteChanged(NewMute As Boolean) If VolumeControl1.Mute = True Then chkMute.value = vbChecked Else chkMute.value = vbUnchecked End If End Sub Private Sub VolumeControl1_VolumeChanged(NewVolume As Long) On Error GoTo errorline If VolSlider1.value <> -NewVolume Then VolSlider1.SetFocus If VolSlider1.value > -NewVolume Then If ReadDoc > Zero Then If Val(fDoc(ReadDoc).cmdSpeak.Caption) > Zero Then Call Front(False, fDoc(ReadDoc)) '\\ so keyboard will work fDoc(ReadDoc).DocText.SetFocus End If End If End If If NewVolume = InitialVolume And MP3Off = Zero Then '\\ set shutdown times wait If Play.Visible = False Then '\\ flag for start or end of raising volume instance UpDown_Fine_Tempo.value = SettingsGet(iniName, "Music", "Fine_Tempo", Zero) Play.Visible = True End If If TrickleLoaded Then MP3Off = Trickle.Laps.value * Trickle.Wait.value Trickle.lblMinPerInt.ForeColor = vbGreen Trickle.lblIntervals.ForeColor = vbGreen End If ElseIf MP3Off <> Zero And TrickleLoaded Then If Trickle.lblIntervals.ForeColor = vbGreen And VolSlider1.value < -NewVolume Then Trickle.lblIntervals.ForeColor = vbRed ElseIf Trickle.lblIntervals.ForeColor = vbRed And VolSlider1.value > -NewVolume Then Trickle.lblIntervals.ForeColor = vbGreen End If End If End If VolSlider1.value = -NewVolume '\\ here because lower down causes delayed resetting? Static LastTime As Single sAns = Timer If sAns - LastTime > Ten And UpperVolPreset Then '\\ otherwise agentsvr seems to crash If fAgent Is Nothing Then Load fAgent End If If LastTime = Zero Then fAgent.SetUpAgent "Volume Set at " & NewVolume, False fAgent.TheAgent.Listen True LastTime = sAns End If TestForZeroVol Exit Sub errorline: ' stop Dim lWork As Long lWork = Err If lWork = -2147418094 Then Unload fAgent If inDesign Then Stop Load fAgent fAgent.SetUpAgent "Hello again", False Resume Next End If End Sub Public Sub HitDrum(ByRef Index As Integer) On Error GoTo errorline '\\ If inGrid_ForDoEvents_BackColor <> vbBlack Then Call perf.PlaySegmentEx(segMotif(Index), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, Zero) If Me.Drum(Index).BackColor <> BackFace Then Me.Drum(Index).BackColor = BackFace Exit Sub End If Exit Sub Resume errorline: ' stop End Sub Sub RandomPlay() Dim lWork As Long Me.Play = True PerturbateOff = KarmaGunAfterStartup ' False lWork = Perturbate(, True) End Sub Sub ResetDrum(ByRef Index As Integer) Static item As Long If item = Index Then Exit Sub item = Index HitDrum Index If Me.Drum(Index).BackColor <> BackFace Then If inGrid_ForDoEvents_BackColor = OffGray Then Me.CPUUsage.Height = Me.CPUUsage.Height * Half End If End If SetStatus Drum(Index) End Sub Function PreparingNextTrack() As Boolean Dim lWork As Long On Error GoTo errorline Static DidItLastTime As Single QuitAnyLiveRecording If PF_Quiting Then GoTo ExitFunction If dmDrumsLoaded Then With dmDrums DMStatus = HIDJstatus '\\ DMStatus = ' Static SecondsLeftPrev As Long ' If SecondsLeftPrev = SecondsLeft And SecondsLeft > Zero Then ' Stop ' End If ' SecondsLeftPrev = SecondsLeft '\\ If Abs(CycleZ) > Half Then sTime = Timer ' SecondsLeft = Int(LastPerturbate + DEG - sTime) If DMStatus = Zero Then '\\ sTime - LastPerturbate >= DEG (SecondsLeft < Zero Or ) 'touchbug hunt If inDesign And Not True Then workbuffer = Mid(sLastLockFilename, InStrRev(sLastLockFilename, "\") + One) workbuffer = Left(workbuffer, Len(workbuffer) - Four) If workbuffer <> TaskNameEx(hPlayingFileName) Then If GridOut.Caption <> workbuffer Then GridOut.Caption = workbuffer OneBell "TaskNameEx(hPlayingFileName)" Else Call sndPlaySound(SoundDir & "ticking.wav", SND_ASYNC + SND_NOSTOP) End If End If End If workbuffer = vbNullString If Dir(Left(sLastLockFilename, InStr(sLastLockFilename, "\")), vbDirectory) = "" Then If MP3Off >= Zero Then If Not KarmaGunLoaded Then HIDJOut , True GoTo ExitFunction End If If m_bBeatmixer And Not SlaveBot And .LabelKey.ForeColor = vbOrange And Not PF_Ending Then ' ' this allows for immediate play of only second song HIDJNext HIDJPlay .LabelKey.ForeColor = vbGreen 'just because m_bBeatmixer not always safe Call SongTime(1020, True) If Not XDoEventsX Then FreshPlot "Perturbate", , True Exit Function End If If Mp3PlayDoc > Zero Then Do Do On Error Resume Next If SecondsLeft < Ten Then '\\ DMStatus = Zero Or If SecondHand < Zero Then If Abs(SecondHand - LastSecondHand) > Twenty Then 'Ten '\\ looking for missing minute bug If LastSecondHand < -Ten Then .RandomPlay ' End If End If LastSecondHand = SecondHand End If Static NextHalfMinute As Single If sTime + One >= NextHalfMinute Then '\\ OnePoint may be causing double entry by if XDoEventsX then exit sub '\\ 20111129 & 2007/01/09 & 2007/03/13 hopefully fixes nasty nasty lost minute looping bug If ExtraSeconds <> Zero And NextHalfMinute + Thirty > sTime Then ' i.e., within the current track ExtraSeconds = ExtraSeconds - Thirty End If SecondHand = SecondHand + One 'wtf? .Label3(Five).ToolTipText = ExtraSeconds NextHalfMinute = (Int((sTime + Ten) / Thirty) + One) * Thirty Else SecondHand = sTime Mod Thirty - ExtraSeconds End If If NextHalfMinute - sTime > Thousand Then 'after midnight? NextHalfMinute = (Int((sTime + Ten) / Thirty) + One) * Thirty End If .Label3(One).Caption = RealTime(SecondHand) .Label3(Zero).Caption = .Label3(One).Caption .Label3(Five).Caption = .Label3(One).Caption If LastSecondHand = DaySeconds Then If .UpperVolPreset And m_ManualTrackAdvance Then '\\ first time? '\\ this favors m_bBeatmixer so both instances don't get locked at high volume '\\ unless so desired If CBool(SettingsGet(iniName, RegSettings, "FadeVolume", True)) Then lWork = WinAmpControls("LessVolume", , False) End If TrackSelected = True End If End If If Mp3FilenameNowPlaying <> NotString Then If MP3Off = One Then '\\ +ve to close rather than shutdwn If Not KarmaGunLoaded Then '20220127 20260109 True Then HIDJOut ' , True'20220206 GoTo ExitFunction Else MP3Off = Zero End If ElseIf MP3Off = -One Then 'manual power off condition MP3Off = Zero End If SpecialSeconds = SpecialSeconds - One If SpecialSeconds > Zero Then GoTo ExitFunction End If If Not m_ManualTrackAdvance Then If EndOfTracks < Two Then GoTo ExitFunction If Not HIDJNext Then GoTo ExitFunction If WA_IsPlaying = Zero Then HIDJPlay '\\ what's this? End of Playlist. I thought Freshplot twice to say, "Hey, Ingrid DJ", toggle off other equalizer. FreshPlot End If Else If TrackSelected = False Or .LabelBPM_Enabled = False Then '\\ acting flag was set false in GetToolbox when > 6% lWork = InStr(One, Mp3FilenameLastSpoken, "\genre", vbTextCompare) Genreholder = "" If lWork > Zero Then Mp3FilenameLastSpoken = MidSong(Mp3FilenameLastSpoken, lWork + One) If dmDrumsLoaded Then If dmDrums.LabelBPM_Enabled Then '\\ just ended song and will only do this once cause genre stripped If EndOfTracks < Two Then GoTo ExitFunction '\\ OneBell MP3ID3v2Tag.MP3File = Mp3FilenameNowPlaying SpeakThisWhenever = g_arID3v1Genres(MP3ID3v1Tag.Genre) & ". " & MP3ID3v2Tag.OtherGenreName & ". In " & m_sCamelotKey & ". " & Mp3FilenameLastSpoken ' SpeakThis Mp3FilenameLastSpoken workbuffer = vbNullString If TrickleLoaded Then workbuffer = Trickle.lblDunAllow.ToolTipText If workbuffer <> NotString Then workbuffer = workbuffer & ". " End If fAgent.SetUpAgent workbuffer & SpeakThisWhenever, False 'Mp3FilenameLastSpoken If Not .Genre.Selected(.Genre.ListIndex) And .GenreEnabled = Two Then '\\ play all but shuffle after deselected items - see GenreSelected '\\ ElseIf Not GenreSelected And .cmdBeatmix.Caption = "Biasmix" Then If .LabelBPM_ForeColor >= vbBlue Then '\\ see PreparingNextTrack If WA_GetShuffle = Zero Then WA_SetShuffle One fAgent.TheAgent.Show SpeakThis "Shuffling on " & .Genre.list(.Genre.ListIndex) End If End If '\\ GenreSelected = True ' Exit Do End If ' .lblDrumSize.ToolTipText = Mp3FilenameLastSpoken '\\ also save here any BPMLEARNING codes and '\\ check that global status was confirmed to be needing a switch End If End If End If If (Abs(SecondHand) Mod Ten) < OnePointTwo And Abs(SecondHand) > Two Then 'OnePointTwo If DidItLastTime < Zero Then If Not m_bBeatmixer Or DelayTrackSelection >= Two Then If PF_Ending Then GoTo ExitFunction ComingUp TrackSelected = True '\\ maybe turned off by jtfe media item .LabelBPM_Enabled = True Else If Not DelayVolSliderFlag Then 'stops two songs playing through bug If .UpperVolPreset And Beatmixing Then '20220903 todo add "And MP3Off <> -One" first play test added to stop Slavebot playing during interrupted play If SecondHand > Zero And .LabelKey.ForeColor <> vbOrange Then 'if this happens more than Four times then assume a mixup and just play. Static lMixup As Long lMixup = lMixup + One If lMixup > Four + Abs(SlaveBot) Then 'so both sides don't start together lMixup = Zero HIDJRealNext ' ReduceMP3Off HIDJPlay Call SongTime(1020, True) If Not XDoEventsX Then FreshPlot "Perturbate", , True Exit Function End If ' If inDesign Then Stop Else Call WinAmpControls("LessVolume", , False) End If End If End If DelayTrackSelection = DelayTrackSelection + One End If DidItLastTime = sTime PreparingNextTrack = True Exit Function End If End If ElseIf Abs(SecondHand) < OnePointTwo Then If Not ((LastSecondHand > -Five And .LabelKey.ForeColor <> vbRed) Or Not m_bBeatmixer) Then 'LastSecondHand = SecondHand means not just back from IngridMixSync and above twenty second mark. WA_SetShuffle Zero TrackSelected = False ' ElseIf SlaveBot And .LabelKey.ForeColor = vbOrange Then ' dmDrums.LabelBPM_Enabled = False ' FreshPlot "Perturbate", , True ' fHIDJ.IngridMixSync ' HIDJNext 'first song bug? ' TrackSelected = False ElseIf Val(.Label3(Five).ToolTipText) = Zero Or ListAdvanceToGreenOnPlay Then '\\ Sixty - SecondHand < OnePointTwo Or - PointTwo'And SecondHand >= Zero'And ExtraSeconds = Zero ReduceMP3Off HIDJPlay End If ElseIf TrackSelected = True And (Abs(SecondHand) Mod Ten) < OnePointTwo Then If DidItLastTime < Zero Then DidItLastTime = sTime LastSecondHand = SecondHand If bEnqueuedTrackWaiting Then .LabelKey.ForeColor = vbGreen 'Cyan Else If .cmdPlayPause(One).BackColor = vbGreen And .LabelKey.ForeColor = vbRed Then If m_bBeatmixer And m_AutoDJActive Then fHIDJ.IngridMixSync ' If .LabelKey.ForeColor = vbRed Then 'not set to Coalface by above If .cmdBeatmix.Tag = vbGreen Then 'not set to Coalface by above If SecondHand > -Thirty Then 'last chance to set correct crossfade ' Call sndPlaySound(SoundDir & "ticking.wav", SND_ASYNC + SND_NOSTOP) ' ExtraSeconds = Zero FreshPlot "Perturbate", , True ' ManyChat.TimerSendData 'don't rely on doevents ' .cmdBeatmix.Tag = CoalFace ' not before because Freshplot resets it 'checks that other things require setting or does nothing '\\ NOT - see doittoit DelayVolSliderFlag '\\ this is where to put the thirty second tempo slider End If End If End If End If End If Exit Function End If End If ' If PreparingNextTrack Then Exit Do GoTo ExitFunction End If Else If Not HIDJNext Then GoTo ExitFunction ' If SecondsLeft < Zero And .UpperVolPreset And m_ManualTrackAdvance Then ' '\\ first time? ' '\\ this favors m_bBeatmixer so both instances don't get locked at high volume ' lWork = WinAmpControls("LessVolume", , False) ' End If End If End If gAns = SongTime(22, False) If gAns > Zero And gAns < Sixteen Then Delay One If gAns >= Ten Then Sleep 500 If DMStatus = One Then '\\ if not perturbate then GoTo exitfunction Else PreparingNextTrack = True End If End If End If Exit Do Loop gAns = SongTime(23, False) ' If GridOut.Timer1.Enabled = False Then ' GoTo exitfunction Else ' End If If .Genre.Selected(.Genre.ListIndex) Or .GenreEnabled = Zero Then Exit Do ElseIf Not .Genre.Selected(.Genre.ListIndex) And .GenreEnabled = One Then '\\ play but do not beatmix Exit Do ElseIf Not .Genre.Selected(.Genre.ListIndex) And .GenreEnabled = Two Then ' '\\ play all but shuffle after deselected items - see GenreSelected '' ElseIf Not GenreSelected And .cmdBeatmix.Caption = "Biasmix" Then ' If .LabelBPM_ForeColor = vbGreen Then '\\ see PreparingNextTrack ' If WA_GetShuffle = Zero Then ' WA_SetShuffle One ' SpeakThis "Shuffling on " & .Genre.list(.Genre.ListIndex) ' End If ' End If '' GenreSelected = True Exit Do ElseIf gAns = -One Then If WA_GetListLength <= WA_GetListPos Then WA_StartPlay Else If Not HIDJNext Then GoTo ExitFunction End If Else If Not HIDJNext Then GoTo ExitFunction End If If GridOut.Timer1.Enabled = False Then GoTo ExitFunction End If Loop Else If Mp3PlayDoc = Zero Then .GenreEnabled = CBool(SettingsGet(iniName, "Music", "Genre.Enabled", True)) If .GenreEnabled Then .SetGenreEnabled '\\ .SetGenreSelected Else Mp3PlayDoc = -Thousand End If End If gAns = SongTime(24, False) If gAns > Zero And gAns < Ten Then HIDJStop End If If (gAns < -One Or gAns > Zero) And WA_IsPlaying = Zero Then '\\ smoothes joint control If Not HIDJNext Then GoTo ExitFunction End If SongTime 25, False End If If Abs(sTime - LastPerturbate) < Thousand And LastPerturbate > Hundred Then '\\ how's this work? s/b Zero Then ' workbuffer = " at Number " & Mp3Off ' End If ' If ReadDoc = Zero And (.LIST_Grooves.ListIndex = -One Or .LIST_Bands.ListIndex = -One) Then ' SpeakThisWhenever = .Genre.list(.Genre.ListIndex) & " track " & .Caption & ". " & .Genre.list(.Genre.ListIndex) & " track " & MidSong(Mp3FilenameNowPlaying) & workbuffer '\\ , (workbuffer <> NotString) ' ElseIf ReadDoc > Zero And .Genre.ListIndex < .Genre.ListCount - One And Not TrackSelected Then ' If fDoc(ReadDoc).Watcher_Caption <> StopWatchCaption Then ' SpeakThisWhenever = .Caption & workbuffer '\\ , (workbuffer <> NotString) ' Else ' SpeakThisWhenever = Left$(.LabelGrooves(One).ToolTipText, Four) & .Genre.list(.Genre.ListIndex) & " track " & workbuffer '\\ , (workbuffer <> NotString) ' End If ' Else ' '\\ what's this? End of Track. I thought Freshplot twice to say, "Hey, Ingrid DJ", toggle on other equalizer. ' '\\ FreshPlot ' FreshPlot ' If LastSecondHand <> DaySeconds Then ' TrackSelected = False ' Else ' dmDrums.cmdBeatmix.Visible = True ' End If ' SpeakThisWhenever = .Caption & ". " & MidSong(Mp3FilenameNowPlaying) & workbuffer '\\ , (workbuffer <> NotString) ' End If ' ' End If ' If Not Perturbate Then GoTo exitfunction Else Else LastPerturbate = sTime - DEG + Val(SettingsGet(App.Title, "Preferences", "AutoDJTime", Thirty)) End If PreparingNextTrack = True End If ExitFunction: .DTPicker1.value = Now DidItLastTime = -sTime End With End If Exit Function Resume errorline: ' stop gAns = Err If gAns = -2147418107 Then SetScrollText "Hey, Ingrid D.J. WAKEUP!!" Else SetScrollText gAns & " PreparingNextTrack" End If End Function Sub AutoBPM() Dim lWork As Long Dim sngRet As Single If Me.Caption <> "DMDrums" And Len(Me.Label3(One).Caption) > One Then sngRet = Rnd If sngRet > PointSeven Then With GridOut If .Timer1.Enabled = True Then .Timer1.Enabled = False sngRet = inGrid.TimeStep.value If sngRet > Zero Then .Timer1.Interval = Thousand Else '\\ a factor of eleven somehow skips a beat .Timer1.Interval = lMin(60000, .Timer1.Interval - sngRet * Ten - sngRet) End If .Timer1.Enabled = True End If End With ElseIf sngRet > PointSeven Then Me.Label3(Zero).Caption = Space(Ten) & Me.Caption End If End If '\\ now to see if Ingrid will automatically save the median tempo '\\ with all the sounds off and running in the background at +50% this is quick. '\\ where Mid.Clicking the finetempo has set the speed to the max. '\\ make sure at least thirty seconds have elapsed since the start of the song so we have AutoBPM If Me.AutoTempo.ListCount = Zero Then If ListAdvanceColor = vbGreen Then dmDrums.EDIT_Tempo.Caption = "255" End If End If Call SongTime(2, False, , , sngRet) lWork = DJHelper(2, False) If lWork <= Zero Then Exit Sub 'not using Leo's DJ Helper End If If sngRet = Zero Then Me.optImmediate = True Me.Frame2.Visible = True Me.imgLogo.Visible = False dmdrums_autotempo_backcolor = vbButtonFace Me.Slider2.Enabled = False ElseIf Me.AutoTempo.ListCount = Zero And Left$(Me.LabelGrooves(One).ToolTipText, Seven) Like "###.##%" Then '\\ And Me.optDefault = True If SongAnalysedFromStart = vbUnchecked Then SongAnalysedFromStart = vbChecked SongTime 3, True If optImmediate <> True And UpDown_Fine_Tempo.value <> Zero Then If LabelBPM_ForeColor < vbBlue Then WA_SetShuffle Zero Else WA_SetShuffle One End If End If End If Me.optDefault = True End If sngRet = Val(TaskNameEx(hAutomaticBPM)) If sngRet = Zero Then '\\ a flag can go here to prove the whole song was analysed If dmDrums.AutoTempo.ListCount > Two Then Call DJHelper(3, True) 'in case Leo's DJ HElper plugin deselected SongAnalysedFromStart = vbUnchecked 'False End If Exit Sub End If '\\ An instruction - should this be shown again as a non modal form to allow sampling workbuffer = Format(sngRet / (One + UpDown_Fine_Tempo.value / Thousand), "000.00") Me.AutoTempo.AddItem workbuffer sngRet = Me.AutoTempo.ListIndex - Int((Me.AutoTempo.ListCount - One) / Two) '\\ manually induced median offset Me.Slider2.Min = -One Me.Slider2.value = Zero Me.Slider2.Max = Me.AutoTempo.ListCount - One Me.Slider2.Enabled = True If Me.AutoTempo.ListIndex >= Zero Then SetAutoTempoListIndex lMax(Zero, Me.AutoTempo.ListIndex) If sngRet <= One Then SetAutoTempoListIndex Int((Me.AutoTempo.ListCount - One) / Two) Else sngRet = sngRet + Int((Me.AutoTempo.ListCount - One) / Two) SetAutoTempoListIndex Me.AutoTempo.ListIndex + (sngRet + Sgn(Me.AutoTempo.list(Me.AutoTempo.ListIndex) - Me.AutoTempo.list(Me.AutoTempo.ListIndex + sngRet))) End If Else If Me.AutoTempo.ListCount > Zero Then SetAutoTempoListIndex Int((Me.AutoTempo.ListCount - One) / Two) End If Me.Slider2.value = Me.AutoTempo.ListIndex If Me.LabelGrooves(One).ToolTipText = Me.AutoTempo.list(Me.AutoTempo.ListIndex) Then Static BadEqualizerCount As Long BadEqualizerCount = BadEqualizerCount + One Else BadEqualizerCount = Zero End If If BadEqualizerCount > 3 Then OneBell "BadEqualizerCount" Me.LabelGrooves(One).ToolTipText = Me.AutoTempo.list(Me.AutoTempo.ListIndex) & "%" & Mid$(Me.LabelGrooves(One).ToolTipText, Eight) If Me.optImmediate = True Then '\\ initial learning Call SongTime(4, True, , , Me.AutoTempo.list(Me.AutoTempo.ListIndex)) End If End Sub Function DrumsMove(Optional ByVal positioned As Boolean = False) As Boolean Dim TopGrid As Long, NewLeft As Long '\\ , i As Long SaveTop As Single, SaveLeft As Single, If Not positioned Then SaveLeft = Me.Left SaveTop = Me.Top End If NewLeft = lMax(One, SaveLeft + SaveX) '\\ lmax(one is to enable a minus flag to be set if drums are not shown full size Me.move NewLeft, lMax(One, lMax(One, SaveTop + SaveY)) If Me.Height <> 6615 Then SaveY = Zero Else DrumsMove = True End If If Not ManyChat Is Nothing Then If Abs(ManyChat.Left - SaveLeft) < Hundred Then ManyChat.move Me.Left, ManyChat.Top + SaveY End If End If If TrickleLoaded Then If Trickle.WindowState = vbNormal Then If Abs(Trickle.Left - SaveLeft) < Hundred Then Trickle.move Me.Left, Trickle.Top + SaveY, Me.Width ElseIf Abs(Trickle.Left - (Me.Width + SaveLeft)) < Hundred Then Trickle.move Me.Left + Me.Width, Me.Width ElseIf Abs(Trickle.Left + Trickle.Width - SaveLeft) < Hundred Then Trickle.move Me.Left - Trickle.Width, Me.Width End If End If End If If Not fBoard Is Nothing Then If fBoard.WindowState = vbNormal And Abs(fBoard.Left - SaveLeft) < Hundred Then fBoard.move Me.Left, fBoard.Top + SaveY End If End If If Abs(inGrid.Top - SaveTop) < Hundred Then '\\ inGrid.Hide inGrid.move Me.Left, lMax(One, SaveTop + SaveY) ElseIf Abs(inGrid.Top - (SaveTop - Thousand)) < Hundred Then If Me.Top + Me.Height > Screen.Height Then ' some weird false startup condition inGrid.move Me.Left Else inGrid.move Me.Left, lMax(One, SaveTop + SaveY) - Thousand End If ElseIf Abs(inGrid.Left - SaveLeft) < Hundred Then inGrid.move Me.Left, inGrid.Top + SaveY ElseIf Abs(inGrid.Left - Abs(Me.Width + SaveLeft)) < Hundred Then inGrid.move Me.Left + Me.Width ElseIf Abs(inGrid.Width - Abs(inGrid.Left - SaveLeft)) < Hundred Then inGrid.move Me.Left - inGrid.Width End If If GridOut.WindowState = vbNormal Then If Abs(GridOut.Left - (SaveLeft + Me.Width)) < Hundred Then If Abs(GridOut.Top - inGrid.Top) < Hundred Then TopGrid = inGrid.Top + SaveY ElseIf Abs(GridOut.Top) > Hundred Then TopGrid = GridOut.Top + SaveY End If If Abs(Screen.Width - GridOut.Left - GridOut.Width) < Hundred Then GridOut.Timer1.Enabled = False GridOut.Timer1.Interval = One GridOut.Timer1.Enabled = True GridOut.move Me.Left + Me.Width, TopGrid, Screen.Width - GridOut.Left - SaveX Else GridOut.move Me.Left + Me.Width, TopGrid End If ElseIf Abs(GridOut.Left + GridOut.Width - SaveLeft) < Hundred Then TopGrid = GridOut.Top + SaveY GridOut.move Me.Left - GridOut.Width, TopGrid ElseIf Abs(GridOut.Top - (SaveTop - GridOut.Height)) < Hundred Then GridOut.move Me.Left, lMax(One, SaveTop - GridOut.Height + SaveY), Me.Width ElseIf Abs(GridOut.Left - SaveLeft) < Hundred And Abs(GridOut.Width - Me.Width) < Hundred Then GridOut.move Me.Left, GridOut.Top, Me.Width ElseIf Abs(GridOut.Top - inGrid.Top) < Hundred Then TopGrid = inGrid.Top + SaveY GridOut.move GridOut.Left + SaveX, inGrid.Top + SaveY End If End If If HIDJLoaded Then If fHIDJ.WindowState = vbNormal Then If Abs(fHIDJ.Left - SaveLeft) < Hundred Then 'And Abs(fHIDJ.Width - inGrid.Width) < Hundred Then fHIDJ.move Me.Left - 75, fHIDJ.Top ' 75= ghosted borderstyle 2 End If End If End If End Function Function DJMove() As Boolean SaveLeft = Me.Left SaveTop = Me.Top On Error GoTo errorline DJMove = True Exit Function Resume errorline: ' stop '\\ Resume Next End Function Sub MouseMacroStarted() 'Click to end and replay mouse macro for Song Tempo. With UserParams.MDSFlexGrid1 End With End Sub Sub Populist(BPM As Long) 'find the nearest setting Dim workz7 As String, J As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long k = Me.Genre.ListIndex + Two J = Val(fDoc(Mp3PlayDoc).Table.TextMatrix(k, fDoc(Mp3PlayDoc).Table.Cols - Three)) For l = Zero To Me.LIST_Grooves.ListCount - One Me.LIST_Grooves.Selected(l) = False Next For l = Zero To Me.LIST_Bands.ListCount - One Me.LIST_Bands.Selected(l) = False Next l = Thousand o = -One p = -One Do While J > Zero workz7 = fDoc(Mp3PlayDoc).Table.TextMatrix(k, J) If Len(workz7) > Four Then workz7 = Mid$(workz7, InStr(workz7, ASpace) + One) m = SendMessageStr(Me.LIST_Grooves.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Left(workz7, InStr(workz7, ":") - One))) If m >= Zero Then Me.LIST_Grooves.Selected(m) = True n = SendMessageStr(Me.LIST_Bands.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Mid$(workz7, InStr(workz7, ":") + One))) If n >= Zero Then Me.LIST_Bands.Selected(n) = True If Abs(J - BPM) < l Then o = m p = n l = Abs(J - BPM) End If J = Val(workz7) '\\ dmDrums.Genre.ItemData(k) = -((Me.LIST_Bands.ListIndex + one) * Thousand + (Me.LIST_Grooves.ListIndex + one)) Else J = Zero End If Loop Me.LIST_Grooves.ListIndex = o Me.LIST_Bands.ListIndex = p End Sub Sub SendStartupKeys() '\\ (Send As String) '\\ Press the key down keybd_event VK_MENU, Zero, Zero, Zero keybd_event Asc("Z"), Zero, Zero, Zero '\\ Release the key '\\ Sleep Hundred keybd_event Asc("Z"), Zero, KEYEVENTF_KEYUP, Zero keybd_event VK_MENU, Zero, KEYEVENTF_KEYUP, Zero '\\ delay one End Sub Sub SetGenreEnabled() If PF_Ending Then Exit Sub Me.Genre.Enabled = Me.GenreEnabled If Me.GenreEnabled Then If Me.GenreEnabled = One Then Me.cmdBeatmix.Caption = "BeatMix" '\\ search "Mix" ElseIf Me.GenreEnabled = Two Then Me.cmdBeatmix.Caption = "Biasmix" Else Me.cmdBeatmix.Caption = "Include" End If Me.LabelGrooves(Zero).Caption = "- grooves" If Mp3PlayDoc = Zero Or Mp3PlayDoc = -Thousand Then Mp3PlayDoc = LoadNewDoc("Untitled") '\\ load from localized directory mp3play.ing fDoc(Mp3PlayDoc).Caption = App.path & "\" & App.Title & strLocalID & "\mp3play.ing" fDoc(Mp3PlayDoc).DocText_Filename = vbNullString '\\ to signal an invisible system grid FileLoad Mp3PlayDoc, fDoc(Mp3PlayDoc).Caption If Not gCancel Then '\\ put the data table into the documents table GetGridTable Mp3PlayDoc, fDoc(Mp3PlayDoc).Table fDoc(Mp3PlayDoc).Visible = False SetDirty False, Mp3PlayDoc Else Mp3PlayDoc = -Mp3PlayDoc '\\ flag to exclude End If End If Else Me.LabelGrooves(Zero).Caption = "+ grooves" Me.cmdBeatmix.Caption = "Unsync" End If SettingsSave iniName, "Music", "Genre.Enabled", Me.GenreEnabled If Mp3PlayDoc > Zero Then Dim i As Long For i = Zero To Genre.ListCount - One Genre.Selected(i) = CStr(Trim(Left(fDoc(Mp3PlayDoc).Table.TextMatrix(i + Two, fDoc(Mp3PlayDoc).Table.Cols - Two), Five))) Next Genre.ListIndex = -One Genre.Refresh SetDirty False, Mp3PlayDoc End If End Sub ' Sub SetMovingPicturesXMLEnabled() If PF_Ending Then Exit Sub Me.cmdExternalHelper(ExternalHelper).Enabled = Me.MovingPicturesXMLEnabled ' 20260124 'cmdMovingPicturesXML If Me.MovingPicturesXMLEnabled Then ' If Me.MovingPicturesXMLEnabled = One Then ' Me.cmdBeatmix.Caption = "BeatMix" '\\ search "Mix" ' ElseIf Me.MovingPicturesXMLEnabled = Two Then ' Me.cmdBeatmix.Caption = "Biasmix" ' Else ' Me.cmdBeatmix.Caption = "Include" ' End If ' Me.LabelGrooves(zero).Caption = "- grooves" If MovingPicturesXMLDoc = Zero Or MovingPicturesXMLDoc = -Thousand Then MovingPicturesXMLDoc = LoadNewDoc("Untitled") '\\ load from localized directory MovingPicturesXML.ing fDoc(MovingPicturesXMLDoc).Caption = App.path & "\" & App.Title & strLocalID & "\MovingPicturesXML.ing" fDoc(MovingPicturesXMLDoc).DocText_Filename = vbNullString '\\ to signal an invisible system grid FileLoad MovingPicturesXMLDoc, fDoc(MovingPicturesXMLDoc).Caption If Not gCancel Then '\\ put the data table into the documents table GetGridTable MovingPicturesXMLDoc, fDoc(MovingPicturesXMLDoc).Table fDoc(MovingPicturesXMLDoc).Visible = False SetDirty False, MovingPicturesXMLDoc Else MovingPicturesXMLDoc = -MovingPicturesXMLDoc '\\ flag to exclude End If End If Else ' Me.LabelGrooves(zero).Caption = "+ grooves" ' Me.cmdBeatmix.Caption = "Unsync" End If ' SettingsSave iniName, "Music", "cmdMovingPicturesXML.Enabled", Me.MovingPicturesXMLEnabled ' If MovingPicturesXMLDoc > Zero Then ' Dim i As Long ' For i = Zero To cmdMovingPicturesXML.ListCount - One ' cmdMovingPicturesXML.Selected(i) = CStr(Trim(Left(fDoc(MovingPicturesXMLDoc).Table.TextMatrix(i + Two, fDoc(MovingPicturesXMLDoc).Table.Cols - Two), Five))) ' Next ' cmdMovingPicturesXML.ListIndex = -One ' cmdMovingPicturesXML.Refresh ' SetDirty False, MovingPicturesXMLDoc ' End If End Sub Function SetLists(k As Long, n As Long) As Boolean Dim workz7 As String If n > Zero And n < 120 Then workz7 = fDoc(Mp3PlayDoc).Table.TextMatrix(k + Two, n + Two) If Len(workz7) > Four Then If Val(workz7) > Zero Then workz7 = Right$(workz7, Len(workz7) - InStr(workz7, ASpace)) Me.LIST_Grooves.ListIndex = SendMessageStr(Me.LIST_Grooves.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Left(workz7, InStr(workz7, ":") - One))) '\\ getBandWord Me.LIST_Bands.ListIndex = SendMessageStr(Me.LIST_Bands.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Mid$(workz7, InStr(workz7, ":") + One))) SetLists = True Genre.ItemData(k) = -((Me.LIST_Bands.ListIndex + One) * Thousand + (Me.LIST_Grooves.ListIndex + One)) End If ElseIf n < Zero Or n > 120 Then SetLists = True Me.LIST_Grooves.ListIndex = -One Me.LIST_Bands.ListIndex = -One End If End Function Public Sub SetMp3playing() With Me If Mp3PlayDoc > Zero Then If .Genre.ListIndex >= Zero Then Dim linkCol As Long, conGenre As Long, elTempo As Long, workz7 As String conGenre = .Genre.ListIndex + Two If Mid$(LabelGrooves(One).ToolTipText, Seven, One) = "%" Then elTempo = Int(Left(LabelGrooves(One).ToolTipText, Six)) - 55 linkCol = fDoc(Mp3PlayDoc).Table.Cols - Three workz7 = fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, elTempo) If workz7 = "?" Then workz7 = Val(fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, linkCol)) fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, linkCol) = elTempo Else workz7 = Val(workz7) End If SetDirty True, Mp3PlayDoc fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, elTempo) = workz7 & ASpace & .LIST_Grooves.list(.LIST_Grooves.ListIndex) & ":" & .LIST_Bands.list(.LIST_Bands.ListIndex) End If .Genre.ItemData(.Genre.ListIndex) = Zero End If End If End With End Sub Sub SyncSchedule(ByRef mytime As Variant) If EnsureScheduleListFor(mytime) Then ScheduleSync End If Me.frmPicture1(One).Refresh ' 20260124 End Sub Public Function LowerVolPreset() As Boolean If Me.LabelVol.BackColor = Sixty Then LabelVolForeColor vbYellow LowerVolPreset = True ElseIf Me.LabelVol.BackColor = 40 Then LabelVolForeColor vbOrange LowerVolPreset = True ElseIf Me.LabelVol.BackColor = Twenty Then LabelVolForeColor vbRed LowerVolPreset = True End If '\\ 25 is a lowervolpreset not to interfere with reader End Function Public Function UpperVolPreset(Optional ByVal EndVolSlider As Single = -One) As Boolean If EndVolSlider = -One Then EndVolSlider = Me.LabelVol.BackColor If EndVolSlider = 255 Then 'And Me.UpDown_Volume.value Mod 50 = Zero) Then LabelVolForeColor vbWhite UpperVolPreset = True End If If EndVolSlider = Round(SelectedVolume / Hundred * 255, Zero) Then LabelVolForeColor vbCyan UpperVolPreset = True End If If EndVolSlider = SixtyFour Then LabelVolForeColor vbGreen UpperVolPreset = True End If '\\ 25% is independent for Max Vol while Reader reading End Function Private Sub AutoTempo_Click() With Me If MP3ID3v1Tag Is Nothing Then Exit Sub End If CloseLockMP3file workbuffer = MP3ID3v1Tag.Comment If Mid$(workbuffer, One, Six) <> .AutoTempo.list(.AutoTempo.ListIndex) Then '\\ the median BPM is stored If Len(workbuffer) < Seven Then workbuffer = Left$(.AutoTempo.list(.AutoTempo.ListIndex), Six) & "%" Else Mid$(workbuffer, One, Seven) = Left$(.AutoTempo.list(.AutoTempo.ListIndex), Six) & "%" End If MP3ID3v1Tag.Comment = workbuffer On Error GoTo errorline If .optImmediate <> True Then If .optDefault = True Then .cmdPlayMotif = True .optBeat = True ElseIf WA_GetShuffle = One And UpDown_Fine_Tempo.value <> Zero And EnqueuedAt <= Zero Then Call WA_SetShuffle(Zero) SpeakThis "Winamp Shuffle is off while learning BPM" End If End If .Slider2.Max = .AutoTempo.ListCount - One .Slider2.value = .AutoTempo.ListIndex Exit Sub errorline: ' stop WarningError Err, "AutoTempo" '\\ , , , vbYes End With End Sub Private Sub AutoTempo_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) On Error Resume Next Me.Slider2.ZOrder One Me.Slider2.Visible = True Me.Slider2.SetFocus End Sub Private Sub AutoTempo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'Click to memorize non-median Tempo. Also sets Winamp playlist to manual advance for a group of unlearned tracks. Opp.Click to hide. If Button = vbRightButton Then Me.BongoMan.ZOrder Zero End If End Sub Private Sub BongoMan_GotFocus() SetStatus BongoMan End Sub Private Sub chkLoop_GotFocus() SetStatus chkLoop End Sub Private Sub chkLoop_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) chkLoop.SetFocus End Sub Private Sub chkLoop_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Me.chkLoop.value = vbGrayed End If End Sub Private Sub chkReverb_GotFocus() SetStatus chkReverb End Sub Private Sub chkReverb_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Me.chkReverb.value = vbGrayed ElseIf Button = vbLeftButton Then '\\ Ok, they want to switch the default audio paths Dim dmPath As DirectMusicAudioPath8 If chkReverb.value = vbUnchecked Then Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_STEREO, 128, True) Else Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True) End If perf.SetDefaultAudioPath dmPath Set dmPath = Nothing ChangeBands End If End Sub Public Sub IMDbPlay() 'depricated in favour of MovingPicturesXML On Error GoTo errorline Dim S As Shell Dim fi As FolderItem Dim f As Folder Dim l As ShellLinkObject Dim i As Long Set S = New Shell If Dir(UserParams.UserName.Text) = "" Then Set f = S.BrowseForFolder(Me.hwnd, "Select Movielinks folder", 0) Else Set f = S.BrowseForFolder(Me.hwnd, "Select Movielinks folder", 0) End If For i = 0 To f.Items.count - 1 Set fi = f.Items.item(i) If fi.IsLink Then Set l = fi.GetLink Dim workz9 As String Dim workz8 As String Dim workz7 As String Dim workz6 As String workz8 = fi.path workz8 = Left(workz8, Len(workz8) - 8) & ".txt" Mid(workz8, InStr(1, workz8, "links", vbTextCompare), 5) = "texts" If Right(fi.name, 4) = ".avi" Then If Dir(UserParams.UserName.Text) = "" Then UserParams.UserName.Text = Left(workz8, InStrRev(workz8, "\")) End If If Dir(workz8, vbNormal) = "" Then If l.description <> "" Then workz7 = l.description If isValidFileName(workz7) Then 'synchronize existing names workz7 = InputBox("Shortcut.description", , workz7) End If Else workz7 = fi.name workz7 = Left(workz7, Len(workz7) - 4) End If If Dir(workz8) <> "" Then 'should only the shortcut be renamed ' if so then the two internal fields could still be different. Else workz6 = "c:\progra~1\amdb\bin\title.exe -t " workz6 = workz6 & " """ & workz7 workz6 = workz6 & """ -o """ workz6 = workz6 & workz8 & """" ShellandWait workz6 End If 'assuming the rows and columns are set up identical to 'ConstructsName and ElementsName 'then a lookup in ElementsName is performed to find the column to paste. 'initially a bug is allowed that omits synchronizing to the files in constructnames If Dir(UserParams.ConstructsName.Text) <> "" Then workbuffer = "H:\MovingPicturesXML\database\Copy of filesizes.txt" UserParams.ConstructsName.Text = InputBox("ConstructsName.Text ", , workbuffer) If Dir(UserParams.ElementsName.Text) = "" Then workbuffer = "H:\Video\Movies\movies.txt" UserParams.ElementsName.Text = InputBox("ElementsName.Text ", , workbuffer) If Dir(UserParams.ElementsName.Text) <> "" Then Open "H:\Video\Movies\movies.txt" For Input As #One 'UserParams.ConstructsName.Text For Input As #One Input #One, workz9 Close #One 'run through workz9 assuming it to be "H:\Video\Movies\movies.txt" 'set construct names and weight i = Zero Dim J As Long, k As Long J = Zero For k = One To NmE i = InStr(i + 1, workz9, vbLf) If i = Zero Then Exit For workz7 = Mid(workz9, J + 1, i - J) If Right(workz7, Four) = ".list" Then GridIn.Table.TextMatrix(k, One) = Left(workz7, Len(workz7) - Four) End If Next End If End If ' Else ' ' End If ' End If Else ' UserParams.ConstructsName.Text = BrowseFolder 'InputBox(UserParams.ConstructsName.Text, , UserParams.ConstructsName.Text) ' If VBGetOpenFileName(UserParams.ConstructsName.Text) Then If Dir(UserParams.ConstructsName.Text) <> "" Then Open "H:\MovingPicturesXML\database\Copy of filesizes.txt" For Input As #One 'UserParams.ConstructsName.Text For Input As #One Input #One, workz9 Close #One 'run through workz9 assuming it to be "H:\MovingPicturesXML\database\Copy of filesizes.txt" 'set construct names and weight i = Zero J = Zero For k = One To NmC i = InStr(i + 1, workz9, vbLf) If i = Zero Then Exit For workz7 = Mid(workz9, J + 1, i - J) If Right(workz7, Four) = ".list" Then GridIn.Table.TextMatrix(k, One) = Left(workz7, Len(workz7) - Four) End If Next End If ' End If End If End If Open workz8 For Input As #One Input #One, workz9 Close #One 'find element and set.clip End If XDoEventsX ' MsgBox fi.Name & vbCrLf & _ l.Description & vbCrLf & _ l.Path & vbCrLf & _ l.WorkingDirectory & vbCrLf & _ l.ShowCommand End If Next errorline: Set l = Nothing Set fi = Nothing Set f = Nothing Set S = Nothing End Sub Public Sub MovingPicturesXMLPlay() On Error GoTo errorline 'first we need the xml file and then we need to build the grid 'later we can build the form with treeview and listview capabilities 'to select different criteria. errorline: End Sub Public Sub PlayMotif(Optional Rand As Long = -One) On Error GoTo errorline If Rand = -One Then Rand = Rnd * (lstMotif.ListCount - One) Else Rand = Rand Mod lstMotif.ListCount End If On Error GoTo errorline Dim lFlags As CONST_DMUS_SEGF_FLAGS lFlags = DMUS_SEGF_SECONDARY If optBeat.value Then lFlags = lFlags Or DMUS_SEGF_BEAT If optDefault.value Then lFlags = lFlags Or DMUS_SEGF_DEFAULT If optGrid.value Then lFlags = lFlags Or DMUS_SEGF_GRID If optImmediate.value Then lFlags = lFlags Or DMUS_SEGF_SECONDARY If optMeasure.value Then lFlags = lFlags Or DMUS_SEGF_MEASURE lstMotif.ListIndex = Rand perf.PlaySegmentEx moMotifs(lstMotif.ListIndex).Motif, lFlags, Zero Exit Sub Resume errorline: ' stop End Sub Private Sub cmdExternalHelper_GotFocus(Index As Integer) 'Click() If Index = One Then SetStatus cmdExternalHelper(Index) ' 20260124 'cmdMovingPicturesXML End Sub Private Sub cmdExternalHelper_MouseMove(Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdExternalHelper(Index).SetFocus ' 20260124 'cmdMovingPicturesXMLClick(cmdMovingPicturesXML End Sub Private Sub cmdExternalHelper_MouseUp(Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_cmdExternalHelper Index, Button, Shift End Sub Private Sub cmdPlayMotif_Click() On Error GoTo errorline MouseState.Buttons(Zero) = Zero '\\ to avoid repeating a random motif Dim lFlags As CONST_DMUS_SEGF_FLAGS lFlags = DMUS_SEGF_SECONDARY If optBeat.value Then lFlags = lFlags Or DMUS_SEGF_BEAT If optDefault.value Then lFlags = lFlags Or DMUS_SEGF_DEFAULT If optGrid.value Then lFlags = lFlags Or DMUS_SEGF_GRID If optImmediate.value Then lFlags = lFlags Or DMUS_SEGF_SECONDARY If optMeasure.value Then lFlags = lFlags Or DMUS_SEGF_MEASURE perf.PlaySegmentEx moMotifs(lstMotif.ListIndex).Motif, lFlags, Zero Exit Sub Resume errorline: ' stop End Sub Private Sub cmdPlayMotif_GotFocus() SetStatus Me.cmdPlayMotif End Sub Private Sub cmdPlayMotif_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.cmdPlayMotif.SetFocus End Sub Private Sub cmdSave_GotFocus() SetStatus cmdSave End Sub Private Sub cmdSave_MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseDown_cmdSave Button End Sub Private Sub cmdSave_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdSave.SetFocus End Sub Private Sub cmdSave_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_cmdSave Button End Sub Private Sub cmdSegment_Click() Static sCurDir As String Static lFilter As Long With cdlOpen '\\ We want to open a file now .flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST .FilterIndex = lFilter .Filter = "Segment Files (*.mid;*.sgt;*.sgp)|*.mid;*.sgt;*.sgp" '\\ .FileName = SettingGet(iniName, "Music", "Filename", notstring) If sCurDir = vbNullString Then '\\ Set the init folder to \windows\media if it exists. If not, set it to the \windows folder Dim sWindir As String sWindir = Space$(255) If GetWindowsDirectory(sWindir, 255) = Zero Then '\\ We couldn't get the windows folder for some reason, use the c:\ .InitDir = "C:\" Else Dim sMedia As String sWindir = Left$(sWindir, InStr(sWindir, vbNullChar) - 1) If Right$(sWindir, One) = "\" Then sMedia = sWindir & "Media" Else sMedia = sWindir & "\Media" End If If Dir$(sMedia, vbNormal + vbHidden + vbSystem + vbDirectory) <> NotString Then .InitDir = sMedia Else .InitDir = sWindir End If End If Else .InitDir = sCurDir End If .ShowOpen '\\ Display the Open dialog box If gCancel Then Exit Sub '\\ Save the current information sCurDir = GetFolder(.FileName) '\\ Set the search folder to this one so we can auto download anything we need loader.SetSearchDirectory sCurDir lFilter = .FilterIndex On Local Error GoTo NoLoadSegment '\\ Before we load the segment stop one if it's playing cmdStop_Click '\\ Now let's load the segment LoadSegment .FileName Call SettingsSave(iniName, "Music", "Filename", .FileName) End With Exit Sub NoLoadSegment: UpdateStatus "Couldn't load this segment" ClickedCancel: End Sub Private Sub cmdSegment_GotFocus() SetStatus cmdSegment End Sub Private Sub cmdSegment_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdSegment.SetFocus End Sub Private Sub cmdStop_Click() 'Stop the segment On Error Resume Next perf.StopEx dmSegMotif, Zero, Zero EnablePlayUI True UpdateStatus "User pressed stop." End Sub Private Sub cmdStop_GotFocus() SetStatus cmdStop End Sub Private Sub cmdStop_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdStop.SetFocus End Sub Private Sub cmdStop_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbMiddleButton Then SetTrickle Trickle.cmdShutDown = True End If End Sub Private Sub cmdPlayPause_GotFocus(ByRef Index As Integer) SetStatus cmdPlayPause(Index) End Sub Private Sub cmdPlayPause_MouseMove(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdPlayPause(Index).SetFocus End Sub Private Sub cmdHaltPlay_Click() DelayTrackSelection = Two Me.StopCmd = True If Not LowerVolPreset Then Call WinAmpControls("LessVolume", , False) WA_Stop FreshPlot "Perturbate", , True '\\ ensures accurate track length If inGrid_SendSpeech_BackColor = vbYellow And IngridLoaded Then inGrid_SendSpeech_BackColor = OffGray End If If Not UserParams Is Nothing And MouseState.Buttons(Zero) = vbLeftButton Then UserParams.MDSFlexGrid1.Visible = False ScreenOff End If End Sub Private Sub cmdHaltPlay_GotFocus() SetStatus cmdHaltPlay End Sub Private Sub cmdHaltPlay_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdHaltPlay.SetFocus End Sub Private Sub cmdHaltPlay_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim lWork As Long If Button = vbMiddleButton Then '\\ Mid.Click to start recording. '\\ Debug.Print "ping.wav DMDrums start recording" ' lWork = sndPlaySound(SoundDir & "ping.wav", flags) If TrickleLoaded Then Trickle.Hide inGrid.TimeStep.value = -Abs(inGrid.TimeStep.value) If inGrid.mnuViewAutoRedraw.Enabled Then inGrid_mnuViewAutoRedraw_Checked = True inGrid.DrawState.value = vbChecked inGridClick_mnuViewAutoRedraw End If params True, True '\\ in order to track mouse movements flush the mouse ScreenOff '\\ and set the flag MouseState.Buttons(Zero) = vbLeftButton End If End Sub Private Sub CommandGridArt_GotFocus() SetStatus CommandGridArt End Sub Private Sub CommandGridArt_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' CommandGridArt.SetFocus End Sub Private Sub cmdBeatmix_GotFocus() SetStatus cmdBeatmix End Sub Private Sub cmdBeatmix_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) cmdBeatmix.SetFocus End Sub Private Sub CPUUsage_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me If Button = vbLeftButton Then '\\ toggle TimeStep between Fps and Tempo gearing. inGrid.TimeStep.value = -inGrid.TimeStep.value If inGrid.TimeStep.value < Zero Then .CPUUsage.Appearance = ccFlat Else .ManualGearing.ForeColor = vbOrange .CPUUsage.Appearance = cc3D End If ElseIf Button = vbRightButton Then '\\ Opp.click toggles enabling for Automatic Tempo gearing. If .ManualGearing.ForeColor = vbOrange Then .ManualGearing.ForeColor = vbCyan Else .ManualGearing.ForeColor = vbOrange End If End If End With End Sub Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) 'Here we will handle the DMusic callbacks Dim dmNotification As DMUS_NOTIFICATION_PMSG Dim oState As DirectMusicSegmentState8 Dim oSeg As DirectMusicSegment8 Dim lCount As Long On Error GoTo FailedOut '\\ Process all events Do While perf.GetNotificationPMSG(dmNotification) If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGEND Then '\\ The segment has ended '\\ First we need to figure out which segment Set oState = dmNotification.USER '\\ The user field holds the segment state on segment notifications Set oSeg = oState.GetSegment '\\ Get the segment from the state '\\ Is this the primary segment? If oSeg Is dmSegMotif Then '\\ Yup UpdateStatus "Primary Segment stopped playing." EnablePlayUI True Else '\\ Go through all of the other segments For lCount = Zero To UBound(moMotifs) If oSeg Is moMotifs(lCount).Motif Then UpdateStatus moMotifs(lCount).name & " stopped playing." '\\ Now update the listbox lstMotif.list(moMotifs(lCount).ListIndex) = moMotifs(lCount).name End If Next End If End If If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGSTART Then '\\ The segment has started '\\ First we need to figure out which segment Set oState = dmNotification.USER '\\ The user field holds the segment state on segment notifications Set oSeg = oState.GetSegment '\\ Get the segment from the state '\\ Is this the primary segment? If oSeg Is dmSegMotif Then '\\ Yup UpdateStatus "Primary Segment started playing." Else '\\ Go through all of the other segments For lCount = Zero To UBound(moMotifs) If oSeg Is moMotifs(lCount).Motif Then UpdateStatus moMotifs(lCount).name & " motif started playing." '\\ Now update the listbox lstMotif.list(moMotifs(lCount).ListIndex) = moMotifs(lCount).name & " (Playing)" End If Next End If End If Loop Exit Sub Resume FailedOut: Static LastTime As Single If Abs(Timer - LastTime) < Half Then '\\ this is here for some strange reason LastTime = Timer Exit Sub End If LastTime = Timer If PF_Ending Or Not StartUpTypeIsNormal Then Exit Sub If ProcessingFlag = PF_Host Or ProcessingFlag = PF_Null Or ProcessingFlag = PF_InitStopD3D Then '\\ If inGrid_SendSpeech_BackColor <> OffGray Then me.Play = True Exit Sub End If If NameString = vbNullString Then SendSound "notify.wav", SND_SYNC + SND_NOSTOP '\\ MsgBoxex"Error processing this Notification", vbOKOnly Or vbInformation, "Cannot Process." End If End Sub Private Sub Drum_GotFocus(ByRef Index As Integer) SetStatus Drum(Index) End Sub Private Sub Drum_MouseMove(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If ScheduleMth > Zero Then If GetForegroundWindow <> fDoc(ScheduleMth).hwnd Then '\\ because "select all" from a context menu can leave mouse on a drum If fToolTips Is Nothing Then Exit Sub ResetDrum Index End If End If End Sub Private Sub Drum_MouseUp(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) On Error GoTo errorline If Button = vbRightButton Then If fPushKeys Is Nothing Then Set fPushKeys = frmPushKeys End If With fPushKeys .Left = Me.Left + Drum(Index).Left + Drum(Index).Width .Top = Me.Top + Drum(Index).Top + Drum(Index).Height .Show vbModeless End With ProcessMacro Index ElseIf Button = vbMiddleButton Then Me.Drum(Index).Font.Strikethrough = True End If Exit Sub Resume errorline: ' stop WarningError Err, "Mouse Macro" End Sub Private Sub DTPicker1_Change() Me.MonthView1.value = Me.DTPicker1.value End Sub Private Sub DTPicker1_DblClick() StartUpChime = Zero Me.DTPicker1.value = Now Me.MonthView1.Visible = False Front , fDoc(ScheduleMth) End Sub Private Sub DTPicker1_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) DTPicker1.SetFocus End Sub Private Sub DTPicker1_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me If Button = vbLeftButton Then Exit Sub '\\ LockWindowUpdate .hWnd Dim DiffTime As Single DiffTime = DateDiff("s", .DTPicker1.value, Now) If Button = vbMiddleButton Or (Button = vbRightButton And Shift = vbCtrlMask) Then If StartUpChime = Zero And Abs(DiffTime) > Sixty Or Not .MonthView1.Visible Then StartUpChime = DiffTime '\\ If Abs(StartUpChime) > Sixty And Abs(StartUpChime) < DEG * Thirty Then '\\ short range diary '\\ .MonthView1.Value = .DTPicker1.Value SyncSchedule (.DTPicker1.value) .MonthView1.Visible = True If ScheduleMth > Zero Then Front False, fDoc(ScheduleMth) fDoc(ScheduleMth).Table.SetFocus End If Exit Sub Else .MonthView1.Visible = False End If If Abs(DiffTime) < Sixty And .MonthView1.Visible = True Then StartUpChime = Zero .DTPicker1.value = Now End If SyncSchedule (.MonthView1.value) ElseIf Button = vbRightButton And Shift = Zero Then .MonthView1.value = .DTPicker1.value Front False, .MonthView1 .MonthView1.Visible = True ElseIf Button = vbRightButton And Shift = vbShiftMask Then date = .DTPicker1.value time = .DTPicker1.value End If End With End Sub Private Sub EDIT_Tempo_GotFocus() SetStatus EDIT_Tempo End Sub Private Sub EDIT_Tempo_MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbMiddleButton Then ' StringFromOCR = vbNullString ScraperRectLeft = Zero SongTime 5, True Play = True End If End Sub Private Sub EDIT_Volume_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) With Me If Button = vbLeftButton And Shift = Zero Then If .UpDown_Volume.value < 25 Then If .UpDown_Volume.value = One Then SelectedVolume = 83 .UpDown_Volume.value = 25 ElseIf .UpDown_Volume.value = 25 Then .UpDown_Volume.value = 50 ElseIf .UpDown_Volume.value = 50 Then .UpDown_Volume.value = SelectedVolume ElseIf .UpDown_Volume.value = SelectedVolume Then .UpDown_Volume.value = Hundred ElseIf .UpDown_Volume.value = Hundred Then .UpDown_Volume.value = One 'Zero End If ElseIf Button = vbMiddleButton Or Button = vbLeftButton And Shift = vbShiftMask Then If LastSecondHand = DaySeconds Then '\\ else will reset "LessVolume" LastSecondHand = Zero End If If .EDIT_Volume.ForeColor = .LabelVol.ForeColor Then Call SettingsSave(iniName, RegSettings, "FadeVolume", True) Call WinAmpControls("LessVolume", , False) Else Call SettingsSave(iniName, RegSettings, "FadeVolume", False) Call WinAmpControls("SetVol", , False) Call SettingsSave(iniName, RegSettings, "SetVolume", .UpDown_Volume.value) If .UpDown_Volume.value = Hundred And Left(SpeechThing, Five) <> "Agent" Then KarmaGunAfterStartup = True End If End If ElseIf Button = vbRightButton Then If .UpDown_Volume.value < 25 Then If .UpDown_Volume.value = One Then SelectedVolume = 83 .UpDown_Volume.value = Hundred ElseIf .UpDown_Volume.value = 25 Then .UpDown_Volume.value = One 'Zero ElseIf .UpDown_Volume.value = 50 Then .UpDown_Volume.value = 25 ElseIf .UpDown_Volume.value = SelectedVolume Then .UpDown_Volume.value = 50 ElseIf .UpDown_Volume.value = Hundred Then .UpDown_Volume.value = SelectedVolume End If End If EDIT_Volume.BorderStyle = One End With End Sub Private Sub Form_KeyDown(ByRef KeyCode As Integer, ByRef Shift As Integer) If KeyCode > 64 And KeyCode < 90 Then '\\ sndPlaySound App.path & "\wav\S-" & chr$(KeyCode) & ".wav", SND_ASYNC '\\ fmDirectSnd.MediaFile = "\wav\S-" & chr$(KeyCode) & ".wav" '\\ fmDirectSnd.cmdPlay = True Dim Letter As Long, DrumBackground As Long Letter = KeyCode - 65 DrumBackground = Me.Drum(Letter).BackColor SetCursorPos (Me.Left + Me.Drum(Letter).Left) / xPixel + Twenty, (Me.Top + Me.Drum(Letter).Top + 430) / yPixel + Five HitDrum (Letter) Drum(KeyCode - 65) = True Me.Drum(Letter).BackColor = DrumBackground ' Call MouseupFormDrumColor(vbLeftButton, Shift, CInt(MousePos.x), CInt(MousePos.y)) '\\ Exit Sub End If '\\ If KeyCode = 72 Then '\\ Me.Hide '\\ Exit Sub '\\ End If '\\ If Not inGrid Is Nothing Then '\\ inGrid.Show vbModeless '\\ inGrid.SetFocus '\\ End If '\\ keybd_event KeyCode, End Sub Private Sub Form_Load() p_LabelBPM_ForeColor = vbWhite '\\ gets around a startup problem setting black. Load frmDrumDown With frmDrumDown .SetDrumDownPictures End With With Me Dim lWork As Long LastSecondHand = DaySeconds If PF_Ending Then '\\ Unload Me Exit Sub End If If TrickleLoaded Then lblClose(Zero).Caption = " X" lblClose(One).Caption = " X" Else lblClose(Zero).Caption = " i" lblClose(One).Caption = " i" End If .BongoMan.move .AutoTempo.Left, .AutoTempo.Top, .AutoTempo.Width, .AutoTempo.Height .Slider2.move .AutoTempo.Left, .AutoTempo.Top, .AutoTempo.Width, .AutoTempo.Height '\\ Set AutoIt = CreateObject("AutoItX.Control") StartDrumRoll = -8 .Drum(Seven).Font.Strikethrough = True On Error GoTo FailedInit TempoFactor = One TempoIndex = One ChDir App.path Dim dmA As DMUS_AUDIOPARAMS, lCount As Long Dim MotifName As String ExternalHelper = Abs(SettingsGet(iniName, "Music", "ExternalHelper", Zero)) ' MouseUp_cmdExternalHelper ExternalHelper, vbMiddleButton, Zero If ExternalHelper = One Then cmdExternalHelper(Zero).Visible = False cmdExternalHelper(Zero).Enabled = False Else cmdExternalHelper(One).Visible = False cmdExternalHelper(One).Enabled = False End If cmdExternalHelper(ExternalHelper).ZOrder Zero 'ExternalHelper ' One - cmdExternalHelper(Index).ZOrder '20260124 cmdExternalHelper(ExternalHelper).Visible = True cmdExternalHelper(ExternalHelper).Enabled = True m_TempoSelector = SettingsGet(iniName, "Preferences", "TempoSelector", -One) If m_TempoSelector <> -One Then Me.TempoMultiplier(m_TempoSelector).BackColor = vbGreen cdlOpen.InitDir = GetFolder(SettingsGet(iniName, "Music", "Filename", App.path & "\")) If cdlOpen.InitDir = vbNullString Then mediapath = FindMediaDir("Drums!.sgt") Else mediapath = FindMediaDir(cdlOpen.InitDir & "Drums!.sgt") End If Set perf = g_dx.DirectMusicPerformanceCreate() Set loader = g_dx.DirectMusicLoaderCreate() Set composer = g_dx.DirectMusicComposerCreate() '\\ Make sure we can init the audio as well '\\ Initialize performance object to use its own DirectSound object perf.InitAudio .hwnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128 '\\ SetMasterAutoDownload indicates we the perofmance object '\\ to attempt to auto download DLS collections when reference in '\\ sgt and sty files Call perf.SetMasterAutoDownload(True) Set style = loader.LoadStyle(mediapath & "drums!.sty") Set dmSegDrum = loader.LoadSegment(mediapath & "drums!.sgt") Get_Bands LIST_Grooves.AddItem ("Alternative") LIST_Grooves.AddItem ("Blues") '\\ 12 bar LIST_Grooves.AddItem ("Country") LIST_Grooves.AddItem ("Dance - Pop") LIST_Grooves.AddItem ("Hard Rock") LIST_Grooves.AddItem ("Hip Hop") LIST_Grooves.AddItem ("Jazz") LIST_Grooves.AddItem ("Latin") LIST_Grooves.AddItem ("R & B") LIST_Grooves.AddItem ("Rap") LIST_Grooves.AddItem ("Soft Rock") LIST_Grooves.AddItem ("World") UpDown_Volume.Enabled = False UpDown_Volume.value = 50 '\\ SelectedVolume DelayTempoSliderFlag = True UpDown_Fine_Tempo.value = m_Fine_Tempo If LabelBPM.ForeColor = vbBlack Then ListAdvanceColor = vbBlue End If ' EDIT_Tempo.Enabled = False ' lCount = SettingsGet(iniName, "Music", "Tempo", EDIT_Tempo.Caption) ' If lCount > 200 Then ' lCount = lCount - Hundred ' If Rnd > PointSeven Then ' lCount = lCount - Hundred ' End If ' End If ' EDIT_Tempo.Caption = lCount ManualGearing.ForeColor = Val(SettingsGet(iniName, "Music", "GearsEnabled")) '\\ , ManualGearing.ForeColor)) If ManualGearing.ForeColor <> vbOrange Then ManualGearing.ForeColor = vbCyan End If SaveX = SettingsGet(iniName, "Music", "Drums.Left", DefaultBot(-300, -300)) SaveY = SettingsGet(iniName, "Music", "Drums.Top", DefaultBot(6390, 6390)) .Height = SettingsGet(iniName, "Music", "Drums.Height", DefaultBot(6615, 2790)) If SaveX < Zero Then .frmPicture1(One).Top = Zero If SaveY < Zero Then .Height = 2790 End If End If If SaveY < Zero Then If .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height + .Top > Screen.Height Then .frmPicture1(One).Top = Zero .Height = 2790 Else .Height = .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height End If End If .move Abs(SaveX), Abs(SaveY) '.Height = 6615 .CPUUsage.Appearance = SettingsGet(iniName, "Music", "CPUUsage", .CPUUsage.Appearance) chkReverb.value = SettingsGet(iniName, "Music", "Reverb", chkReverb.value) chkLoop.value = SettingsGet(iniName, "Music", "Loop", chkLoop.value) SetStation LIST_Grooves.ListIndex = SettingsGet(iniName, "Music", "Groove", LIST_Grooves.ListIndex) LIST_Bands.ListIndex = SettingsGet(iniName, "Music", "Bands", LIST_Bands.ListIndex) UpDown_Volume.Enabled = True ' EDIT_Tempo.Enabled = True If .CPUUsage.Appearance = ccFlat Then inGrid.TimeStep.value = -Abs(inGrid.TimeStep.value) Else inGrid.TimeStep.value = Abs(inGrid.TimeStep.value) End If '\\ Download the default band so that we can play the drum pads immediately ChangeBands ChangeVolume UpDown_Volume.value ReDim segMotif(style.GetMotifCount() - 1) For lCount = Zero To style.GetMotifCount() - 1 MotifName = style.GetMotifName(lCount) '\\ We could set the drum name here (but we'll just leave them hard coded) '\\ Drum(lCount).Caption = MotifName Set segMotif(lCount) = style.GetMotif(MotifName) Next LIST_Grooves.ListIndex = Zero LIST_Bands.ListIndex = Zero '\\ on error GoTo FailedInit '\\ Dim dma As DMUS_AUDIOPARAMS Dim sMedia As String '\\ Create our objects '\\ Set perf = g_dx.DirectMusicPerformanceCreate '\\ Set loader = g_dx.DirectMusicLoaderCreate '\\ Set up a default audio path '\\ perf.InitAudio .hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128 '\\ Create an event handle mlSeg = g_dx.CreateEvent(Me) perf.AddNotificationType DMUS_NOTIFY_ON_SEGMENT perf.SetNotificationHandle mlSeg '\\ Don't let them play a motif yet cmdPlayMotif.Enabled = False '\\ Now let's load our default segment sMedia = FindMediaDir("sample.sgt") loader.SetSearchDirectory sMedia If sMedia = vbNullString Then sMedia = AddDirSep(CurDir) LoadSegment sMedia & "sample.sgt" EnablePlayMotif False If inGrid.WindowState = vbMinimized Then '\\ ie after Hibernate inGrid.WindowState = vbNormal .Width = inGrid.Width ' - Thirty '-30 = 20150506 Windows 10 inGrid.WindowState = vbMinimized ' .Hide'20120226 Else .Width = inGrid.Width ' - Thirty '-30 = 20150506 Windows 10 .lblClose(Zero).Left = inGrid.Width - .lblClose(Zero).Width .lblClose(One).Left = inGrid.Width - .Frame2.Left - .lblClose(One).Width If inGrid.mnuViewDMDrums.Checked And StartUpTypeIsNormal And Not InStr(CmdStr, "shut") > Zero Then ' .Show vbModeless dmDrums.WindowState = vbNormal End If End If Dim MacroCounts As Variant MacroCounts = Array() MacroCounts = GetAllSettings(App.Title, "MacroCount") On Error Resume Next If Not MacroCounts = Empty Then If Not MacroCounts(Zero, Zero) = Empty Then For lCount = Zero To UBound(MacroCounts) If MacroCounts(lCount, One) > Zero Then .Drum(MacroCounts(lCount, Zero)).Font.Italic = True End If Next End If End If anyName Me Label3(Zero).ForeColor = ForeFace GdiSetupDMGraphics DJReady = True lWork = SettingsGet(iniName, RegSettings, "DeviceToControl", -One) ' If lWork = -One Then 'when should this happen? Option1(5).value = True If .VolSlider1.value <> -80 Then .VolSlider1.value = -80 ' If lWork <> -One Then SpeakThis "Reader set WAV volume to 80%" lWork = Zero End If Option1(lWork).value = True If chkMute.value = vbChecked And lWork = Zero Then 'master volume? Select Case MsgBox("do you want to un-Mute VolumeControl " & lWork, vbYesNoCancel) Case vbYes VolumeControl1.Mute = False chkMute.value = vbUnchecked Case vbCancel HIDJOut End Select End If Call SettingsSave(iniName, RegSettings, "DiaryAnnounce", vbUnchecked) dmDrumsLoaded = True PlaylistAdvance If (Not ListAdvanceColor = vbGreen) And WA_IsPlaying <> One Then '(Not 1) If Not SlaveBot Then '20120808 TrackSelected = True LikeLessThanThirtySecondsLeft '20120823 20110906 - put here to try to avoid repeat of first song when ListAdvanceColor = vbGreen Else ' DelayTrackSelection = -Thirty '20120823 - will this hold long enough past the next call End If End If ' ListAdvanceToGreenOnPlay = SettingsGet(iniName, RegSettings, "ListAdvanceToGreenOnPlay", ListAdvanceToGreenOnPlay) VolSlider1.value = -VolumeControl1.Volume If InitialVolume = Zero Then InitialVolume = VolumeControl1.Volume End If LowerVolume = SettingsGet(iniName, RegSettings, "LowerVolume", LowerVolume) UpperVolume = SettingsGet(iniName, RegSettings, "UpperVolume", Hundred) Label3(Five).ForeColor = ForeFace Exit Sub Resume FailedInit: gCancel = True If inDesign Then Stop MsgBoxEx "Error " & Err & ". Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "PF_Ending..." inGrid_SendSpeech_BackColor = OffGray If inGrid_ForDoEvents_BackColor <> vbBlack Then inGrid_ForDoEvents_BackColor = vbGreen '\\ inGrid_ForDoEvents_BackColor = inGrid.ForDoevents.BackColor End If inGrid.ForDoevents.MousePointer = One '\\ Unload Me End With End Sub Private Sub Form_MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbLeftButton Then Call GetCursorPos(MousePos) SaveX = MousePos.x SaveY = MousePos.y ElseIf Button = vbMiddleButton Then If Not IngridLoaded Then Unload Me Exit Sub End If If Abs(inGrid.Top - Me.Top) < Sixty Or inGrid.WindowState <> vbNormal Then inGrid.WindowState = vbNormal inGrid.Show vbModeless inGrid.move Val(SettingsGet(iniName, RegSettings, "MainLeft", DefaultBot(300, 300))), Val(SettingsGet(iniName, RegSettings, "MainTop", DefaultBot(1890, 1890))) inGrid.Visible = True IngridHidden = Zero Else If inGrid.WindowState = vbNormal Then inGrid.move Me.Left, Me.Top inGrid.Visible = False '\\ Hide IngridHidden = One End If Else End If End Sub Private Sub Form_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbLeftButton Then Static inMove As Boolean If inMove Then Exit Sub inMove = True Call GetCursorPos(MousePos) SaveX = (MousePos.x - SaveX) * xPixel SaveY = (MousePos.y - SaveY) * yPixel DrumsMove Call GetCursorPos(MousePos) SaveX = MousePos.x SaveY = MousePos.y inMove = False ElseIf Me.imgLogo.Visible = False Then '\\ Me.Slider2.Enabled = Me.Frame2.Visible = False Me.imgLogo.Visible = True Me.BongoMan.Enabled = True End If End Sub Private Sub Form_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Call MouseupFormDrumColor(Button, Shift, x, y) End Sub Private Sub Form_Unload(ByRef Cancel As Integer): LoseControl Me With Me Dim lWork As Long On Error Resume Next Call SettingsSave(iniName, RegSettings, "DeviceToControl", VolumeControl1.DeviceToControl) .Visible = False If Not StartUpTypeIsPreview Then If .WindowState = vbNormal Then SaveX = .Left SaveY = .Top If .frmPicture1(One).Top = Zero Then SaveX = -SaveX End If If .Height = .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height Then SaveY = -SaveY End If If .Left Mod Screen.Width = .Left Then SettingsSave iniName, "Music", "Drums.Left", SaveX SettingsSave iniName, "Music", "Drums.Top", SaveY SettingsSave iniName, "Music", "Drums.Height", .Height End If End If If (UpDown_Volume.value Mod 50) > One And UpDown_Volume.value <> 25 Then SettingsSave iniName, "Music", "Volume", UpDown_Volume.value SettingsSave iniName, "Music", "Reverb", chkReverb.value SettingsSave iniName, "Music", "Loop", chkLoop.value ' SettingsSave iniName, "Music", "Tempo", EDIT_Tempo.Caption SettingsSave iniName, "Music", "Groove", LIST_Grooves.ListIndex SettingsSave iniName, "Music", "Bands", LIST_Bands.ListIndex SettingsSave iniName, "Music", "GearsEnabled", ManualGearing.ForeColor SettingsSave iniName, "Music", "CPUUsage", .CPUUsage.Appearance End If If Not perf Is Nothing Then .StopCmd = True .cmdStop = True End If Dim lCount As Long On Error Resume Next ReDim path(Zero) If Not (segBand Is Nothing) Then perf.StopEx segBand, Zero, Zero segBand.Unload perf.GetDefaultAudioPath End If If Not (dmSegDrum Is Nothing) Then perf.StopEx dmSegDrum, Zero, Zero Set dmSegDrum = Nothing For lCount = LBound(segMotif) To UBound(segMotif) If Not (segMotif(lCount) Is Nothing) Then perf.StopEx segMotif(lCount), Zero, Zero Set segMotif(lCount) = Nothing Next Set segBand = Nothing Set style = Nothing Set composer = Nothing '\\ Set loader = Nothing If Not (band Is Nothing) Then Call band.Unload(perf) End If Set band = Nothing '\\ Set perf = Nothing '\\ on error Resume Next '\\ Get rid of our event perf.RemoveNotificationType DMUS_NOTIFY_ON_SEGMENT g_dx.DestroyEvent mlSeg Call CloseHandle(mlSeg) '\\ Unload our segment dmSegMotif.Unload perf.GetDefaultAudioPath Set dmSegMotif = Nothing If Not (perf Is Nothing) Then perf.CloseDown '\\ Get rid of our motifs ReDim moMotifs(Zero) '\\ Cleanup '\\ perf.CloseDown Set perf = Nothing Set loader = Nothing DJHandle = Zero '\\ Set Grid_Amp = Nothing If gAns <> -Sixty Then '\\ precarious hibernate flag If Not (m_oHeyIngridDJ Is Nothing) Then m_oHeyIngridDJ.quitunload '\\ False Set m_oHeyIngridDJ = Nothing End If End If If m_lAfterWinampOnEngaging = vbUnchecked Then Exit Sub ElseIf .LabelAlign.Caption = "exit WinampTV" Or m_lAfterWinampOnEngaging = vbGrayed Then Dim lhandle As Long lhandle = GetWAHandleWinampTV If lhandle <> Zero Then Call PostMessageByNum(lhandle, WM_CLOSE, vbNull, vbNull) If FindWindow(NotString, "ManyCam Options") <> Zero And m_bCamon Then Shell "taskkill.exe /f /t /im ManyCam.exe" End If If FindWindow(NotString, "mIRC") <> Zero Then Shell "taskkill.exe /f /t /im mIRC.exe" End If End If End If GDIDeleteDMgraphics dmDrumsLoaded = False End With End Sub Public Sub EnablePlayUI(ByRef fEnable As Boolean) 'Enable/Disable the buttons If fEnable Then chkLoop.Enabled = True cmdStop.Enabled = False cmdExternalHelper(ExternalHelper).Enabled = True ' 20260124 'cmdMovingPicturesXML cmdSegment.Enabled = True cmdStop.ZOrder One Else chkLoop.Enabled = False cmdStop.Enabled = True cmdExternalHelper(ExternalHelper).Enabled = False ' 20260124 'cmdMovingPicturesXML cmdSegment.Enabled = False cmdStop.ZOrder Zero End If If lstMotif.ListCount > Zero And lstMotif.ListIndex <> -One Then EnablePlayMotif Not fEnable Else EnablePlayMotif False End If End Sub Public Sub EnablePlayMotif(ByVal fEnable As Boolean) cmdPlayMotif.Enabled = fEnable End Sub Private Sub LoadSegment(ByVal sFile As String) Dim lTrack As Long, lCount As Long Dim oStyle As DirectMusicStyle8 Dim lTotalStyle As Long, lTempTotalStyle As Long On Error GoTo LeaveProc ReDim moMotifs(Zero) lstMotif.Clear Set dmSegMotif = loader.LoadSegment(sFile) dmSegMotif.Download perf.GetDefaultAudioPath txtSegment.Text = sFile EnablePlayUI True '\\ Now let's get the motifs in this segment Do While True Set oStyle = dmSegMotif.GetStyle(lTrack) lTotalStyle = lTotalStyle + oStyle.GetMotifCount - 1 ReDim Preserve moMotifs(lTotalStyle) For lCount = Zero To oStyle.GetMotifCount - 1 lstMotif.AddItem oStyle.GetMotifName(lCount) Set moMotifs(lTempTotalStyle + lCount).Motif = oStyle.GetMotif(oStyle.GetMotifName(lCount)) moMotifs(lTempTotalStyle + lCount).name = oStyle.GetMotifName(lCount) moMotifs(lTempTotalStyle + lCount).ListIndex = lstMotif.ListCount - 1 Next lTrack = lTrack + One lTempTotalStyle = lTotalStyle Loop LeaveProc: If lstMotif.ListCount > Zero Then lstMotif.ListIndex = Zero UpdateStatus "File loaded." End Sub Private Sub UpdateStatus(sStat As String) txtMotifStatus.Text = sStat End Sub Public Sub GrooveUp() On Error GoTo errorline '\\ me.EDIT_Tempo.caption = me.EDIT_Tempo.caption + cyclez * Int(xaxis) If Mp3PlayDoc > Zero Then Dim i As Long, k As Long '\\ , J As Long, m As Long k = Genre.ListIndex If k < Zero Then Exit Sub If Not Me.Genre.Selected(k) And DMStatus = Zero Then If Not HIDJNext Then Exit Sub If Not Perturbate Then Exit Sub Exit Sub End If i = Genre.ItemData(k) If i < Zero Then '\\ get the mod of groove and band '\\ -999 says the is no data so do nothing LIST_Grooves.ListIndex = (-i Mod Thousand) - One '\\ (LIST_Grooves.ListCount) LIST_Bands.ListIndex = lMax(Zero, Int(-i / Thousand) - One) '\\ Mod (LIST_Bands.ListCount) Else If LabelGrooves(One).ToolTipText Like "###.##%" Then Populist (Int(Left(LabelGrooves(One).ToolTipText, Six)) - 55) End If End If Else If Rnd > PointSeven Then LIST_Grooves.ListIndex = (LIST_Grooves.ListIndex + One) Mod (LIST_Grooves.ListCount) If Rnd > PointSeven Then LIST_Bands.ListIndex = (LIST_Bands.ListIndex + One) Mod (LIST_Bands.ListCount) End If perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * Eight) + One) ChangeBands Exit Sub errorline: ' stop End Sub Public Sub Whack(ByRef itemtype As Long, ByVal r1 As Long, Optional ByRef lFlags As Long = Zero) '\\ , ByVal Volume As Long, ByRef x As Single, ByRef y As Single, ByRef z As Single If PF_Ending Then Exit Sub On Error Resume Next Static DrumHit As Long, MeterHeight As Long If lFlags = Zero Then lFlags = DMUS_SEGF_SECONDARY If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_BEAT If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_DEFAULT If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_GRID If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_MEASURE End If If r1 > Thousand Then r1 = r1 Mod Thousand Else r1 = (Abs(r1) + Abs(xaxis) - Two + StartDrumRoll) Mod 25 End If If r1 = -One Then Exit Sub If itemtype = Construct Then r1 = Abs(24 - r1) Mod 25 If Abs(r1 + One) = Abs(StartDrumRoll) Then If StartDrumRoll < Zero Then Exit Sub Else StartDrumRoll = -StartDrumRoll If Rnd < PointSeven Then Exit Sub End If End If End If '\\ Call perf.PlaySegmentEx(segMotif(Abs(r1)), lFlags, Zero) If Spiral <= UBound(path) Then Set path(Spiral) = Nothing Set path(Spiral) = perf.GetDefaultAudioPath '\\ path(Spiral).SelectedVolume Volume, 0 '\\ If itemtype = element Then Me.Drum(DrumHit).Font.Bold = False '\\ If DrumHit = r1 Then Call perf.StopEx(segMotif(Abs(r1)), Zero, DMUS_SEGF_BEAT Or DMUS_SEGF_VALID_START_MEASURE Or DMUS_SEGF_ALIGN) '\\ '\\ Else Call perf.PlaySegmentEx(segMotif(Abs(r1)), lFlags, Zero, , path(Spiral)) DrumHit = Abs(r1) '\\ End If Me.Drum(Abs(r1)).Font.Bold = True If MeterHeight < ConstMeterHeight Then MeterHeight = (MeterHeight + ConstMeterHeight) * Half Me.CPUUsage.Height = MeterHeight End If End If Me.Drum(Abs(r1)).BackColor = MyBrush.lbColor End Sub Private Sub Drum_Click(ByRef Index As Integer) If Me.UpDown_Volume = One Then Me.UpDown_Volume.value = Hundred End If HitDrum Index End Sub Private Sub EDIT_Tempo_KeyPress(KeyAscii As Integer) Dim lWork As Long If KeyAscii = vbKeyReturn Then If Val(EDIT_Tempo.Caption) > Zero And Val(EDIT_Tempo.Caption) < 1001 And IsNumeric(EDIT_Tempo.Caption) Then lWork = ChangeTempo(EDIT_Tempo.Caption) End If End If If KeyAscii = vbKeyReturn Then KeyAscii = Zero End Sub Private Sub EDIT_Tempo_LostFocus() Dim lWork As Long If Not IngridLoaded Then Exit Sub If Val(EDIT_Tempo.Caption) > Zero And Val(EDIT_Tempo.Caption) < 1001 And IsNumeric(EDIT_Tempo.Caption) Then lWork = ChangeTempo(EDIT_Tempo.Caption) End If End Sub Private Sub Get_Bands() Dim BandCount As Integer Dim counter As Integer BandCount = style.GetBandCount() For counter = Zero To (BandCount - 1) LIST_Bands.AddItem (style.GetBandName(BandCount - counter - 1)) Next counter End Sub 'Private Sub frmPicture2_Click() ' 'End Sub ' Private Sub frmPicture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then Call GetCursorPos(MousePos) SaveX = MousePos.x SaveY = MousePos.y ElseIf Button = vbMiddleButton Then If Not IngridLoaded Then Unload Me Exit Sub End If If Abs(inGrid.Top - Me.Top) < Sixty Or inGrid.WindowState <> vbNormal Then inGrid.WindowState = vbNormal inGrid.Show vbModeless inGrid.move Val(SettingsGet(iniName, RegSettings, "MainLeft", 300)), Val(SettingsGet(iniName, RegSettings, "MainTop", 1890)) inGrid.Visible = True IngridHidden = Zero Else If inGrid.WindowState = vbNormal Then inGrid.move Me.Left, Me.Top inGrid.Visible = False '\\ Hide IngridHidden = One End If ElseIf Button = vbRightButton Then Me.move inGrid.Left End If End Sub Private Sub frmPicture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Me.cmdSave.Enabled = False Then Exit Sub 'stupid bug 20170721 see "weird 2" If Button = vbLeftButton Then Static inMove As Boolean If inMove Then Exit Sub inMove = True Call GetCursorPos(MousePos) SaveX = (MousePos.x - SaveX) * xPixel SaveY = (MousePos.y - SaveY) * yPixel DrumsMove SaveX = MousePos.x SaveY = MousePos.y inMove = False ElseIf Me.imgLogo.Visible = False Then '\\ Me.Slider2.Enabled = Me.Frame2.Visible = False Me.imgLogo.Visible = True Me.BongoMan.Enabled = True End If End Sub Private Sub frmPicture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton And Index = Zero Then Dim Color As Long Color = Int(((GetPixel(Me.frmPicture1(Index).hdc, x / xPixel, y / yPixel) - vbBlue) Mod vbGreen) / Eight) If Color <= 31 And Color >= Zero Then If Color < Two Then Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") Else Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") If Color <= ScheduleCol + One Then Color = Color - One End If End If fDoc(ScheduleMth).ZOrder Zero fDoc(ScheduleMth).Visible = True ScheduleSync Color, (x - (Me.Drum((Color - Three) Mod Seven).Left - Sixty)) / Me.Drum(Zero).Width * TwentyFour End If End If End Sub Private Sub Genre_GotFocus() SetStatus Me.Genre End Sub Private Sub Genre_ItemCheck(ByRef item As Integer) If Me.GenreEnabled Then SetDirty True, Mp3PlayDoc End Sub Private Sub Genre_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbMiddleButton Then ShellExecute Zero, "open", "explorer", Quotes & Left$(Mp3FilenameNowPlaying, InStrRev(Mp3FilenameNowPlaying, "\")) & Quotes, Zero, One WA_OpenFileInfoBox End If End Sub Private Sub Genre_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Left$(Me.Genre.ToolTipText, Len(Me.Genre.list(Me.Genre.ListIndex))) = Me.Genre.list(Me.Genre.ListIndex) Then Exit Sub Me.Genre.ToolTipText = Me.Genre.list(Me.Genre.ListIndex) & " - " & Trim$(Mid$(Me.Genre.ToolTipText, InStr(Me.Genre.ToolTipText, "-") + One)) Me.Genre.SetFocus End Sub Private Sub Genre_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then PopupMenu inGrid.mnuGenre Else If Not Me.Genre.Selected(Me.Genre.ListIndex) And Me.cmdBeatmix.Caption = "Biasmix" Then If Me.LabelBPM_ForeColor >= vbBlue Then '\\ see PreparingNextTrack If WA_GetShuffle = Zero Then WA_SetShuffle One SpeakThis "Shuffling on " & Me.Genre.list(Me.Genre.ListIndex) End If End If End If FreshPlot "Perturbate", , True '\\ ensures accurate track length End If End Sub Private Sub Label3_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Dim lWork As Long If Index = Two Then SetTrickle Trickle.chkEngage.value = vbChecked ' WA_CloseWinamp ' Call WritePrivateProfileStringKey("Winamp", "dspplugin_name", "dsp_djHelp.dll", WinampInidir) ' Call WritePrivateProfileStringKey("Winamp", "dspplugin_num", "0", WinampInidir) ElseIf Button = vbMiddleButton Then CrossFadeTime = m_lCrossfadeTime 'Twenty ' Me.Label3(One).ToolTipText = CrossFadeTime If Me.UpperVolPreset Then lWork = WinAmpControls("LessVolume") Else lWork = WinAmpControls("SetVol") End If End If End Sub Private Sub LabelGrooves_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then Me.GenreEnabled = (Me.GenreEnabled + One) Mod Three SetGenreEnabled '\\ SetGenreSelected ElseIf Button = vbMiddleButton Then Me.lblDrumSize.Caption = "- drums ^" Me.frmPicture1(One).Top = DRUMPADSIZE Me.Height = 6615 Me.Top = fHIDJ.Top + fHIDJ.Height ElseIf Button = vbRightButton And Index = Zero Then If LabelGrooves(Zero).ForeColor = vbOrange Then ' KarmaGunAfterStartup = True RecordingNow = True ' LabelGrooves(zero).ForeColor = vbGreen ElseIf LabelGrooves(Zero).ForeColor = vbGreen Then ' KarmaGunAfterStartup = True RecordingNow = True LabelGrooves(Zero).ForeColor = vbYellow Else RecordingNow = False ' LabelGrooves(Zero).ForeColor = vbOrange ' KarmaGunAfterStartup = False 'this causes a delayed off for Recording at end of track End If End If End Sub Private Sub LabelVol_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim lWork As Long If Button = vbLeftButton Then lWork = WinAmpControls("VolUp", , False) ElseIf Button = vbRightButton Then lWork = WinAmpControls("VolDn", , False) End If End Sub Private Sub LabelVol_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim lWork As Long If Button = vbMiddleButton Then CrossFadeTime = m_lCrossfadeTime 'Twenty ' Me.Label3(One).ToolTipText = CrossFadeTime If Me.UpperVolPreset Then lWork = WinAmpControls("LessVolume") ElseIf Me.LowerVolPreset Then lWork = WinAmpControls("SetVol") If DMStatus <> One Then PlayWinamp End If ElseIf Button = vbLeftButton Then lWork = WinAmpControls("VolUp", , False) ElseIf Button = vbRightButton Then lWork = WinAmpControls("VolDn", , False) End If End Sub Private Sub lblClose_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Close_MouseUp Button End Sub Private Sub lblStatus_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_lblStatus Button End Sub Private Sub LIST_Bands_GotFocus() SetStatus Me.LIST_Bands End Sub Private Sub LIST_Bands_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.LIST_Bands.SetFocus End Sub Private Sub LIST_Bands_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) SetMp3playing End Sub Private Sub LIST_Grooves_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) SetMp3playing End Sub Private Sub lstMotif_GotFocus() SetStatus lstMotif End Sub Private Sub ManualGearing_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.ManualGearing.ZOrder End Sub Private Sub imgLogo_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me Dim lWork As Long If Button <> vbMiddleButton Then '\\ inoperable due to proc ' .Frame2.Visible = True ' .imgLogo.Visible = False Else If .BongoMan.Width = .Frame2.Width + Sixty Then GridOut.Visible = True inGrid.Visible = True PictureLoaded = False lWork = SetParent(GridOut.Picture2.hwnd, GridOut.hwnd) .BongoMan.move .AutoTempo.Left - 15, .txtMotifStatus.Top, 870, 1800 End If End If End With End Sub Private Sub imgLogo_OLEDragDrop(ByRef data As DataObject, ByRef Effect As Long, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Call OLEDragDropEx(data, Effect, Button, Shift, x, y) '\\ fDoc(gDoc),fDoc(gDoc), End Sub Private Sub LabelBPM_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_LabelBPM Button End Sub Private Sub LIST_Bands_Click() ChangeBands End Sub Private Sub LIST_Grooves_Click() perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * 8) + One) End Sub Private Sub LIST_Grooves_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MakeForegroundWindow Me.hwnd Me.Slider1.ZOrder One Me.Slider1.Visible = True Me.Slider1.SetFocus End Sub Private Sub lstMotif_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me If OnTop Then Exit Sub If .Height <> .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height Then ElseIf .frmPicture1(One).Top = Zero Then .lblDrumSize.Caption = "- drums ^" .Height = 2790 '2340 Else .lblDrumSize.Caption = "- drums ^" .Height = 6615 '6165 End If If Button = vbLeftButton Then cmdPlayMotif = True lstMotif.SetFocus End With End Sub Private Sub BongoMan_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) BongoMan.SetFocus If OnTop Then Exit Sub On Error Resume Next If TrickleLoaded Then If Trickle.WindowState <> vbNormal Then Trickle.WindowState = vbNormal inGrid.Show vbModeless Trickle.Show vbModeless End If If Not inGrid.Visible Then inGrid.WindowState = vbNormal inGrid.Show vbModeless inGrid.ZOrder Zero End If End If End Sub Private Sub BongoMan_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me On Error GoTo errorline If Button = vbMiddleButton Then '\\ code not finished due to serious Proc bug .BongoMan.Enabled = True .BongoMan.AutoRedraw = True .BongoMan.move -20, -20, .Frame2.Width + Sixty, .Frame2.Height + Sixty WindowMe .BongoMan.hwnd .BongoMan.ZOrder FrontFlipper = Ten ElseIf Button = vbLeftButton Then If Not DJHandle = Zero Then If HIDJstatus = One Then If .UpDown_Volume.value = Zero Then MsgBoxEx "Drum volume set to zero disables BPM Learning" Exit Sub End If .AutoTempo.ZOrder dmdrums_autotempo_backcolor = vbButtonFace workbuffer = MP3ID3v1Tag.Comment If Shift = vbShiftMask Then Mid$(workbuffer, One, Seven) = "000.00%" MP3ID3v1Tag.Comment = workbuffer MP3ID3v1Tag.Update End If '\\ mid$(MP3Tag.Comment, one, seven) = "000.00%" '\\ Call PutTagV1(Mp3FilenameNowPlaying, MP3Tag) .AutoTempo.ZOrder End If End If ElseIf Button = vbRightButton Then ToggleWinamp End If Exit Sub Resume errorline: ' stop End With End Sub Private Sub ManualGearing_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' Click toggles Automatic Tempo gearing. If Me.ManualGearing.ForeColor = vbOrange Then Me.ManualGearing.ForeColor = vbCyan Else Me.ManualGearing.ForeColor = vbOrange End If End Sub Private Sub MonthView1_DateDblClick(ByVal DateDblClicked As Date) Me.DTPicker1.value = Me.MonthView1.value SyncSchedule (Me.DTPicker1.value) End Sub Private Sub MonthView1_GetDayBold(ByVal StartDate As Date, ByVal count As Integer, state() As Boolean) If PF_Ending Then Exit Sub If DateValue(Now) = DateValue(MonthView1.value) Then If StartUpChime = Zero Then DTPicker1.value = Now Else DTPicker1.value = MonthView1.value End If Call SyncSchedule(Me.DTPicker1.value) If ScheduleMth > Zero Then Front True, fDoc(ScheduleMth) End If End Sub Private Sub MonthView1_GotFocus() SetStatus MonthView1 End Sub Private Sub MonthView1_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MonthView1.SetFocus End Sub Private Sub MonthView1_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.DTPicker1.value = Me.MonthView1.value If Button = vbLeftButton Then Exit Sub If Button = vbRightButton Then Me.MonthView1.Visible = False: Exit Sub End If If Button = vbMiddleButton Then Me.DTPicker1.value = Now Me.MonthView1.Visible = False End If Call SyncSchedule(Me.DTPicker1.value) End Sub Private Sub MonthView1_SelChange(ByVal StartDate As Date, ByVal EndDate As Date, Cancel As Boolean) If Day(DTPicker1.value) <> Day(MonthView1.value) And DateValue(MonthView1.value) <> DateValue(MonthView1.VisibleDays(One)) Then DTPicker1.value = MonthView1.value SyncSchedule DTPicker1.value '\\ schedulecol attempted bug correction End If End Sub Private Sub optBeat_GotFocus() SetStatus optBeat End Sub Private Sub optDefault_GotFocus() SetStatus optDefault End Sub Private Sub optGrid_GotFocus() SetStatus optGrid End Sub Private Sub optImmediate_GotFocus() SetStatus optImmediate End Sub Private Sub optMeasure_GotFocus() SetStatus optMeasure End Sub Private Sub Slider1_GotFocus() SetStatus Me.LIST_Grooves End Sub Private Sub Slider1_Scroll() With Me Do While True .Slider1.Max = .LIST_Grooves.ListCount - One If .Slider1.value < One Then If .Slider1.value = -One Then .LIST_Grooves.ListIndex = Zero .Slider1.value = .Slider1.Max Exit Do Else .Slider1.value = .Slider1.Max - One End If ElseIf .Slider1.value = .Slider1.Max Then .Slider1.value = Zero End If .LIST_Grooves.ListIndex = .Slider1.value Exit Do Loop .Play = True End With End Sub Private Sub Slider2_GotFocus() SetStatus AutoTempo End Sub Private Sub Slider2_Scroll() SongTime 6, False Me.Slider2.Max = Me.AutoTempo.ListCount - One If Me.Slider2.value < Zero Then Me.Slider2.value = Zero '\\ Me.AutoTempo.ListIndex End If SetAutoTempoListIndex Me.Slider2.value workbuffer = MP3ID3v1Tag.Comment Mid$(workbuffer, One, Seven) = Left$(AutoTempo.list(dmDrums.AutoTempo.ListIndex), Six) & "%" MP3ID3v1Tag.Comment = workbuffer MP3ID3v1Tag.Update SongTime 7, True Me.Play = True End Sub Private Sub StopCmd_Click() On Error Resume Next perf.StopEx dmSegDrum, Zero, Zero chkReverb.Enabled = True End Sub Public Sub TempoMultiplier_Click(ByRef Index As Integer) If TempoIndex > Index And Index = Zero Then If Not SendSound("changedn.wav", , True, One) Then Exit Sub ElseIf TempoIndex < Index And Index = Three Then Call SendSound("changeup.wav", , True) End If Me.ManualGearing.ForeColor = vbOrange TempoIndex = Index Select Case Index Case Zero TempoFactor = One / Four If Me.ManualGearing.ForeColor = vbCyan And inGrid_ForDoEvents_BackColor <> OffGray Then If Not Perturbate Then Exit Sub TempoFactor = 0.5001 '\\ this is a flag not to change into Low until upshifted TempoMultiplier(One) = True Exit Sub End If Case One If TempoFactor <> 0.5001 Then TempoFactor = Half Case Two If TempoFactor <> 1.0001 Then TempoFactor = One Case Three TempoFactor = Two '\\ One + Half If Me.ManualGearing.ForeColor = vbCyan And inGrid_ForDoEvents_BackColor <> OffGray Then If Not Perturbate Then Exit Sub TempoFactor = 1.0001 '\\ this is a flag not to change into overdrive until downshifted TempoMultiplier(Two) = True Exit Sub End If End Select SongTime 8, False '\\ True End Sub Private Sub Play_Click() PlaySeg ChangeBands chkReverb.Enabled = False If inGrid_SendSpeech_BackColor <> vbYellow Then If Me.cmdExternalHelper(One).Enabled = False And Me.cmdSave.Enabled = False Then ' 20260124 'cmdMovingPicturesXML Me.cmdSave.Enabled = True End If inGrid_SendSpeech_BackColor = vbYellow End If End Sub Private Sub TempoMultiplier_DblClick(ByRef Index As Integer) TempoIndex = Index Select Case Index Case Zero TempoFactor = One / Four Case One TempoFactor = Half Case Two TempoFactor = One Case Three TempoFactor = Two '\\ One + Half End Select SongTime 9, True End Sub Private Sub TempoMultiplier_MouseMove(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim PseudoTempo As Single Select Case Index Case Zero PseudoTempo = One / Four Case One PseudoTempo = Half Case Two PseudoTempo = One Case Three PseudoTempo = Two '\\ One + Half End Select '\\ determine base by knowing which tempo selector is visible PseudoTempo = Me.EDIT_Tempo * PseudoTempo / TempoFactor ' Me.TempoMultiplier(Index).ToolTipText = "Opp.Click (" & Index & ") sets " & format(PseudoTempo, "000.00") & " into ID3v1Tag.Comment" End Sub Private Sub TempoMultiplier_MouseUp(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then If Not m_TempoSelector = -One Then Me.TempoMultiplier(m_TempoSelector).BackColor = CoalFace If Index = m_TempoSelector Then m_TempoSelector = -One Else m_TempoSelector = Index Me.TempoMultiplier(m_TempoSelector).BackColor = vbGreen m_CurrentGenreSorting = SettingsGet(iniName, "Preferences", "GenreSortMask" & m_TempoSelector, m_CurrentGenreSorting) SetStation End If Call SettingsSave(iniName, "Preferences", "TempoSelector", m_TempoSelector) End If End Sub Private Sub txtSegment_GotFocus() SetStatus txtSegment End Sub Private Sub txtSegment_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) txtSegment.SetFocus End Sub Private Sub txtMotifStatus_GotFocus() SetStatus txtMotifStatus End Sub Private Sub txtMotifStatus_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) txtMotifStatus.SetFocus End Sub Private Sub txtMotifStatus_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbMiddleButton Then MP3ID3v2Tag.MP3File = Mp3FilenameNowPlaying txtMotifStatus.Text = "http://www.allmusic.com/cg/amg.dll?P=amg&opt1=1&sql=" & TrimNull(MP3ID3v2Tag.artist) Allmusic = txtMotifStatus.Text txtMotifStatus.SelStart = Zero txtMotifStatus.SelLength = Len(txtMotifStatus.Text) DocSetupAllmusic If AllmusicDoc > Zero Then fDoc(AllmusicDoc).PopupMenu fDoc(AllmusicDoc).mnuSong2text End If ' Set MP3ID3v2Tag = Nothing End If End Sub Private Sub UpDown_Fine_Tempo_Change() Dim lWork As Long LabelBPM.Caption = Format(UpDown_Fine_Tempo.value / Ten, "0.0") & "%BPM" lWork = BPMcolor(UpDown_Fine_Tempo.value / Ten) LabelBPM_ForeColor = lWork '\\ the following factors are used by Sub DoItToIt to change the state space of the DJHelper Tempo Slider TempoSliderAdjustmentLength = Twenty '\\ If UpDown_Fine_Tempo.Enabled And LabelBPM_Enabled Then EndTempoSlider = UpDown_Fine_Tempo.value DelayTempoSliderFlag = True StartTempoSliderTimer = Timer Else DelayTempoSliderFlag = False End If ' Label3(Five).ForeColor = ForeFace '(lblDrumSize.ForeColor + Label3(One).ForeColor) * Half lblDrumSize.ForeColor = LabelBPM_ForeColor ' lblDrumSize.Caption = "drums" End Sub Private Sub UpDown_Fine_Tempo_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Me.EDIT_Tempo.ZOrder ElseIf Button = vbLeftButton Then DelayTempoSliderFlag = False SetSliderDJTempo False End If End Sub Private Sub UPDOWN_Volume_Change() EDIT_Volume.Caption = UpDown_Volume.value ' If UpDown_Volume.value = 50 Then Stop If (UpDown_Volume.value Mod 50) > One And UpDown_Volume.value <> 25 Then SelectedVolume = UpDown_Volume.value Select Case UpDown_Volume.value Case 25 EDIT_Volume.BackColor = vbBlack EDIT_Volume.ForeColor = vbGreen Case 100, 50 EDIT_Volume.BackColor = vbBlack EDIT_Volume.ForeColor = vbWhite Case Is < 2 EDIT_Volume.BackColor = vbWhite EDIT_Volume.ForeColor = vbBlack Case Else EDIT_Volume.BackColor = vbBlack EDIT_Volume.ForeColor = vbCyan End Select EDIT_Volume.BorderStyle = One If UpDown_Volume.Enabled = True Then Call ChangeVolume(UpDown_Volume.value) End Sub Private Sub ChangeBands() On Error Resume Next If Not (band Is Nothing) Then Call band.Unload(perf) Set band = Nothing End If If Not (segBand Is Nothing) Then Call segBand.Unload(perf) Set segBand = Nothing End If If LIST_Bands = vbNullString Then Set band = style.GetBand("Standard") Else Set band = style.GetBand(LIST_Bands) End If Call band.Download(perf) Set segBand = band.CreateSegment() segBand.Download perf.GetDefaultAudioPath Call perf.PlaySegmentEx(segBand, DMUS_SEGF_SECONDARY, Zero) End Sub Private Sub PlaySeg() On Error Resume Next Call perf.PlaySegmentEx(dmSegDrum, Zero, Zero) End Sub Public Function ChangeTempo(ByVal Tempo As Single) '\\ , Optional ByVal NowFineTempo As Double = Infini) As Single On Error Resume Next ChangeTempo = Tempo * TempoFactor * (One + UpDown_Fine_Tempo.value / Thousand) If inGrid.TimeStep.value < Zero Then inGrid.TimeStep.value = -250 / (ChangeTempo / Sixty) '\\ why -250? End If perf.SendTempoPMSG Zero, DMUS_PMSGF_MUSICTIME, ChangeTempo End Function Sub ChangeItemVolume(ByVal n As Long) If n = Zero Then n = -10000 Else n = (-50 * (100 - n)) End If End Sub Sub ChangeVolume(ByVal n As Long) If n = Zero Then n = -10000 Else n = (-50 * (100 - n)) End If If Me.UpDown_Volume.value = Zero Then '\\ And Me.AutoTempo.Enabled SetScrollText "Drum volume set to zero disables BPM Learning" End If If Not perf Is Nothing Then perf.SetMasterVolume n '20120813 bug End Sub Public Property Get LabelBPM_Enabled() As Boolean LabelBPM_Enabled = m_bLabelBPM_Enabled End Property Public Property Let LabelBPM_Enabled(ByVal bLabelBPM_Enabled As Boolean) m_bLabelBPM_Enabled = bLabelBPM_Enabled ' wtf? unchangeable while another form is shown vbmodal LabelBPM.Enabled = m_bLabelBPM_Enabled If m_bLabelBPM_Enabled = False Then SetLabelKeyForeColor vbRed End If End PropertyVERSION 5.00 Object = "{0791F269-FBBF-46AD-B5A6-78DB890BFA5F}#2.0#0"; "VolumeCtrl.ocx" Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.Ocx" Object = "{E3583FCE-0595-4681-9ACD-48F7805DEFE1}#1.0#0"; "glxpbuttonz.ocx" Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX" Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx" Begin VB.Form frmDMDrums AutoRedraw = -1 'True BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "DMDrums" ClientHeight = 6285 ClientLeft = -885 ClientTop = 5190 ClientWidth = 5790 FillStyle = 0 'Solid BeginProperty Font Name = "MS Serif" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Icon = "frmDMDrums.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6285 ScaleWidth = 5790 Begin RichTextLib.RichTextBox rWinampPlaylist Height = 750 Left = 6045 TabIndex = 95 Top = 2385 Visible = 0 'False Width = 1500 _ExtentX = 2646 _ExtentY = 1323 _Version = 393217 RightMargin = 1.50000e5 TextRTF = $"frmDMDrums.frx":014A End Begin VB.PictureBox frmPicture1 BackColor = &H80000001& BorderStyle = 0 'None Height = 3000 Index = 1 Left = 45 ScaleHeight = 3000 ScaleWidth = 5745 TabIndex = 30 Top = 3225 Width = 5745 Begin VB.CommandButton cmdExternalHelper BackColor = &H80000001& Caption = "Caruso" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 1 Left = 1005 Style = 1 'Graphical TabIndex = 43 ToolTipText = """Caruso interprets sLastLockFilename on Gemini - Edge"" Opp.click for Green toggle, Mid.Click or (CtrlShift+Opp.Click) for swotGPT" Top = 1200 Visible = 0 'False Width = 765 End Begin MSComctlLib.Slider VolSlider1 Height = 1545 Left = 1755 TabIndex = 77 ToolTipText = "Mid.Click to Blank Screen. Opp.Click to reset InitialVolume or LowerVolume or UpperVolume" Top = 435 Width = 225 _ExtentX = 397 _ExtentY = 2725 _Version = 393216 Orientation = 1 Min = -100 Max = 0 SelStart = -100 TickFrequency = 15 Value = -100 TextPosition = 1 End Begin VB.CommandButton cmdPlayPause BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 1 Left = 15 Picture = "frmDMDrums.frx":01D3 Style = 1 'Graphical TabIndex = 91 ToolTipText = "Left.Click toggles/holds Winamp on/off. Mid.Click starts Winamp and Direct Music Drums." Top = 885 UseMaskColor = -1 'True Width = 390 End Begin MSComCtl2.MonthView MonthView1 Height = 2070 Left = 2910 TabIndex = 78 Top = 360 Visible = 0 'False Width = 2625 _ExtentX = 4630 _ExtentY = 3651 _Version = 393216 ForeColor = -2147483630 BackColor = -2147483647 BorderStyle = 1 Appearance = 1 OLEDropMode = 1 MultiSelect = -1 'True ScrollRate = 1 ShowWeekNumbers = -1 'True StartOfWeek = 313851905 CurrentDate = 38028 End Begin VB.CommandButton cmdBeatmix BackColor = &H80000001& Caption = "&MixInGrid" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 1005 Style = 1 'Graphical TabIndex = 36 ToolTipText = "Click to swap DRUMPADSIZE. Opp.Click to try to IngridMixSync or (Mid.Click) to start Beatmixing 'temposync' instance" Top = 885 Visible = 0 'False Width = 765 End Begin VB.CommandButton CommandGridArt BackColor = &H80000001& Caption = "^Grid&Art" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 1005 Style = 1 'Graphical TabIndex = 45 ToolTipText = $"frmDMDrums.frx":0536 Top = 420 UseMaskColor = -1 'True Width = 765 End Begin VB.CommandButton cmdPlayPause BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 0 Left = 15 Picture = "frmDMDrums.frx":0609 Style = 1 'Graphical TabIndex = 50 ToolTipText = "Left.Click starts Winamp and Direct Music Drums. Mid.Click toggles/holds Winamp on/off." Top = 885 UseMaskColor = -1 'True Width = 390 End Begin VB.CommandButton cmdHaltPlay BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 420 Picture = "frmDMDrums.frx":064B Style = 1 'Graphical TabIndex = 51 ToolTipText = "Mid.Click to start recording Mouse Macro. Click to stop." Top = 885 UseMaskColor = -1 'True Width = 390 End Begin VB.CommandButton cmdPlayMotif BackColor = &H80000001& Caption = "Plugin" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 6005 Style = 1 'Graphical TabIndex = 79 Top = 450 Visible = 0 'False Width = 765 End Begin VB.ListBox Genre BackColor = &H80000001& Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 285 ItemData = "frmDMDrums.frx":0B01 Left = 0 List = "frmDMDrums.frx":0D88 Style = 1 'Checkbox TabIndex = 34 ToolTipText = "deSelect to skip. Opp.Click for menu. Mid.Click to Explorer & File Info." Top = 135 Width = 1350 End Begin VB.Frame ManualGearing BackColor = &H80000001& Caption = "¼ ½ 1 2x " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 420 Left = 15 TabIndex = 37 ToolTipText = "Click toggles Automatic Tempo gearing. " Top = 435 Width = 1005 Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "2x" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 3 Left = 705 Style = 1 'Graphical TabIndex = 41 Top = 180 Width = 285 End Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "1" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 2 Left = 465 Style = 1 'Graphical TabIndex = 40 Top = 180 Value = -1 'True Width = 285 End Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "½" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 1 Left = 240 Style = 1 'Graphical TabIndex = 39 Top = 180 Width = 285 End Begin VB.OptionButton TempoMultiplier BackColor = &H80000001& Caption = "¼" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 285 Index = 0 Left = 0 Style = 1 'Graphical TabIndex = 38 Top = 180 Width = 285 End End Begin VB.CheckBox chkLoop BackColor = &H80000001& Caption = "&Loop Segment" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 30 TabIndex = 80 ToolTipText = "When Grayed will not randomly play and Play plays system MIDI" Top = 2340 Value = 2 'Grayed Width = 1350 End Begin VB.CommandButton cmdStop BackColor = &H80000001& Caption = "RadioOff" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Left = 1005 Style = 1 'Graphical TabIndex = 47 ToolTipText = "Mid.Click to close all and Shutdown Windows" Top = 435 UseMaskColor = -1 'True Width = 765 End Begin VB.CommandButton cmdSegment BackColor = &H80000001& Caption = "Segment &File" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 270 Left = 0 Style = 1 'Graphical TabIndex = 87 Top = 2610 UseMaskColor = -1 'True Width = 1140 End Begin VB.CommandButton cmdSave BackColor = &H80000001& Caption = "&sort^>>|" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 0 Style = 1 'Graphical TabIndex = 49 ToolTipText = $"frmDMDrums.frx":1547 Top = 1215 UseMaskColor = -1 'True Visible = 0 'False Width = 795 End Begin VB.OptionButton optMeasure BackColor = &H80000001& Caption = "Measure" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 4620 Style = 1 'Graphical TabIndex = 85 Top = 2325 Width = 990 End Begin VB.OptionButton optBeat BackColor = &H80000001& Caption = "Beat" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 3945 Style = 1 'Graphical TabIndex = 84 Top = 2325 Width = 675 End Begin VB.OptionButton optGrid BackColor = &H80000001& Caption = "Grid" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 3240 Style = 1 'Graphical TabIndex = 83 Top = 2325 Width = 690 End Begin VB.OptionButton optImmediate BackColor = &H80000001& Caption = "Learning" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2220 Style = 1 'Graphical TabIndex = 82 Top = 2325 Width = 1035 End Begin VB.TextBox txtSegment BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1170 Locked = -1 'True TabIndex = 86 Top = 2595 Width = 4455 End Begin VB.OptionButton optDefault BackColor = &H80000001& Caption = "Default" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1395 Style = 1 'Graphical TabIndex = 81 Top = 2325 Value = -1 'True Width = 855 End Begin MSComctlLib.ProgressBar CPUUsage Height = 645 Left = 810 TabIndex = 44 Tag = "progressbar.htm" ToolTipText = "Click to toggles Fps" Top = 885 WhatsThisHelpID = 20510 Width = 150 _ExtentX = 265 _ExtentY = 1138 _Version = 393216 Appearance = 1 Orientation = 1 End Begin MSComCtl2.UpDown UpDown_Volume Height = 510 Left = 15 TabIndex = 54 Top = 1545 Width = 240 _ExtentX = 423 _ExtentY = 900 _Version = 393216 Value = 100 Max = 100 Enabled = -1 'True End Begin MSComCtl2.UpDown UpDown_Fine_Tempo Height = 435 Left = 0 TabIndex = 55 TabStop = 0 'False ToolTipText = "Change Fine_Tempo - Opp.click for Tempo" Top = 1545 Visible = 0 'False Width = 300 _ExtentX = 529 _ExtentY = 767 _Version = 393216 Value = 2 Max = 500 Min = -500 Enabled = -1 'True End Begin VB.Frame Frame2 BackColor = &H80000001& BorderStyle = 0 'None BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2160 Left = 1815 TabIndex = 59 Top = 135 Visible = 0 'False Width = 3780 Begin VB.PictureBox BongoMan AutoRedraw = -1 'True BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1800 Left = 720 Picture = "frmDMDrums.frx":15CF ScaleHeight = 116 ScaleMode = 3 'Pixel ScaleWidth = 53 TabIndex = 73 TabStop = 0 'False ToolTipText = $"frmDMDrums.frx":2301 Top = 315 Width = 855 End Begin VB.CheckBox chkMute BackColor = &H80000001& Caption = "&Mute" ForeColor = &H000080FF& Height = 240 Left = 0 TabIndex = 76 ToolTipText = $"frmDMDrums.frx":23A5 Top = 1890 Width = 690 End Begin VB.Frame Frame1 BackColor = &H80000001& BorderStyle = 0 'None Height = 1620 Left = 100 TabIndex = 63 Top = 270 Width = 585 Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Line" ForeColor = &H000080FF& Height = 255 Index = 1 Left = 120 Style = 1 'Graphical TabIndex = 65 Top = 240 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Aux" ForeColor = &H000080FF& Height = 225 Index = 6 Left = 120 Style = 1 'Graphical TabIndex = 70 Top = 1350 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Wav" ForeColor = &H000080FF& Height = 255 Index = 5 Left = 120 Style = 1 'Graphical TabIndex = 69 Top = 1125 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "CD" ForeColor = &H000080FF& Height = 255 Index = 4 Left = 120 Style = 1 'Graphical TabIndex = 68 Top = 915 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Syn" ForeColor = &H000080FF& Height = 255 Index = 3 Left = 120 Style = 1 'Graphical TabIndex = 67 Top = 690 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Mic" ForeColor = &H000080FF& Height = 255 Index = 2 Left = 120 Style = 1 'Graphical TabIndex = 66 Top = 465 Width = 450 End Begin VB.OptionButton Option1 BackColor = &H80000001& Caption = "Main" ForeColor = &H000080FF& Height = 255 Index = 0 Left = 120 Style = 1 'Graphical TabIndex = 64 Top = 30 Width = 450 End End Begin VB.ListBox AutoTempo BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1815 ItemData = "frmDMDrums.frx":2442 Left = 705 List = "frmDMDrums.frx":2444 Sorted = -1 'True TabIndex = 71 ToolTipText = $"frmDMDrums.frx":2446 Top = 300 Width = 885 End Begin VB.TextBox txtMotifStatus BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Left = 1590 Locked = -1 'True MultiLine = -1 'True OLEDragMode = 1 'Automatic OLEDropMode = 2 'Automatic TabIndex = 72 ToolTipText = "Mid.Click to call up a menu for text handling of the current song" Top = 300 Width = 2175 End Begin VB.ListBox lstMotif BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1620 Left = 1590 TabIndex = 75 Top = 510 Width = 2175 End Begin MSComctlLib.Slider Slider2 Height = 1755 Left = 930 TabIndex = 74 Top = 360 Visible = 0 'False Width = 435 _ExtentX = 767 _ExtentY = 3096 _Version = 393216 Enabled = 0 'False Orientation = 1 Min = -1 Max = 0 End Begin MSComCtl2.DTPicker DTPicker1 Height = 255 Left = 690 TabIndex = 92 ToolTipText = $"frmDMDrums.frx":24CD Top = 15 Width = 2235 _ExtentX = 3942 _ExtentY = 450 _Version = 393216 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Tahoma" Size = 6.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty CustomFormat = "ddd dd MMM yyyy HH:mm:ss" Format = 313851907 UpDown = -1 'True CurrentDate = 38200 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C0C0C0& Height = 480 Index = 5 Left = -345 TabIndex = 61 Top = -105 Width = 120 End Begin VB.Label lblDTStatus Alignment = 1 'Right Justify BackColor = &H80000001& Caption = "No Active Schedule" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 225 Left = 1005 TabIndex = 93 Top = 45 Width = 1695 End Begin VB.Label lblClose BackColor = &H008080FF& Caption = " +" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 200 Index = 1 Left = 3600 TabIndex = 60 ToolTipText = "Click again to abort Closing..." Top = -120 Visible = 0 'False Width = 280 End Begin VB.Label lblStatus BackColor = &H80000001& Caption = "Switch" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 3060 TabIndex = 62 ToolTipText = "Click or Opp.click to add or subtrack 30 ExtraSeconds before next play. Mid.Click to SetGenreEnabled" Top = 60 Width = 705 End End Begin VB.CommandButton cmdExternalHelper BackColor = &H80000001& Caption = "swotGPT" CausesValidation= 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Index = 0 Left = 1005 Style = 1 'Graphical TabIndex = 104 ToolTipText = $"frmDMDrums.frx":255C Top = 1200 Width = 765 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C000C0& Height = 555 Index = 4 Left = 1050 TabIndex = 48 Top = 395 Width = 105 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 24 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000C000& Height = 555 Index = 3 Left = 1005 TabIndex = 46 Top = 350 Width = 105 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "HI DJ" BeginProperty Font Name = "Arial" Size = 14.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 315 Index = 2 Left = 1020 TabIndex = 42 Top = 885 Width = 705 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 480 Index = 1 Left = 1470 TabIndex = 32 Top = 0 Width = 120 End Begin VB.Label Label3 AutoSize = -1 'True BackColor = &H00000000& BackStyle = 0 'Transparent BeginProperty Font Name = "Arial" Size = 20.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0080C0FF& Height = 480 Index = 0 Left = 1485 TabIndex = 35 Top = 15 Width = 120 End Begin VB.Label LabelGrooves BackStyle = 0 'Transparent Caption = "+ grooves" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Index = 1 Left = 0 TabIndex = 102 Top = 135 Width = 1350 End Begin VB.Label LabelVol Alignment = 2 'Center BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "VOL" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Left = 15 TabIndex = 57 ToolTipText = "Winamp Click VolUp Opp.Click VolDn Mid.Click (cross)fades Winamp for beatmiixing, etc." Top = 2085 Width = 510 End Begin VB.Label LabelKey Alignment = 2 'Center BackColor = &H00000000& Caption = "G#m" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 225 Left = 255 TabIndex = 94 Top = 1830 Width = 600 End Begin VB.Label EDIT_Tempo Alignment = 2 'Center BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "255" Enabled = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 900 TabIndex = 53 ToolTipText = "Punch the Mouse Wheel to retrieve the Tempo from either the MP3 Comment or do a Screen Scrape of the AtomixMP3 BPM calculator" Top = 1515 Width = 855 End Begin VB.Label EDIT_Volume Alignment = 2 'Center BackColor = &H80000001& BorderStyle = 1 'Fixed Single Caption = "50" BeginProperty Font Name = "Microsoft Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 315 Left = 255 TabIndex = 52 ToolTipText = $"frmDMDrums.frx":2619 Top = 1515 Width = 615 WordWrap = -1 'True End Begin VB.Label LabelBPM Alignment = 1 'Right Justify BackColor = &H00000000& Caption = "BPM" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 225 Left = 840 TabIndex = 56 ToolTipText = $"frmDMDrums.frx":26F7 Top = 1830 Width = 900 End Begin VB.Label lblClose BackColor = &H008080FF& Caption = " +" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FFFFFF& Height = 195 Index = 0 Left = 5415 TabIndex = 33 ToolTipText = "Click again to abort Closing..." Top = 15 Visible = 0 'False Width = 285 End Begin VB.Label lblDrumSize BackStyle = 0 'Transparent Caption = "- drums ^" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Left = 15 TabIndex = 31 Top = -30 Width = 930 End Begin VB.Label LabelAlign Alignment = 2 'Center AutoSize = -1 'True BackColor = &H00000000& BorderStyle = 1 'Fixed Single Caption = "List Advance" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Left = 525 TabIndex = 58 ToolTipText = $"frmDMDrums.frx":27B4 Top = 2085 Width = 1230 End Begin VB.Image imgLogo Appearance = 0 'Flat BorderStyle = 1 'Fixed Single Height = 2175 Left = 1815 OLEDropMode = 1 'Manual Picture = "frmDMDrums.frx":284C Stretch = -1 'True Top = 105 Width = 3780 End End Begin VB.PictureBox frmPicture1 AutoRedraw = -1 'True BackColor = &H80000001& BorderStyle = 0 'None Height = 3270 Index = 0 Left = 60 ScaleHeight = 3270 ScaleWidth = 5700 TabIndex = 0 Top = 0 Width = 5700 Begin VB.OptionButton optStation Caption = "R" Height = 210 Index = 6 Left = 2985 Style = 1 'Graphical TabIndex = 100 ToolTipText = $"frmDMDrums.frx":8DA6 Top = 3015 Width = 225 End Begin VB.OptionButton optStation Caption = "A" Height = 210 Index = 1 Left = 2970 Style = 1 'Graphical TabIndex = 101 ToolTipText = "Acoustic, Classical, Easy_Listening, Jazz, Musicals, New_Age, Opera, Swing, Vocal" Top = 15 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "E" Height = 210 Index = 5 Left = 2985 Style = 1 'Graphical TabIndex = 99 ToolTipText = "Folk, Oldies, Pop, Rock _Roll, Soft_Rock" Top = 2430 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "D" Height = 210 Index = 4 Left = 2985 Style = 1 'Graphical TabIndex = 98 ToolTipText = "BlueGrass, Blues, Celtic, Country, Ethnic, Funk, Latin, R _B, Reggae, Soul, Soundtrack" Top = 1815 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "C" Height = 210 Index = 3 Left = 2985 Style = 1 'Graphical TabIndex = 97 ToolTipText = "Alternative, Hard_Rock, Metal, New_Wave, Psychedelic_Rock, Punk" Top = 1200 Width = 225 End Begin VB.OptionButton optStation Alignment = 1 'Right Justify Caption = "B" Height = 210 Index = 2 Left = 2985 Style = 1 'Graphical TabIndex = 96 ToolTipText = "Dance, Disco, Drum _Bass, Electronica, Hip_Hop, House, Rap, Techno, Trance" Top = 615 Width = 225 End Begin VB.CheckBox chkReverb BackColor = &H80000001& Caption = "&Environmental reverb" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 225 Left = 3435 TabIndex = 90 ToolTipText = "When Grayed will not randomly stop and Play must be manual" Top = 3015 Value = 2 'Grayed Width = 2220 End Begin VB.ListBox LIST_Bands BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1185 ItemData = "frmDMDrums.frx":8E48 Left = -15 List = "frmDMDrums.frx":8E4A Style = 1 'Checkbox TabIndex = 24 Top = 2045 Width = 1350 End Begin glxpbuttonz.UserButtonz UserButtonz Height = 435 Left = 1485 TabIndex = 103 Top = 495 Visible = 0 'False Width = 690 _ExtentX = 1217 _ExtentY = 767 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Tahoma" Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Caption = "Kick" IconHighLite = -1 'True IconHighLiteColor= 0 CaptionHighLite = -1 'True CaptionHighLiteColor= 0 Style = 1 Checked = 0 'False ColorButtonHover= 160 ColorButtonUp = 128 ColorButtonDown = 240 BorderBrightness= 2 ColorBright = 255 DisplayHand = -1 'True ColorScheme = 3 End Begin VB.CommandButton Drum BackColor = &H00EBEB75& Caption = "Sticks" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 22 Left = 3165 Style = 1 'Graphical TabIndex = 27 ToolTipText = "Physical Proximity Alert" Top = 2595 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00F7D46D& Caption = "Hand Clap" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 21 Left = 2340 Style = 1 'Graphical TabIndex = 26 ToolTipText = "Public Interface Mask" Top = 2595 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FFE1AA& Caption = "Tamb- orine" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 20 Left = 1485 Style = 1 'Graphical TabIndex = 25 ToolTipText = "Resource Cache Defense" Top = 2595 Width = 690 End Begin VB.CommandButton Drum Appearance = 0 'Flat BackColor = &H00FFADA5& Caption = "Jingle Bells" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 19 Left = 4845 Style = 1 'Graphical TabIndex = 23 ToolTipText = "Outer Ledger Sentry" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FFCCC9& Caption = "Cast- anets" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 18 Left = 4005 Style = 1 'Graphical TabIndex = 22 ToolTipText = "LOGISTICS" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FF83CD& Caption = "Shaker" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 17 Left = 3165 Style = 1 'Graphical TabIndex = 21 ToolTipText = "OPERATIONS" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00FEACE1& Caption = "Triangle" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 16 Left = 2325 Style = 1 'Graphical TabIndex = 20 ToolTipText = "INTELLIGENCE" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00D778E7& Caption = "Cuica" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 15 Left = 1485 Style = 1 'Graphical TabIndex = 19 ToolTipText = "Drive Offline Isolation Node" Top = 1995 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00EDA8EB& Caption = "High Block" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 14 Left = 4845 Style = 1 'Graphical TabIndex = 17 ToolTipText = "Outbound Exfiltration Sentry" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00B27DF6& Caption = "Low Block" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 13 Left = 4005 Style = 1 'Graphical TabIndex = 16 ToolTipText = "PLANS" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00CEAAF7& Caption = "Guiro" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 12 Left = 3150 Style = 1 'Graphical TabIndex = 15 ToolTipText = "GUERRILLA Command" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H009186F4& Caption = "Agogo" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 11 Left = 2325 Style = 1 'Graphical TabIndex = 14 ToolTipText = "PERSONNEL" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00BDABF8& Caption = "Timbale" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 10 Left = 1485 Style = 1 'Graphical TabIndex = 13 ToolTipText = "Infiltration Detection Buffer" Top = 1395 Width = 690 End Begin VB.CommandButton Drum BackColor = &H007C9DF3& Caption = "High Conga" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 9 Left = 4830 Style = 1 'Graphical TabIndex = 12 ToolTipText = "Safehouse Perimeter Node" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00AAC5F7& Caption = "Low Conga" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 8 Left = 4005 Style = 1 'Graphical TabIndex = 11 ToolTipText = "COMMS" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H006ECAD5& Caption = "Crash" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 7 Left = 3165 Style = 1 'Graphical TabIndex = 10 ToolTipText = "Medical" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00A2E2DD& Caption = "Splash" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 6 Left = 2325 Style = 1 'Graphical TabIndex = 9 ToolTipText = "UNDERGROUND" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H0049F585& Caption = "Ride" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 5 Left = 1485 Style = 1 'Graphical TabIndex = 8 ToolTipText = "External Boundary Monitor" Top = 795 Width = 690 End Begin VB.CommandButton Drum BackColor = &H0082F6B0& Caption = "High Tom" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 4 Left = 4845 Style = 1 'Graphical TabIndex = 7 ToolTipText = "Propaganda/Information " Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H007EF14D& Caption = " Mid Tom" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 3 Left = 4005 Style = 1 'Graphical TabIndex = 6 ToolTipText = "Sabotage Prevention Check" Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H009BF296& Caption = "Low Tom" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 2 Left = 3165 Style = 1 'Graphical TabIndex = 5 ToolTipText = "Inbound Data Sieve" Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00C6EC4D& Caption = "Snare" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 1 Left = 2325 Style = 1 'Graphical TabIndex = 4 ToolTipText = $"frmDMDrums.frx":8E4C Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00CCED84& Caption = "Kick" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 0 Left = 1485 Style = 1 'Graphical TabIndex = 3 ToolTipText = $"frmDMDrums.frx":8EE2 Top = 195 Width = 690 End Begin VB.CommandButton Drum BackColor = &H00E7E753& Caption = "Scratch" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 23 Left = 4005 Style = 1 'Graphical TabIndex = 28 ToolTipText = "Ordnance/Supply Logistics Edge" Top = 2595 Width = 690 End Begin VB.CommandButton Drum BackColor = &H80000001& Caption = " High Q" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 435 Index = 24 Left = 4845 Style = 1 'Graphical TabIndex = 29 ToolTipText = "Final Exit Gateway / Air-Gap Severance" Top = 2595 Width = 690 End Begin MSComctlLib.Slider Slider1 Height = 1770 Left = 405 TabIndex = 2 Top = 60 Visible = 0 'False Width = 480 _ExtentX = 847 _ExtentY = 3122 _Version = 393216 Orientation = 1 Min = -1 End Begin VB.ListBox LIST_Grooves BackColor = &H80000001& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1860 ItemData = "frmDMDrums.frx":8F7D Left = -15 List = "frmDMDrums.frx":8F7F Style = 1 'Checkbox TabIndex = 1 Top = 15 Width = 1350 End Begin VolumeCtrl.VolumeControl VolumeControl1 Left = 0 Top = 0 _ExtentX = 1296 _ExtentY = 873 End Begin VB.Label LabelGrooves BackStyle = 0 'Transparent Caption = "+ grooves" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 255 Index = 0 Left = -15 TabIndex = 18 ToolTipText = "Click togles GenreEnabled. Opp.Click Toggles TOH Recording." Top = 1845 Width = 3015 End End Begin VB.CommandButton StopCmd BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 390 Left = 3300 Picture = "frmDMDrums.frx":8F81 Style = 1 'Graphical TabIndex = 88 Top = 6525 Width = 390 End Begin VB.CommandButton Play BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 390 Left = 2805 Picture = "frmDMDrums.frx":9437 Style = 1 'Graphical TabIndex = 89 Top = 6540 Visible = 0 'False Width = 390 End End Attribute VB_Name = "frmDMDrums" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit '\\ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '\\ '\\ Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved. '\\ '\\ File: frmPlayMotif.frm '\\ '\\ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Implements DirectXEvent8 Public cdlOpen As New frmCommonDialog Public AutoTempo_Visible As Boolean Public OnTop As Boolean Public Allmusic As String Public GenreEnabled As Long Public MovingPicturesXMLEnabled As Long Private p_DJReady As Boolean Private p_LabelBPM_ForeColor As Long Private Const DRUMPADSIZE As Long = 3240 Private m_bLabelBPM_Enabled As Boolean Public Property Get LabelBPM_ForeColor() As Long LabelBPM_ForeColor = p_LabelBPM_ForeColor End Property Public Property Let LabelBPM_ForeColor(ByVal LabelBPM_ForeColorObj As Long) If p_LabelBPM_ForeColor = LabelBPM_ForeColorObj Then Exit Property 'Or (p_LabelBPM_ForeColor = vbCyan And LabelBPM_ForeColorObj <> vbBlack) p_LabelBPM_ForeColor = LabelBPM_ForeColorObj Me.LabelBPM.ForeColor = LabelBPM_ForeColorObj ' Me.LabelBPM.BackColor = vbWhite - LabelBPM_ForeColorObj ' Me.LabelKey.BackColor = vbWhite - LabelBPM_ForeColorObj If Me.LabelBPM_ForeColor >= vbBlue Then '\\ see PreparingNextTrack If WA_GetShuffle = Zero Then WA_SetShuffle One End If ElseIf ListAdvanceColor <> vbYellow Then 'fixes m_bBeatmixer bug If WA_GetShuffle = One Then WA_SetShuffle Zero End If End If End Property Public Property Get DJReady() As Boolean DJReady = p_DJReady End Property Public Property Let DJReady(ByVal DJReadyObj As Boolean) p_DJReady = DJReadyObj Me.cmdSave.Visible = p_DJReady If p_DJReady = False And Not PF_Quiting Then SpeakThis "No DJ Helper Ready?" End If End Property Function BPMcolor(ByVal Difference As Single) As Long Select Case Abs(Difference) Case Is < Deci '\\ near Zero BPMcolor = vbBlack Case Is < One BPMcolor = vbRed Case Is < Two BPMcolor = vbOrange Case Is < Three BPMcolor = vbYellow Case Is < Four BPMcolor = vbGreen Case Is < Five BPMcolor = vbBlue Case Is < Six BPMcolor = vbMagenta Case Is < Seven BPMcolor = vbCyan Case Else BPMcolor = vbWhite End Select End Function Public Sub MouseupFormDrumColor(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Dim Color As Long Color = Int(((GetPixel(Me.hdc, x / xPixel, y / yPixel) - vbBlue) Mod vbGreen) / Eight) If Color <= 31 And Color >= Zero Then If Color < Two Then Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") Else Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") If Color <= ScheduleCol + One Then Color = Color - One End If End If fDoc(ScheduleMth).ZOrder fDoc(ScheduleMth).Visible = True ScheduleSync Color, (x - (Me.Drum((Color - Three) Mod Seven).Left - Sixty)) / Me.Drum(Zero).Width * TwentyFour End If End If End Sub Sub SetAutoTempoListIndex(ByVal Index As Long) Dim lWork As Long, Before As Single, After As Single AutoTempo.ListIndex = Index Before = EDIT_Tempo.Caption After = AutoTempo.list(AutoTempo.ListIndex) lWork = BPMcolor(Before - After) If lWork = vbRed And Int(Before) = Int(After) And Abs(Before - After) < Half Then lWork = Abs(Before - After) End If EDIT_Tempo.ForeColor = lWork EDIT_Tempo.BackColor = vbWhite - lWork End Sub Sub SetStation() Dim i As Long, J As Long, k As Long, l As Long J = Zero k = Six If optStation(k).value <> True Then 'UCase(Mid(m_CurrentGenreSorting, k, One)) <> "R" And For i = One To Five workbuffer = Mid(m_CurrentGenreSorting, i, One) If Asc(workbuffer) > 128 Then optStation(i).ForeColor = vbRed workbuffer = Chr$(Asc(workbuffer) Mod 128) Else optStation(i).ForeColor = vbBlack End If optStation(i).Caption = workbuffer l = Asc(UCase(optStation(i).Caption)) If l > J Then J = l k = i End If Next End If optStation(k).value = True optStation(k).BackColor = vbWhite Call SettingsSave(iniName, "Preferences", "GenreYearSortMask", m_CurrentGenreSorting) If m_TempoSelector <> -One Then Call SettingsSave(iniName, "Preferences", "GenreSortMask" & m_TempoSelector, m_CurrentGenreSorting) End Sub Public Sub TestForZeroVol() ' If VolSlider1.value = Zero Then ' QuitReader True ' here because no sound, even though this is done in HIDJOut ' Label3(One).ForeColor = vbBlue ' OneBell ' Else Label3(One).ForeColor = dmDrums.LabelVol.ForeColor '\\ vbBlue ' End If End Sub Private Sub chkMute_GotFocus() SetStatus chkMute End Sub Private Sub chkMute_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton Then Select Case chkMute.ForeColor Case vbRed '\\ LowerVolume VolSlider1.value = -InitialVolume chkMute.ForeColor = vbOrange Case vbCyan '\\ UpperVolume VolSlider1.value = -LowerVolume chkMute.ForeColor = vbRed Case Else '\\ vbOrange, vbGreen '\\ InitialVolume VolSlider1.value = -UpperVolume chkMute.ForeColor = vbCyan End Select ElseIf Button = vbLeftButton Then chkMute.value = Abs(One - chkMute.value) If chkMute.value = vbChecked Then VolumeControl1.Mute = True Else VolumeControl1.Mute = False End If End If End Sub Private Sub cmdBeatmix_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'Click to swap DRUMPADSIZE. Opp.Click to try to IngridMixSync or (Mid.Click) to start Beatmixing 'temposync' instance If Button = vbRightButton Then If m_bBeatmixer Then fHIDJ.IngridMixSync True Else SpeechThing = "Agent" frmTempoSync.Show vbModal End If ElseIf (Not m_bBeatmixer Or ListAdvanceColor = vbGreen) And (Button = vbMiddleButton Or (Shift = vbShiftMask And Button = vbLeftButton)) Then SpeechThing = "Agent" frmTempoSync.Show frmTempoSync.cmdOK = True Trickle.TrafficTimer.Interval = 30000 ElseIf Button = vbLeftButton Then With Me cmdPlayMotif = True If .frmPicture1(One).Top = Zero Then .lblDrumSize.Caption = "- drums ^" .frmPicture1(One).Top = DRUMPADSIZE If Abs(.Height - (.LabelVol.Top + .LabelVol.Height + 430)) < Sixty Then .Height = 6615 Else .Height = .Height + DRUMPADSIZE '+ 430 End If .Top = .Top - DRUMPADSIZE ' Fix the "Mist" from the CPU Freeze Drum(0).ToolTipText = "Intelligence" Drum(1).ToolTipText = "Counter-Intel" Drum(2).ToolTipText = "Logistics" Drum(3).ToolTipText = "Sabotage" Drum(4).ToolTipText = "Propaganda" Drum(5).ToolTipText = "Recruitment" Drum(6).ToolTipText = "Training" ' Drum(7) and (8) are already handled Drum(9).ToolTipText = "Safehouse" Drum(10).ToolTipText = "Infiltration" Drum(11).ToolTipText = "Exfiltration" ' ... and indices 21-24 for the remaining ROC layers ' SE Quadrant Triage Logic ' 20260209 ' Assuming Index 17 or 18 is your "Logistics" Triage Node Drum(18).ToolTipText = "Inner Triage: Logistics (ROC SE)" ' The two "expertise" drums it supports on the outer ring: Drum(4).ToolTipText = "Expertise: Finance / Resource Cache" Drum(23).ToolTipText = "Expertise: Ordnance / Supply" Else .lblDrumSize.Caption = "+ drums ^" .frmPicture1(One).Top = Zero If .Height = 6615 Then .Height = .LabelVol.Top + .LabelVol.Height + 430 Else .Height = .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height + 430 '\\ .Height - DRUMPADSIZE End If .Top = .Top + DRUMPADSIZE End If End With End If End Sub Private Sub cmdExternalHelper_Click(Index As Integer) If Index = Zero Then 'This function plays on a called shutdown and also on the hour of schedule entry. Opp.Click to play the whole Midi. or Reset Ingrid to stop, Mid.Click or (CtrlShift+Opp.Click) for Caruso If MsgBoxEx("This will rebuild the grid called MovingPicturesXML.ing", vbOKCancel) = vbCancel Then Exit Sub If chkLoop.value <> vbUnchecked Then dmSegMotif.SetRepeats INFINITE Else '\\ If chkLoop.value = vbUnchecked Then dmSegMotif.SetRepeats Zero End If perf.PlaySegmentEx dmSegMotif, Zero, Zero EnablePlayUI False DocSetupMovingPicturesXML MovingPicturesXMLPlay Else '"Caruso interprets sLastLockFilename on Gemini - Edge" Opp.click for Green toggle, Mid.Click or (CtrlShift+Opp.Click) for swotGPT Static CarusoTargetTitle As String Dim sCleanName As String Dim sYearMode As String ' 1. The Track: Identify the "Last Lock" sCleanName = sLastLockFilename ' Clean the path using the logic found in frmHIDJmain If InStrRev(sCleanName, "\") > 0 Then sCleanName = Mid$(sCleanName, InStrRev(sCleanName, "\") + 1) If InStrRev(sCleanName, ".") > 0 Then sCleanName = Left$(sCleanName, InStrRev(sCleanName, ".") - 1) GetCarusoSongData (sLastLockFilename) ' 2. The Marshalling: Check the "Car Radio" optStation(6) ' This reflects the [0-9]YYYY[0-9] vs [0-9][0-9]YYYY cold war If optStation(6).value = True Then sYearMode = "Strict-Y" Else sYearMode = "Relaxed-Y" End If ' 3. The sCamelot Key: Get the harmonic coordinate ' 4. Update the Sliver Monitor (frmPicture1) ' Hover over the sliver on your bike to see this: frmPicture1(One).ZOrder 0 ' Ensure it's in front of occluding controls frmPicture1(One).ToolTipText = "CUE: " & sCleanName & " | " & sYearMode & " | Key: " & sCamelot If SecondHand < -Twenty Then If iniName = vbNullString Then workbuffer = App.Title Else workbuffer = iniName End If workbuffer = "Readying " & workbuffer & " at " & Format(DateAdd("s", -SecondHand + Two, Now), "HH:MM:SS") Mid(workbuffer, Len(workbuffer)) = "0" Else workbuffer = SpokenTime End If workbuffer = workbuffer & Label3(One).Caption & " - Caruso interprets: '" & sCleanName & "' (" & sYearMode & ") Genre/Key: " & sGenre & "/" & sCamelot & ASpace & LabelBPM.Caption & ASpace & EDIT_Tempo.Caption & " ExternalHelper " & sCurrentDuration & "[Dur]" Debug.Print workbuffer If m_lAtenGreen Then workbuffer = workbuffer & vbCrLf & "CARUSO PROTOCOL ACTIVATED" & vbCrLf & _ "Node: 5700G" & vbCrLf & _ "Status: " & IIf(m_lAtenGreen, "LOCKED", "OPEN") & vbCrLf & _ "Gear: " & frmTrickle.TrafficTimer.Interval & vbCrLf & _ "Veneer: Edge/Matrix Bridge" Call SendMatrixPulse(workbuffer) Exit Sub Else Clipboard.Clear Clipboard.SetText workbuffer ' The train has its fangs; proceed with PushKeys to hCarusoHelper ' Call ExecuteAutomatedPushKeys(hCarusoHelper) SixorSeven9Smith = True ' Manual CNT, or Auto Notepad, or Edge If Caruso2NotePad2Edge(CarusoTargetTitle) Then ' // Only now do the PushKeys fire PushKeys "^{end}+{enter}", hCarusoHelper PushKeys "^v<[systime=", hCarusoHelper Delay Half PushKeys "%+{F12}" ', hCarusoHelper ' changing the order from +% to %+ fixed an earlier character drop Delay Half ' delay includes a doevents PushKeys "]+{enter}", hCarusoHelper Sleep Two PushKeys "{enter}", hCarusoHelper End If Exit Sub End If On Error Resume Next AppActivate "Edge" 'Google Gemini - Microsoft If Err.number = 0 Then ' 5. The Handoff to Edge (Silent DJ Mode) 'I set the color to green only mouse down and the final {Enter} 'WinampPlay will only send If .LowerVolPreset 'will only when GetToolbox says all on many-chat turned to green 'should the final {Enter} be sent. So, several layers of protection and 'you don't need to worry about getting flooded. Else ' Log if the browser is closed or renamed OneBell "Edge Island Disconnected: " & time cmdExternalHelper(Zero).BackColor = vbRed End If End If End Sub Private Sub cmdPlayPause_Click(ByRef Index As Integer) Dim lWork As Long ' Left.Click toggles/holds Winamp on/off. Mid.Click starts Winamp and Direct Music Drums. If Index = One Then ' If Button = vbRightButton Then ' UpDown_Volume.Tag = Timer ' GlobalPlayPause If DMStatus = One Then WA_Pause If Me.UpDown_Volume.value > One Then SetReaderVolume = Me.UpDown_Volume.value Me.UpDown_Volume.value = One Else '\\ If Me.UpDown_Volume.value <= One Then HIDJPlay If SecondsLeft > Ten Then 'Thirty 20120803 prevent global pause anomaly Me.UpDown_Volume.value = SetReaderVolume End If End If ' PlayStateChange = Billion 'this flag is to enable a global play/pause facility - 20120803 ' FreshPlot "Perturbate", , True ElseIf IngridLoaded Then '20120813 bug If inGrid.mnuViewDMDrums.Checked = False Or DJReady = False Or cmdSave.Enabled = False Then DJReady = True cmdPlayMotif.Visible = False Ingrid_mnuViewDMDrums_Checked True cmdSave.Enabled = True lWork = StartingHeyIngridDJ cmdPlayMotif.Visible = True '\\ just in case turned off while doevents Ingrid_mnuViewDMDrums_Checked True 'why twice? DJReady = True hWndWinamp = Zero '\\ incase -1 closed If fHIDJ.CheckWinamp(True) Then DJHelper 1, True End If End If If DMStatus <> One Or LowerVolPreset Or TrackSelected = True Then HIDJPlay If Me.UpDown_Volume.value <= One And SetReaderVolume <> Zero Then Me.UpDown_Volume.value = SetReaderVolume End If Else ScreenOff If GridOut.Timer1.Interval > Zero Then GridOut.Timer1.Enabled = False GridOut.Timer1.Interval = One GridOut.Timer1.Enabled = True SendSound "hyoshigi1.wav", , True If Abs(CycleZ) < Half Then spin End If Me.Play = True End If TrackSelected = False End If ' GlobalPlayPause Exit Sub errorline: ' stop DJHandle = -One End Sub Private Sub CommandGridArt_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'Right.Click Perturbates the whole system and sets Winamp Shuffle ON+Auto Advance. Left.Click (or Left+mask) toggles the KarmaGun (+shift=FullScreen or x&y<100). (Mid.Click a title in HeyIngridDJ = JumpToFile) If Button = vbMiddleButton And Shift = Zero Then '20241121 because of dead MiddleButton Button = vbLeftButton ElseIf Button = vbLeftButton And Shift = Zero Then Button = vbMiddleButton End If Call MouseUp_CommandGridArt(Button, Shift, x, y) End Sub Private Sub EDIT_Tempo_Change() EDIT_Tempo.ForeColor = vbRed EDIT_Tempo.BackColor = RGB(31, Zero, 15) Call ChangeTempo(EDIT_Tempo.Caption) '\\ SongTempo End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If PF_Ending Then Exit Sub Cancel = True Close_MouseUp One End Sub Private Sub Form_Resize() ' If Me.WindowState = vbMinimized And inGrid.mnuViewDMDrums.Checked = True Then ' Me.WindowState = vbNormal ' End If End Sub Private Sub imgLogo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton Then Dim Color As Long Dim lWork As Long, nVal As Long With frmDrumDown .SetDrumDownPictures .Show End With ' Me.AutoRedraw = False '' Me.Frame2.Visible = False ' Me.Refresh ' Color = GetPixel(Me.hdc, (x + imgLogo.Left) / xPixel, (y + imgLogo.Top) / yPixel) '' Me.Frame2.Visible = True ' Me.AutoRedraw = True ' ' Do While True ' For lWork = One To Two ' For nVal = One To Twelve ' If Color = g_arCamelotRGB(nVal, lWork) Then Exit Do ' Next ' Next ' ' Exit Sub ' Loop ' Me.LabelKey.ForeColor = Color ' Me.LabelKey.Caption = format(nVal, "00") & Chr$(64 + lWork) ElseIf Button = vbLeftButton Then Me.Frame2.Visible = True Me.imgLogo.Visible = False End If End Sub Private Sub Label3_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) ForceForegroundWindow Me.hwnd End Sub Private Sub LabelAlign_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then EnqueuedAt = Val(InputBox("EnqueuedAt", "Set value higher than zero to play to end of playlist", EnqueuedAt)) Call SettingsSave(iniName, "Music", "EnqueuedAt", EnqueuedAt) Exit Sub ElseIf Button = vbMiddleButton Then Select Case ListAdvanceColor Case vbGreen ListAdvanceColor = vbRed Case vbOrange ListAdvanceColor = vbYellow End Select PlaylistAdvance True ElseIf Button = vbRightButton Then If HIDJLoaded Then fHIDJ.PopupMenu fHIDJ.mnuPopupListAdvance End If End If 'to manually sever beatmixing If ListAdvanceColor = vbGreen Then dmDrums.LabelAlign.ForeColor = &H80FF80 Call SettingsSave(iniName, "Music", "ListAdvanceColor", vbBlack) 'black is the new green startup condition End If End Sub Private Sub lblDrumSize_Click() OnTop = Not OnTop If OnTop Then FrontFalseMe = True lblDrumSize = "on top" If TrickleLoaded Then Trickle.Visible = True End If Else FrontTrueMe = True lblDrumSize = "+ drums ^" If TrickleLoaded Then Trickle.Visible = False End If End If End Sub Private Sub lblDrumSize_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If Me.Height <> Me.frmPicture1(One).Top + Me.cmdBeatmix.Top + Me.cmdBeatmix.Height Then Me.lblDrumSize.Caption = "+ drums ^" Me.Height = Me.frmPicture1(One).Top + Me.cmdBeatmix.Top + Me.cmdBeatmix.Height + 430 '\\ 2790 End If End Sub Private Sub lblDTStatus_Click() SetTrickle Trickle.RunAsScr = vbChecked dmDrums.DTPicker1.Visible = True End Sub Private Sub Option1_Click(Index As Integer) VolumeControl1.DeviceToControl = Index If VolumeControl1.Mute = True Then chkMute.value = vbChecked Else chkMute.value = vbUnchecked End If End Sub Private Sub optStation_GotFocus(Index As Integer) SetStatus optStation(Index) End Sub Private Sub optStation_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) optStation(Index).SetFocus End Sub Private Sub optStation_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) ' Opp.Click toggles upper/Lowercase for strict Year sort or not Call MouseUp_optStation(Index, Button) End Sub Private Sub UserButtonz_Click() UserButtonz.ForeColor = vbYellow End Sub Private Sub UserButtonz_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Call GetCursorPos(MousePos) ButtonzLastTop = MousePos.y * Screen.TwipsPerPixelY ButtonzLastLeft = MousePos.x * Screen.TwipsPerPixelX End Sub Private Sub UserButtonz_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Call GetCursorPos(MousePos) If ButtonzLastTop > Zero Then UserButtonz.Top = UserButtonz.Top - ButtonzLastTop + MousePos.y * Screen.TwipsPerPixelY If Me.Height - UserButtonz.Height > UserButtonz.Top Then ButtonzLastTop = UserButtonz.Top If ButtonzLastLeft > Zero Then UserButtonz.Left = UserButtonz.Left - ButtonzLastLeft + MousePos.x * Screen.TwipsPerPixelX If Me.Left - UserButtonz.Width > UserButtonz.Left Then ButtonzLastLeft = UserButtonz.Left End Sub Private Sub VolSlider1_Change() VolumeControl1.Volume = -VolSlider1.value TestForZeroVol End Sub Private Sub VolSlider1_GotFocus() SetStatus VolSlider1 End Sub Private Sub VolSlider1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If VolSlider1.Top = Zero Then Exit Sub '\\ i.e., parent not set to vbMaximized frmDocument ForceForegroundWindow Me.hwnd If Me.Height <> Me.frmPicture1(One).Top + Me.cmdBeatmix.Top + Me.cmdBeatmix.Height + 430 Then ElseIf Me.frmPicture1(One).Top = Zero Then Me.lblDrumSize.Caption = "- drums ^" Me.Height = 2790 Else Me.lblDrumSize.Caption = "- drums ^" Me.Height = 6615 End If Me.VolSlider1.SetFocus End Sub Private Sub VolSlider1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbMiddleButton Then SetMonitorPower mpOff, True ElseIf Button = vbRightButton Then Select Case chkMute.ForeColor Case vbRed '\\ LowerVolume LowerVolume = VolumeControl1.Volume Case vbOrange, vbGreen '\\ InitialVolume InitialVolume = VolumeControl1.Volume Case vbCyan '\\ UpperVolume UpperVolume = VolumeControl1.Volume End Select End If End Sub Private Sub VolSlider1_Scroll() VolumeControl1.Volume = -VolSlider1.value TestForZeroVol End Sub Private Sub VolumeControl1_MuteChanged(NewMute As Boolean) If VolumeControl1.Mute = True Then chkMute.value = vbChecked Else chkMute.value = vbUnchecked End If End Sub Private Sub VolumeControl1_VolumeChanged(NewVolume As Long) On Error GoTo errorline If VolSlider1.value <> -NewVolume Then VolSlider1.SetFocus If VolSlider1.value > -NewVolume Then If ReadDoc > Zero Then If Val(fDoc(ReadDoc).cmdSpeak.Caption) > Zero Then Call Front(False, fDoc(ReadDoc)) '\\ so keyboard will work fDoc(ReadDoc).DocText.SetFocus End If End If End If If NewVolume = InitialVolume And MP3Off = Zero Then '\\ set shutdown times wait If Play.Visible = False Then '\\ flag for start or end of raising volume instance UpDown_Fine_Tempo.value = SettingsGet(iniName, "Music", "Fine_Tempo", Zero) Play.Visible = True End If If TrickleLoaded Then MP3Off = Trickle.Laps.value * Trickle.Wait.value Trickle.lblMinPerInt.ForeColor = vbGreen Trickle.lblIntervals.ForeColor = vbGreen End If ElseIf MP3Off <> Zero And TrickleLoaded Then If Trickle.lblIntervals.ForeColor = vbGreen And VolSlider1.value < -NewVolume Then Trickle.lblIntervals.ForeColor = vbRed ElseIf Trickle.lblIntervals.ForeColor = vbRed And VolSlider1.value > -NewVolume Then Trickle.lblIntervals.ForeColor = vbGreen End If End If End If VolSlider1.value = -NewVolume '\\ here because lower down causes delayed resetting? Static LastTime As Single sAns = Timer If sAns - LastTime > Ten And UpperVolPreset Then '\\ otherwise agentsvr seems to crash If fAgent Is Nothing Then Load fAgent End If If LastTime = Zero Then fAgent.SetUpAgent "Volume Set at " & NewVolume, False fAgent.TheAgent.Listen True LastTime = sAns End If TestForZeroVol Exit Sub errorline: ' stop Dim lWork As Long lWork = Err If lWork = -2147418094 Then Unload fAgent If inDesign Then Stop Load fAgent fAgent.SetUpAgent "Hello again", False Resume Next End If End Sub Public Sub HitDrum(ByRef Index As Integer) On Error GoTo errorline '\\ If inGrid_ForDoEvents_BackColor <> vbBlack Then Call perf.PlaySegmentEx(segMotif(Index), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, Zero) If Me.Drum(Index).BackColor <> BackFace Then Me.Drum(Index).BackColor = BackFace Exit Sub End If Exit Sub Resume errorline: ' stop End Sub Sub RandomPlay() Dim lWork As Long Me.Play = True PerturbateOff = KarmaGunAfterStartup ' False lWork = Perturbate(, True) End Sub Sub ResetDrum(ByRef Index As Integer) Static item As Long If item = Index Then Exit Sub item = Index HitDrum Index If Me.Drum(Index).BackColor <> BackFace Then If inGrid_ForDoEvents_BackColor = OffGray Then Me.CPUUsage.Height = Me.CPUUsage.Height * Half End If End If SetStatus Drum(Index) End Sub Function PreparingNextTrack() As Boolean Dim lWork As Long On Error GoTo errorline Static DidItLastTime As Single QuitAnyLiveRecording If PF_Quiting Then GoTo ExitFunction If dmDrumsLoaded Then With dmDrums DMStatus = HIDJstatus '\\ DMStatus = ' Static SecondsLeftPrev As Long ' If SecondsLeftPrev = SecondsLeft And SecondsLeft > Zero Then ' Stop ' End If ' SecondsLeftPrev = SecondsLeft '\\ If Abs(CycleZ) > Half Then sTime = Timer ' SecondsLeft = Int(LastPerturbate + DEG - sTime) If DMStatus = Zero Then '\\ sTime - LastPerturbate >= DEG (SecondsLeft < Zero Or ) 'touchbug hunt If inDesign And Not True Then workbuffer = Mid(sLastLockFilename, InStrRev(sLastLockFilename, "\") + One) workbuffer = Left(workbuffer, Len(workbuffer) - Four) If workbuffer <> TaskNameEx(hPlayingFileName) Then If GridOut.Caption <> workbuffer Then GridOut.Caption = workbuffer OneBell "TaskNameEx(hPlayingFileName)" Else Call sndPlaySound(SoundDir & "ticking.wav", SND_ASYNC + SND_NOSTOP) End If End If End If workbuffer = vbNullString If Dir(Left(sLastLockFilename, InStr(sLastLockFilename, "\")), vbDirectory) = "" Then If MP3Off >= Zero Then If Not KarmaGunLoaded Then HIDJOut , True GoTo ExitFunction End If If m_bBeatmixer And Not SlaveBot And .LabelKey.ForeColor = vbOrange And Not PF_Ending Then ' ' this allows for immediate play of only second song HIDJNext HIDJPlay .LabelKey.ForeColor = vbGreen 'just because m_bBeatmixer not always safe Call SongTime(1020, True) If Not XDoEventsX Then FreshPlot "Perturbate", , True Exit Function End If If Mp3PlayDoc > Zero Then Do Do On Error Resume Next If SecondsLeft < Ten Then '\\ DMStatus = Zero Or If SecondHand < Zero Then If Abs(SecondHand - LastSecondHand) > Twenty Then 'Ten '\\ looking for missing minute bug If LastSecondHand < -Ten Then .RandomPlay ' End If End If LastSecondHand = SecondHand End If Static NextHalfMinute As Single If sTime + One >= NextHalfMinute Then '\\ OnePoint may be causing double entry by if XDoEventsX then exit sub '\\ 20111129 & 2007/01/09 & 2007/03/13 hopefully fixes nasty nasty lost minute looping bug If ExtraSeconds <> Zero And NextHalfMinute + Thirty > sTime Then ' i.e., within the current track ExtraSeconds = ExtraSeconds - Thirty End If SecondHand = SecondHand + One 'wtf? .Label3(Five).ToolTipText = ExtraSeconds NextHalfMinute = (Int((sTime + Ten) / Thirty) + One) * Thirty Else SecondHand = sTime Mod Thirty - ExtraSeconds End If If NextHalfMinute - sTime > Thousand Then 'after midnight? NextHalfMinute = (Int((sTime + Ten) / Thirty) + One) * Thirty End If .Label3(One).Caption = RealTime(SecondHand) .Label3(Zero).Caption = .Label3(One).Caption .Label3(Five).Caption = .Label3(One).Caption If LastSecondHand = DaySeconds Then If .UpperVolPreset And m_ManualTrackAdvance Then '\\ first time? '\\ this favors m_bBeatmixer so both instances don't get locked at high volume '\\ unless so desired If CBool(SettingsGet(iniName, RegSettings, "FadeVolume", True)) Then lWork = WinAmpControls("LessVolume", , False) End If TrackSelected = True End If End If If Mp3FilenameNowPlaying <> NotString Then If MP3Off = One Then '\\ +ve to close rather than shutdwn If Not KarmaGunLoaded Then '20220127 20260109 True Then HIDJOut ' , True'20220206 GoTo ExitFunction Else MP3Off = Zero End If ElseIf MP3Off = -One Then 'manual power off condition MP3Off = Zero End If SpecialSeconds = SpecialSeconds - One If SpecialSeconds > Zero Then GoTo ExitFunction End If If Not m_ManualTrackAdvance Then If EndOfTracks < Two Then GoTo ExitFunction If Not HIDJNext Then GoTo ExitFunction If WA_IsPlaying = Zero Then HIDJPlay '\\ what's this? End of Playlist. I thought Freshplot twice to say, "Hey, Ingrid DJ", toggle off other equalizer. FreshPlot End If Else If TrackSelected = False Or .LabelBPM_Enabled = False Then '\\ acting flag was set false in GetToolbox when > 6% lWork = InStr(One, Mp3FilenameLastSpoken, "\genre", vbTextCompare) Genreholder = "" If lWork > Zero Then Mp3FilenameLastSpoken = MidSong(Mp3FilenameLastSpoken, lWork + One) If dmDrumsLoaded Then If dmDrums.LabelBPM_Enabled Then '\\ just ended song and will only do this once cause genre stripped If EndOfTracks < Two Then GoTo ExitFunction '\\ OneBell MP3ID3v2Tag.MP3File = Mp3FilenameNowPlaying SpeakThisWhenever = g_arID3v1Genres(MP3ID3v1Tag.Genre) & ". " & MP3ID3v2Tag.OtherGenreName & ". In " & m_sCamelotKey & ". " & Mp3FilenameLastSpoken ' SpeakThis Mp3FilenameLastSpoken workbuffer = vbNullString If TrickleLoaded Then workbuffer = Trickle.lblDunAllow.ToolTipText If workbuffer <> NotString Then workbuffer = workbuffer & ". " End If fAgent.SetUpAgent workbuffer & SpeakThisWhenever, False 'Mp3FilenameLastSpoken If Not .Genre.Selected(.Genre.ListIndex) And .GenreEnabled = Two Then '\\ play all but shuffle after deselected items - see GenreSelected '\\ ElseIf Not GenreSelected And .cmdBeatmix.Caption = "Biasmix" Then If .LabelBPM_ForeColor >= vbBlue Then '\\ see PreparingNextTrack If WA_GetShuffle = Zero Then WA_SetShuffle One fAgent.TheAgent.Show SpeakThis "Shuffling on " & .Genre.list(.Genre.ListIndex) End If End If '\\ GenreSelected = True ' Exit Do End If ' .lblDrumSize.ToolTipText = Mp3FilenameLastSpoken '\\ also save here any BPMLEARNING codes and '\\ check that global status was confirmed to be needing a switch End If End If End If If (Abs(SecondHand) Mod Ten) < OnePointTwo And Abs(SecondHand) > Two Then 'OnePointTwo If DidItLastTime < Zero Then If Not m_bBeatmixer Or DelayTrackSelection >= Two Then If PF_Ending Then GoTo ExitFunction ComingUp TrackSelected = True '\\ maybe turned off by jtfe media item .LabelBPM_Enabled = True Else If Not DelayVolSliderFlag Then 'stops two songs playing through bug If .UpperVolPreset And Beatmixing Then '20220903 todo add "And MP3Off <> -One" first play test added to stop Slavebot playing during interrupted play If SecondHand > Zero And .LabelKey.ForeColor <> vbOrange Then 'if this happens more than Four times then assume a mixup and just play. Static lMixup As Long lMixup = lMixup + One If lMixup > Four + Abs(SlaveBot) Then 'so both sides don't start together lMixup = Zero HIDJRealNext ' ReduceMP3Off HIDJPlay Call SongTime(1020, True) If Not XDoEventsX Then FreshPlot "Perturbate", , True Exit Function End If ' If inDesign Then Stop Else Call WinAmpControls("LessVolume", , False) End If End If End If DelayTrackSelection = DelayTrackSelection + One End If DidItLastTime = sTime PreparingNextTrack = True Exit Function End If End If ElseIf Abs(SecondHand) < OnePointTwo Then If Not ((LastSecondHand > -Five And .LabelKey.ForeColor <> vbRed) Or Not m_bBeatmixer) Then 'LastSecondHand = SecondHand means not just back from IngridMixSync and above twenty second mark. WA_SetShuffle Zero TrackSelected = False ' ElseIf SlaveBot And .LabelKey.ForeColor = vbOrange Then ' dmDrums.LabelBPM_Enabled = False ' FreshPlot "Perturbate", , True ' fHIDJ.IngridMixSync ' HIDJNext 'first song bug? ' TrackSelected = False ElseIf Val(.Label3(Five).ToolTipText) = Zero Or ListAdvanceToGreenOnPlay Then '\\ Sixty - SecondHand < OnePointTwo Or - PointTwo'And SecondHand >= Zero'And ExtraSeconds = Zero ReduceMP3Off HIDJPlay End If ElseIf TrackSelected = True And (Abs(SecondHand) Mod Ten) < OnePointTwo Then If DidItLastTime < Zero Then DidItLastTime = sTime LastSecondHand = SecondHand If bEnqueuedTrackWaiting Then .LabelKey.ForeColor = vbGreen 'Cyan Else If .cmdPlayPause(One).BackColor = vbGreen And .LabelKey.ForeColor = vbRed Then If m_bBeatmixer And m_AutoDJActive Then fHIDJ.IngridMixSync ' If .LabelKey.ForeColor = vbRed Then 'not set to Coalface by above If .cmdBeatmix.Tag = vbGreen Then 'not set to Coalface by above If SecondHand > -Thirty Then 'last chance to set correct crossfade ' Call sndPlaySound(SoundDir & "ticking.wav", SND_ASYNC + SND_NOSTOP) ' ExtraSeconds = Zero FreshPlot "Perturbate", , True ' ManyChat.TimerSendData 'don't rely on doevents ' .cmdBeatmix.Tag = CoalFace ' not before because Freshplot resets it 'checks that other things require setting or does nothing '\\ NOT - see doittoit DelayVolSliderFlag '\\ this is where to put the thirty second tempo slider End If End If End If End If End If Exit Function End If End If ' If PreparingNextTrack Then Exit Do GoTo ExitFunction End If Else If Not HIDJNext Then GoTo ExitFunction ' If SecondsLeft < Zero And .UpperVolPreset And m_ManualTrackAdvance Then ' '\\ first time? ' '\\ this favors m_bBeatmixer so both instances don't get locked at high volume ' lWork = WinAmpControls("LessVolume", , False) ' End If End If End If gAns = SongTime(22, False) If gAns > Zero And gAns < Sixteen Then Delay One If gAns >= Ten Then Sleep 500 If DMStatus = One Then '\\ if not perturbate then GoTo exitfunction Else PreparingNextTrack = True End If End If End If Exit Do Loop gAns = SongTime(23, False) ' If GridOut.Timer1.Enabled = False Then ' GoTo exitfunction Else ' End If If .Genre.Selected(.Genre.ListIndex) Or .GenreEnabled = Zero Then Exit Do ElseIf Not .Genre.Selected(.Genre.ListIndex) And .GenreEnabled = One Then '\\ play but do not beatmix Exit Do ElseIf Not .Genre.Selected(.Genre.ListIndex) And .GenreEnabled = Two Then ' '\\ play all but shuffle after deselected items - see GenreSelected '' ElseIf Not GenreSelected And .cmdBeatmix.Caption = "Biasmix" Then ' If .LabelBPM_ForeColor = vbGreen Then '\\ see PreparingNextTrack ' If WA_GetShuffle = Zero Then ' WA_SetShuffle One ' SpeakThis "Shuffling on " & .Genre.list(.Genre.ListIndex) ' End If ' End If '' GenreSelected = True Exit Do ElseIf gAns = -One Then If WA_GetListLength <= WA_GetListPos Then WA_StartPlay Else If Not HIDJNext Then GoTo ExitFunction End If Else If Not HIDJNext Then GoTo ExitFunction End If If GridOut.Timer1.Enabled = False Then GoTo ExitFunction End If Loop Else If Mp3PlayDoc = Zero Then .GenreEnabled = CBool(SettingsGet(iniName, "Music", "Genre.Enabled", True)) If .GenreEnabled Then .SetGenreEnabled '\\ .SetGenreSelected Else Mp3PlayDoc = -Thousand End If End If gAns = SongTime(24, False) If gAns > Zero And gAns < Ten Then HIDJStop End If If (gAns < -One Or gAns > Zero) And WA_IsPlaying = Zero Then '\\ smoothes joint control If Not HIDJNext Then GoTo ExitFunction End If SongTime 25, False End If If Abs(sTime - LastPerturbate) < Thousand And LastPerturbate > Hundred Then '\\ how's this work? s/b Zero Then ' workbuffer = " at Number " & Mp3Off ' End If ' If ReadDoc = Zero And (.LIST_Grooves.ListIndex = -One Or .LIST_Bands.ListIndex = -One) Then ' SpeakThisWhenever = .Genre.list(.Genre.ListIndex) & " track " & .Caption & ". " & .Genre.list(.Genre.ListIndex) & " track " & MidSong(Mp3FilenameNowPlaying) & workbuffer '\\ , (workbuffer <> NotString) ' ElseIf ReadDoc > Zero And .Genre.ListIndex < .Genre.ListCount - One And Not TrackSelected Then ' If fDoc(ReadDoc).Watcher_Caption <> StopWatchCaption Then ' SpeakThisWhenever = .Caption & workbuffer '\\ , (workbuffer <> NotString) ' Else ' SpeakThisWhenever = Left$(.LabelGrooves(One).ToolTipText, Four) & .Genre.list(.Genre.ListIndex) & " track " & workbuffer '\\ , (workbuffer <> NotString) ' End If ' Else ' '\\ what's this? End of Track. I thought Freshplot twice to say, "Hey, Ingrid DJ", toggle on other equalizer. ' '\\ FreshPlot ' FreshPlot ' If LastSecondHand <> DaySeconds Then ' TrackSelected = False ' Else ' dmDrums.cmdBeatmix.Visible = True ' End If ' SpeakThisWhenever = .Caption & ". " & MidSong(Mp3FilenameNowPlaying) & workbuffer '\\ , (workbuffer <> NotString) ' End If ' ' End If ' If Not Perturbate Then GoTo exitfunction Else Else LastPerturbate = sTime - DEG + Val(SettingsGet(App.Title, "Preferences", "AutoDJTime", Thirty)) End If PreparingNextTrack = True End If ExitFunction: .DTPicker1.value = Now DidItLastTime = -sTime End With End If Exit Function Resume errorline: ' stop gAns = Err If gAns = -2147418107 Then SetScrollText "Hey, Ingrid D.J. WAKEUP!!" Else SetScrollText gAns & " PreparingNextTrack" End If End Function Sub AutoBPM() Dim lWork As Long Dim sngRet As Single If Me.Caption <> "DMDrums" And Len(Me.Label3(One).Caption) > One Then sngRet = Rnd If sngRet > PointSeven Then With GridOut If .Timer1.Enabled = True Then .Timer1.Enabled = False sngRet = inGrid.TimeStep.value If sngRet > Zero Then .Timer1.Interval = Thousand Else '\\ a factor of eleven somehow skips a beat .Timer1.Interval = lMin(60000, .Timer1.Interval - sngRet * Ten - sngRet) End If .Timer1.Enabled = True End If End With ElseIf sngRet > PointSeven Then Me.Label3(Zero).Caption = Space(Ten) & Me.Caption End If End If '\\ now to see if Ingrid will automatically save the median tempo '\\ with all the sounds off and running in the background at +50% this is quick. '\\ where Mid.Clicking the finetempo has set the speed to the max. '\\ make sure at least thirty seconds have elapsed since the start of the song so we have AutoBPM If Me.AutoTempo.ListCount = Zero Then If ListAdvanceColor = vbGreen Then dmDrums.EDIT_Tempo.Caption = "255" End If End If Call SongTime(2, False, , , sngRet) lWork = DJHelper(2, False) If lWork <= Zero Then Exit Sub 'not using Leo's DJ Helper End If If sngRet = Zero Then Me.optImmediate = True Me.Frame2.Visible = True Me.imgLogo.Visible = False dmdrums_autotempo_backcolor = vbButtonFace Me.Slider2.Enabled = False ElseIf Me.AutoTempo.ListCount = Zero And Left$(Me.LabelGrooves(One).ToolTipText, Seven) Like "###.##%" Then '\\ And Me.optDefault = True If SongAnalysedFromStart = vbUnchecked Then SongAnalysedFromStart = vbChecked SongTime 3, True If optImmediate <> True And UpDown_Fine_Tempo.value <> Zero Then If LabelBPM_ForeColor < vbBlue Then WA_SetShuffle Zero Else WA_SetShuffle One End If End If End If Me.optDefault = True End If sngRet = Val(TaskNameEx(hAutomaticBPM)) If sngRet = Zero Then '\\ a flag can go here to prove the whole song was analysed If dmDrums.AutoTempo.ListCount > Two Then Call DJHelper(3, True) 'in case Leo's DJ HElper plugin deselected SongAnalysedFromStart = vbUnchecked 'False End If Exit Sub End If '\\ An instruction - should this be shown again as a non modal form to allow sampling workbuffer = Format(sngRet / (One + UpDown_Fine_Tempo.value / Thousand), "000.00") Me.AutoTempo.AddItem workbuffer sngRet = Me.AutoTempo.ListIndex - Int((Me.AutoTempo.ListCount - One) / Two) '\\ manually induced median offset Me.Slider2.Min = -One Me.Slider2.value = Zero Me.Slider2.Max = Me.AutoTempo.ListCount - One Me.Slider2.Enabled = True If Me.AutoTempo.ListIndex >= Zero Then SetAutoTempoListIndex lMax(Zero, Me.AutoTempo.ListIndex) If sngRet <= One Then SetAutoTempoListIndex Int((Me.AutoTempo.ListCount - One) / Two) Else sngRet = sngRet + Int((Me.AutoTempo.ListCount - One) / Two) SetAutoTempoListIndex Me.AutoTempo.ListIndex + (sngRet + Sgn(Me.AutoTempo.list(Me.AutoTempo.ListIndex) - Me.AutoTempo.list(Me.AutoTempo.ListIndex + sngRet))) End If Else If Me.AutoTempo.ListCount > Zero Then SetAutoTempoListIndex Int((Me.AutoTempo.ListCount - One) / Two) End If Me.Slider2.value = Me.AutoTempo.ListIndex If Me.LabelGrooves(One).ToolTipText = Me.AutoTempo.list(Me.AutoTempo.ListIndex) Then Static BadEqualizerCount As Long BadEqualizerCount = BadEqualizerCount + One Else BadEqualizerCount = Zero End If If BadEqualizerCount > 3 Then OneBell "BadEqualizerCount" Me.LabelGrooves(One).ToolTipText = Me.AutoTempo.list(Me.AutoTempo.ListIndex) & "%" & Mid$(Me.LabelGrooves(One).ToolTipText, Eight) If Me.optImmediate = True Then '\\ initial learning Call SongTime(4, True, , , Me.AutoTempo.list(Me.AutoTempo.ListIndex)) End If End Sub Function DrumsMove(Optional ByVal positioned As Boolean = False) As Boolean Dim TopGrid As Long, NewLeft As Long '\\ , i As Long SaveTop As Single, SaveLeft As Single, If Not positioned Then SaveLeft = Me.Left SaveTop = Me.Top End If NewLeft = lMax(One, SaveLeft + SaveX) '\\ lmax(one is to enable a minus flag to be set if drums are not shown full size Me.move NewLeft, lMax(One, lMax(One, SaveTop + SaveY)) If Me.Height <> 6615 Then SaveY = Zero Else DrumsMove = True End If If Not ManyChat Is Nothing Then If Abs(ManyChat.Left - SaveLeft) < Hundred Then ManyChat.move Me.Left, ManyChat.Top + SaveY End If End If If TrickleLoaded Then If Trickle.WindowState = vbNormal Then If Abs(Trickle.Left - SaveLeft) < Hundred Then Trickle.move Me.Left, Trickle.Top + SaveY, Me.Width ElseIf Abs(Trickle.Left - (Me.Width + SaveLeft)) < Hundred Then Trickle.move Me.Left + Me.Width, Me.Width ElseIf Abs(Trickle.Left + Trickle.Width - SaveLeft) < Hundred Then Trickle.move Me.Left - Trickle.Width, Me.Width End If End If End If If Not fBoard Is Nothing Then If fBoard.WindowState = vbNormal And Abs(fBoard.Left - SaveLeft) < Hundred Then fBoard.move Me.Left, fBoard.Top + SaveY End If End If If Abs(inGrid.Top - SaveTop) < Hundred Then '\\ inGrid.Hide inGrid.move Me.Left, lMax(One, SaveTop + SaveY) ElseIf Abs(inGrid.Top - (SaveTop - Thousand)) < Hundred Then If Me.Top + Me.Height > Screen.Height Then ' some weird false startup condition inGrid.move Me.Left Else inGrid.move Me.Left, lMax(One, SaveTop + SaveY) - Thousand End If ElseIf Abs(inGrid.Left - SaveLeft) < Hundred Then inGrid.move Me.Left, inGrid.Top + SaveY ElseIf Abs(inGrid.Left - Abs(Me.Width + SaveLeft)) < Hundred Then inGrid.move Me.Left + Me.Width ElseIf Abs(inGrid.Width - Abs(inGrid.Left - SaveLeft)) < Hundred Then inGrid.move Me.Left - inGrid.Width End If If GridOut.WindowState = vbNormal Then If Abs(GridOut.Left - (SaveLeft + Me.Width)) < Hundred Then If Abs(GridOut.Top - inGrid.Top) < Hundred Then TopGrid = inGrid.Top + SaveY ElseIf Abs(GridOut.Top) > Hundred Then TopGrid = GridOut.Top + SaveY End If If Abs(Screen.Width - GridOut.Left - GridOut.Width) < Hundred Then GridOut.Timer1.Enabled = False GridOut.Timer1.Interval = One GridOut.Timer1.Enabled = True GridOut.move Me.Left + Me.Width, TopGrid, Screen.Width - GridOut.Left - SaveX Else GridOut.move Me.Left + Me.Width, TopGrid End If ElseIf Abs(GridOut.Left + GridOut.Width - SaveLeft) < Hundred Then TopGrid = GridOut.Top + SaveY GridOut.move Me.Left - GridOut.Width, TopGrid ElseIf Abs(GridOut.Top - (SaveTop - GridOut.Height)) < Hundred Then GridOut.move Me.Left, lMax(One, SaveTop - GridOut.Height + SaveY), Me.Width ElseIf Abs(GridOut.Left - SaveLeft) < Hundred And Abs(GridOut.Width - Me.Width) < Hundred Then GridOut.move Me.Left, GridOut.Top, Me.Width ElseIf Abs(GridOut.Top - inGrid.Top) < Hundred Then TopGrid = inGrid.Top + SaveY GridOut.move GridOut.Left + SaveX, inGrid.Top + SaveY End If End If If HIDJLoaded Then If fHIDJ.WindowState = vbNormal Then If Abs(fHIDJ.Left - SaveLeft) < Hundred Then 'And Abs(fHIDJ.Width - inGrid.Width) < Hundred Then fHIDJ.move Me.Left - 75, fHIDJ.Top ' 75= ghosted borderstyle 2 End If End If End If End Function Function DJMove() As Boolean SaveLeft = Me.Left SaveTop = Me.Top On Error GoTo errorline DJMove = True Exit Function Resume errorline: ' stop '\\ Resume Next End Function Sub MouseMacroStarted() 'Click to end and replay mouse macro for Song Tempo. With UserParams.MDSFlexGrid1 End With End Sub Sub Populist(BPM As Long) 'find the nearest setting Dim workz7 As String, J As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long k = Me.Genre.ListIndex + Two J = Val(fDoc(Mp3PlayDoc).Table.TextMatrix(k, fDoc(Mp3PlayDoc).Table.Cols - Three)) For l = Zero To Me.LIST_Grooves.ListCount - One Me.LIST_Grooves.Selected(l) = False Next For l = Zero To Me.LIST_Bands.ListCount - One Me.LIST_Bands.Selected(l) = False Next l = Thousand o = -One p = -One Do While J > Zero workz7 = fDoc(Mp3PlayDoc).Table.TextMatrix(k, J) If Len(workz7) > Four Then workz7 = Mid$(workz7, InStr(workz7, ASpace) + One) m = SendMessageStr(Me.LIST_Grooves.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Left(workz7, InStr(workz7, ":") - One))) If m >= Zero Then Me.LIST_Grooves.Selected(m) = True n = SendMessageStr(Me.LIST_Bands.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Mid$(workz7, InStr(workz7, ":") + One))) If n >= Zero Then Me.LIST_Bands.Selected(n) = True If Abs(J - BPM) < l Then o = m p = n l = Abs(J - BPM) End If J = Val(workz7) '\\ dmDrums.Genre.ItemData(k) = -((Me.LIST_Bands.ListIndex + one) * Thousand + (Me.LIST_Grooves.ListIndex + one)) Else J = Zero End If Loop Me.LIST_Grooves.ListIndex = o Me.LIST_Bands.ListIndex = p End Sub Sub SendStartupKeys() '\\ (Send As String) '\\ Press the key down keybd_event VK_MENU, Zero, Zero, Zero keybd_event Asc("Z"), Zero, Zero, Zero '\\ Release the key '\\ Sleep Hundred keybd_event Asc("Z"), Zero, KEYEVENTF_KEYUP, Zero keybd_event VK_MENU, Zero, KEYEVENTF_KEYUP, Zero '\\ delay one End Sub Sub SetGenreEnabled() If PF_Ending Then Exit Sub Me.Genre.Enabled = Me.GenreEnabled If Me.GenreEnabled Then If Me.GenreEnabled = One Then Me.cmdBeatmix.Caption = "BeatMix" '\\ search "Mix" ElseIf Me.GenreEnabled = Two Then Me.cmdBeatmix.Caption = "Biasmix" Else Me.cmdBeatmix.Caption = "Include" End If Me.LabelGrooves(Zero).Caption = "- grooves" If Mp3PlayDoc = Zero Or Mp3PlayDoc = -Thousand Then Mp3PlayDoc = LoadNewDoc("Untitled") '\\ load from localized directory mp3play.ing fDoc(Mp3PlayDoc).Caption = App.path & "\" & App.Title & strLocalID & "\mp3play.ing" fDoc(Mp3PlayDoc).DocText_Filename = vbNullString '\\ to signal an invisible system grid FileLoad Mp3PlayDoc, fDoc(Mp3PlayDoc).Caption If Not gCancel Then '\\ put the data table into the documents table GetGridTable Mp3PlayDoc, fDoc(Mp3PlayDoc).Table fDoc(Mp3PlayDoc).Visible = False SetDirty False, Mp3PlayDoc Else Mp3PlayDoc = -Mp3PlayDoc '\\ flag to exclude End If End If Else Me.LabelGrooves(Zero).Caption = "+ grooves" Me.cmdBeatmix.Caption = "Unsync" End If SettingsSave iniName, "Music", "Genre.Enabled", Me.GenreEnabled If Mp3PlayDoc > Zero Then Dim i As Long For i = Zero To Genre.ListCount - One Genre.Selected(i) = CStr(Trim(Left(fDoc(Mp3PlayDoc).Table.TextMatrix(i + Two, fDoc(Mp3PlayDoc).Table.Cols - Two), Five))) Next Genre.ListIndex = -One Genre.Refresh SetDirty False, Mp3PlayDoc End If End Sub ' Sub SetMovingPicturesXMLEnabled() If PF_Ending Then Exit Sub Me.cmdExternalHelper(ExternalHelper).Enabled = Me.MovingPicturesXMLEnabled ' 20260124 'cmdMovingPicturesXML If Me.MovingPicturesXMLEnabled Then ' If Me.MovingPicturesXMLEnabled = One Then ' Me.cmdBeatmix.Caption = "BeatMix" '\\ search "Mix" ' ElseIf Me.MovingPicturesXMLEnabled = Two Then ' Me.cmdBeatmix.Caption = "Biasmix" ' Else ' Me.cmdBeatmix.Caption = "Include" ' End If ' Me.LabelGrooves(zero).Caption = "- grooves" If MovingPicturesXMLDoc = Zero Or MovingPicturesXMLDoc = -Thousand Then MovingPicturesXMLDoc = LoadNewDoc("Untitled") '\\ load from localized directory MovingPicturesXML.ing fDoc(MovingPicturesXMLDoc).Caption = App.path & "\" & App.Title & strLocalID & "\MovingPicturesXML.ing" fDoc(MovingPicturesXMLDoc).DocText_Filename = vbNullString '\\ to signal an invisible system grid FileLoad MovingPicturesXMLDoc, fDoc(MovingPicturesXMLDoc).Caption If Not gCancel Then '\\ put the data table into the documents table GetGridTable MovingPicturesXMLDoc, fDoc(MovingPicturesXMLDoc).Table fDoc(MovingPicturesXMLDoc).Visible = False SetDirty False, MovingPicturesXMLDoc Else MovingPicturesXMLDoc = -MovingPicturesXMLDoc '\\ flag to exclude End If End If Else ' Me.LabelGrooves(zero).Caption = "+ grooves" ' Me.cmdBeatmix.Caption = "Unsync" End If ' SettingsSave iniName, "Music", "cmdMovingPicturesXML.Enabled", Me.MovingPicturesXMLEnabled ' If MovingPicturesXMLDoc > Zero Then ' Dim i As Long ' For i = Zero To cmdMovingPicturesXML.ListCount - One ' cmdMovingPicturesXML.Selected(i) = CStr(Trim(Left(fDoc(MovingPicturesXMLDoc).Table.TextMatrix(i + Two, fDoc(MovingPicturesXMLDoc).Table.Cols - Two), Five))) ' Next ' cmdMovingPicturesXML.ListIndex = -One ' cmdMovingPicturesXML.Refresh ' SetDirty False, MovingPicturesXMLDoc ' End If End Sub Function SetLists(k As Long, n As Long) As Boolean Dim workz7 As String If n > Zero And n < 120 Then workz7 = fDoc(Mp3PlayDoc).Table.TextMatrix(k + Two, n + Two) If Len(workz7) > Four Then If Val(workz7) > Zero Then workz7 = Right$(workz7, Len(workz7) - InStr(workz7, ASpace)) Me.LIST_Grooves.ListIndex = SendMessageStr(Me.LIST_Grooves.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Left(workz7, InStr(workz7, ":") - One))) '\\ getBandWord Me.LIST_Bands.ListIndex = SendMessageStr(Me.LIST_Bands.hwnd, _ LB_FINDSTRINGEXACT, _ -1, _ ByVal CStr(Mid$(workz7, InStr(workz7, ":") + One))) SetLists = True Genre.ItemData(k) = -((Me.LIST_Bands.ListIndex + One) * Thousand + (Me.LIST_Grooves.ListIndex + One)) End If ElseIf n < Zero Or n > 120 Then SetLists = True Me.LIST_Grooves.ListIndex = -One Me.LIST_Bands.ListIndex = -One End If End Function Public Sub SetMp3playing() With Me If Mp3PlayDoc > Zero Then If .Genre.ListIndex >= Zero Then Dim linkCol As Long, conGenre As Long, elTempo As Long, workz7 As String conGenre = .Genre.ListIndex + Two If Mid$(LabelGrooves(One).ToolTipText, Seven, One) = "%" Then elTempo = Int(Left(LabelGrooves(One).ToolTipText, Six)) - 55 linkCol = fDoc(Mp3PlayDoc).Table.Cols - Three workz7 = fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, elTempo) If workz7 = "?" Then workz7 = Val(fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, linkCol)) fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, linkCol) = elTempo Else workz7 = Val(workz7) End If SetDirty True, Mp3PlayDoc fDoc(Mp3PlayDoc).Table.TextMatrix(conGenre, elTempo) = workz7 & ASpace & .LIST_Grooves.list(.LIST_Grooves.ListIndex) & ":" & .LIST_Bands.list(.LIST_Bands.ListIndex) End If .Genre.ItemData(.Genre.ListIndex) = Zero End If End If End With End Sub Sub SyncSchedule(ByRef mytime As Variant) If EnsureScheduleListFor(mytime) Then ScheduleSync End If Me.frmPicture1(One).Refresh ' 20260124 End Sub Public Function LowerVolPreset() As Boolean If Me.LabelVol.BackColor = Sixty Then LabelVolForeColor vbYellow LowerVolPreset = True ElseIf Me.LabelVol.BackColor = 40 Then LabelVolForeColor vbOrange LowerVolPreset = True ElseIf Me.LabelVol.BackColor = Twenty Then LabelVolForeColor vbRed LowerVolPreset = True End If '\\ 25 is a lowervolpreset not to interfere with reader End Function Public Function UpperVolPreset(Optional ByVal EndVolSlider As Single = -One) As Boolean If EndVolSlider = -One Then EndVolSlider = Me.LabelVol.BackColor If EndVolSlider = 255 Then 'And Me.UpDown_Volume.value Mod 50 = Zero) Then LabelVolForeColor vbWhite UpperVolPreset = True End If If EndVolSlider = Round(SelectedVolume / Hundred * 255, Zero) Then LabelVolForeColor vbCyan UpperVolPreset = True End If If EndVolSlider = SixtyFour Then LabelVolForeColor vbGreen UpperVolPreset = True End If '\\ 25% is independent for Max Vol while Reader reading End Function Private Sub AutoTempo_Click() With Me If MP3ID3v1Tag Is Nothing Then Exit Sub End If CloseLockMP3file workbuffer = MP3ID3v1Tag.Comment If Mid$(workbuffer, One, Six) <> .AutoTempo.list(.AutoTempo.ListIndex) Then '\\ the median BPM is stored If Len(workbuffer) < Seven Then workbuffer = Left$(.AutoTempo.list(.AutoTempo.ListIndex), Six) & "%" Else Mid$(workbuffer, One, Seven) = Left$(.AutoTempo.list(.AutoTempo.ListIndex), Six) & "%" End If MP3ID3v1Tag.Comment = workbuffer On Error GoTo errorline If .optImmediate <> True Then If .optDefault = True Then .cmdPlayMotif = True .optBeat = True ElseIf WA_GetShuffle = One And UpDown_Fine_Tempo.value <> Zero And EnqueuedAt <= Zero Then Call WA_SetShuffle(Zero) SpeakThis "Winamp Shuffle is off while learning BPM" End If End If .Slider2.Max = .AutoTempo.ListCount - One .Slider2.value = .AutoTempo.ListIndex Exit Sub errorline: ' stop WarningError Err, "AutoTempo" '\\ , , , vbYes End With End Sub Private Sub AutoTempo_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) On Error Resume Next Me.Slider2.ZOrder One Me.Slider2.Visible = True Me.Slider2.SetFocus End Sub Private Sub AutoTempo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'Click to memorize non-median Tempo. Also sets Winamp playlist to manual advance for a group of unlearned tracks. Opp.Click to hide. If Button = vbRightButton Then Me.BongoMan.ZOrder Zero End If End Sub Private Sub BongoMan_GotFocus() SetStatus BongoMan End Sub Private Sub chkLoop_GotFocus() SetStatus chkLoop End Sub Private Sub chkLoop_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) chkLoop.SetFocus End Sub Private Sub chkLoop_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Me.chkLoop.value = vbGrayed End If End Sub Private Sub chkReverb_GotFocus() SetStatus chkReverb End Sub Private Sub chkReverb_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Me.chkReverb.value = vbGrayed ElseIf Button = vbLeftButton Then '\\ Ok, they want to switch the default audio paths Dim dmPath As DirectMusicAudioPath8 If chkReverb.value = vbUnchecked Then Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_STEREO, 128, True) Else Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True) End If perf.SetDefaultAudioPath dmPath Set dmPath = Nothing ChangeBands End If End Sub Public Sub IMDbPlay() 'depricated in favour of MovingPicturesXML On Error GoTo errorline Dim S As Shell Dim fi As FolderItem Dim f As Folder Dim l As ShellLinkObject Dim i As Long Set S = New Shell If Dir(UserParams.UserName.Text) = "" Then Set f = S.BrowseForFolder(Me.hwnd, "Select Movielinks folder", 0) Else Set f = S.BrowseForFolder(Me.hwnd, "Select Movielinks folder", 0) End If For i = 0 To f.Items.count - 1 Set fi = f.Items.item(i) If fi.IsLink Then Set l = fi.GetLink Dim workz9 As String Dim workz8 As String Dim workz7 As String Dim workz6 As String workz8 = fi.path workz8 = Left(workz8, Len(workz8) - 8) & ".txt" Mid(workz8, InStr(1, workz8, "links", vbTextCompare), 5) = "texts" If Right(fi.name, 4) = ".avi" Then If Dir(UserParams.UserName.Text) = "" Then UserParams.UserName.Text = Left(workz8, InStrRev(workz8, "\")) End If If Dir(workz8, vbNormal) = "" Then If l.description <> "" Then workz7 = l.description If isValidFileName(workz7) Then 'synchronize existing names workz7 = InputBox("Shortcut.description", , workz7) End If Else workz7 = fi.name workz7 = Left(workz7, Len(workz7) - 4) End If If Dir(workz8) <> "" Then 'should only the shortcut be renamed ' if so then the two internal fields could still be different. Else workz6 = "c:\progra~1\amdb\bin\title.exe -t " workz6 = workz6 & " """ & workz7 workz6 = workz6 & """ -o """ workz6 = workz6 & workz8 & """" ShellandWait workz6 End If 'assuming the rows and columns are set up identical to 'ConstructsName and ElementsName 'then a lookup in ElementsName is performed to find the column to paste. 'initially a bug is allowed that omits synchronizing to the files in constructnames If Dir(UserParams.ConstructsName.Text) <> "" Then workbuffer = "H:\MovingPicturesXML\database\Copy of filesizes.txt" UserParams.ConstructsName.Text = InputBox("ConstructsName.Text ", , workbuffer) If Dir(UserParams.ElementsName.Text) = "" Then workbuffer = "H:\Video\Movies\movies.txt" UserParams.ElementsName.Text = InputBox("ElementsName.Text ", , workbuffer) If Dir(UserParams.ElementsName.Text) <> "" Then Open "H:\Video\Movies\movies.txt" For Input As #One 'UserParams.ConstructsName.Text For Input As #One Input #One, workz9 Close #One 'run through workz9 assuming it to be "H:\Video\Movies\movies.txt" 'set construct names and weight i = Zero Dim J As Long, k As Long J = Zero For k = One To NmE i = InStr(i + 1, workz9, vbLf) If i = Zero Then Exit For workz7 = Mid(workz9, J + 1, i - J) If Right(workz7, Four) = ".list" Then GridIn.Table.TextMatrix(k, One) = Left(workz7, Len(workz7) - Four) End If Next End If End If ' Else ' ' End If ' End If Else ' UserParams.ConstructsName.Text = BrowseFolder 'InputBox(UserParams.ConstructsName.Text, , UserParams.ConstructsName.Text) ' If VBGetOpenFileName(UserParams.ConstructsName.Text) Then If Dir(UserParams.ConstructsName.Text) <> "" Then Open "H:\MovingPicturesXML\database\Copy of filesizes.txt" For Input As #One 'UserParams.ConstructsName.Text For Input As #One Input #One, workz9 Close #One 'run through workz9 assuming it to be "H:\MovingPicturesXML\database\Copy of filesizes.txt" 'set construct names and weight i = Zero J = Zero For k = One To NmC i = InStr(i + 1, workz9, vbLf) If i = Zero Then Exit For workz7 = Mid(workz9, J + 1, i - J) If Right(workz7, Four) = ".list" Then GridIn.Table.TextMatrix(k, One) = Left(workz7, Len(workz7) - Four) End If Next End If ' End If End If End If Open workz8 For Input As #One Input #One, workz9 Close #One 'find element and set.clip End If XDoEventsX ' MsgBox fi.Name & vbCrLf & _ l.Description & vbCrLf & _ l.Path & vbCrLf & _ l.WorkingDirectory & vbCrLf & _ l.ShowCommand End If Next errorline: Set l = Nothing Set fi = Nothing Set f = Nothing Set S = Nothing End Sub Public Sub MovingPicturesXMLPlay() On Error GoTo errorline 'first we need the xml file and then we need to build the grid 'later we can build the form with treeview and listview capabilities 'to select different criteria. errorline: End Sub Public Sub PlayMotif(Optional Rand As Long = -One) On Error GoTo errorline If Rand = -One Then Rand = Rnd * (lstMotif.ListCount - One) Else Rand = Rand Mod lstMotif.ListCount End If On Error GoTo errorline Dim lFlags As CONST_DMUS_SEGF_FLAGS lFlags = DMUS_SEGF_SECONDARY If optBeat.value Then lFlags = lFlags Or DMUS_SEGF_BEAT If optDefault.value Then lFlags = lFlags Or DMUS_SEGF_DEFAULT If optGrid.value Then lFlags = lFlags Or DMUS_SEGF_GRID If optImmediate.value Then lFlags = lFlags Or DMUS_SEGF_SECONDARY If optMeasure.value Then lFlags = lFlags Or DMUS_SEGF_MEASURE lstMotif.ListIndex = Rand perf.PlaySegmentEx moMotifs(lstMotif.ListIndex).Motif, lFlags, Zero Exit Sub Resume errorline: ' stop End Sub Private Sub cmdExternalHelper_GotFocus(Index As Integer) 'Click() If Index = One Then SetStatus cmdExternalHelper(Index) ' 20260124 'cmdMovingPicturesXML End Sub Private Sub cmdExternalHelper_MouseMove(Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdExternalHelper(Index).SetFocus ' 20260124 'cmdMovingPicturesXMLClick(cmdMovingPicturesXML End Sub Private Sub cmdExternalHelper_MouseUp(Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_cmdExternalHelper Index, Button, Shift End Sub Private Sub cmdPlayMotif_Click() On Error GoTo errorline MouseState.Buttons(Zero) = Zero '\\ to avoid repeating a random motif Dim lFlags As CONST_DMUS_SEGF_FLAGS lFlags = DMUS_SEGF_SECONDARY If optBeat.value Then lFlags = lFlags Or DMUS_SEGF_BEAT If optDefault.value Then lFlags = lFlags Or DMUS_SEGF_DEFAULT If optGrid.value Then lFlags = lFlags Or DMUS_SEGF_GRID If optImmediate.value Then lFlags = lFlags Or DMUS_SEGF_SECONDARY If optMeasure.value Then lFlags = lFlags Or DMUS_SEGF_MEASURE perf.PlaySegmentEx moMotifs(lstMotif.ListIndex).Motif, lFlags, Zero Exit Sub Resume errorline: ' stop End Sub Private Sub cmdPlayMotif_GotFocus() SetStatus Me.cmdPlayMotif End Sub Private Sub cmdPlayMotif_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.cmdPlayMotif.SetFocus End Sub Private Sub cmdSave_GotFocus() SetStatus cmdSave End Sub Private Sub cmdSave_MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseDown_cmdSave Button End Sub Private Sub cmdSave_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdSave.SetFocus End Sub Private Sub cmdSave_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_cmdSave Button End Sub Private Sub cmdSegment_Click() Static sCurDir As String Static lFilter As Long With cdlOpen '\\ We want to open a file now .flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST .FilterIndex = lFilter .Filter = "Segment Files (*.mid;*.sgt;*.sgp)|*.mid;*.sgt;*.sgp" '\\ .FileName = SettingGet(iniName, "Music", "Filename", notstring) If sCurDir = vbNullString Then '\\ Set the init folder to \windows\media if it exists. If not, set it to the \windows folder Dim sWindir As String sWindir = Space$(255) If GetWindowsDirectory(sWindir, 255) = Zero Then '\\ We couldn't get the windows folder for some reason, use the c:\ .InitDir = "C:\" Else Dim sMedia As String sWindir = Left$(sWindir, InStr(sWindir, vbNullChar) - 1) If Right$(sWindir, One) = "\" Then sMedia = sWindir & "Media" Else sMedia = sWindir & "\Media" End If If Dir$(sMedia, vbNormal + vbHidden + vbSystem + vbDirectory) <> NotString Then .InitDir = sMedia Else .InitDir = sWindir End If End If Else .InitDir = sCurDir End If .ShowOpen '\\ Display the Open dialog box If gCancel Then Exit Sub '\\ Save the current information sCurDir = GetFolder(.FileName) '\\ Set the search folder to this one so we can auto download anything we need loader.SetSearchDirectory sCurDir lFilter = .FilterIndex On Local Error GoTo NoLoadSegment '\\ Before we load the segment stop one if it's playing cmdStop_Click '\\ Now let's load the segment LoadSegment .FileName Call SettingsSave(iniName, "Music", "Filename", .FileName) End With Exit Sub NoLoadSegment: UpdateStatus "Couldn't load this segment" ClickedCancel: End Sub Private Sub cmdSegment_GotFocus() SetStatus cmdSegment End Sub Private Sub cmdSegment_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdSegment.SetFocus End Sub Private Sub cmdStop_Click() 'Stop the segment On Error Resume Next perf.StopEx dmSegMotif, Zero, Zero EnablePlayUI True UpdateStatus "User pressed stop." End Sub Private Sub cmdStop_GotFocus() SetStatus cmdStop End Sub Private Sub cmdStop_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdStop.SetFocus End Sub Private Sub cmdStop_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbMiddleButton Then SetTrickle Trickle.cmdShutDown = True End If End Sub Private Sub cmdPlayPause_GotFocus(ByRef Index As Integer) SetStatus cmdPlayPause(Index) End Sub Private Sub cmdPlayPause_MouseMove(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdPlayPause(Index).SetFocus End Sub Private Sub cmdHaltPlay_Click() DelayTrackSelection = Two Me.StopCmd = True If Not LowerVolPreset Then Call WinAmpControls("LessVolume", , False) WA_Stop FreshPlot "Perturbate", , True '\\ ensures accurate track length If inGrid_SendSpeech_BackColor = vbYellow And IngridLoaded Then inGrid_SendSpeech_BackColor = OffGray End If If Not UserParams Is Nothing And MouseState.Buttons(Zero) = vbLeftButton Then UserParams.MDSFlexGrid1.Visible = False ScreenOff End If End Sub Private Sub cmdHaltPlay_GotFocus() SetStatus cmdHaltPlay End Sub Private Sub cmdHaltPlay_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) cmdHaltPlay.SetFocus End Sub Private Sub cmdHaltPlay_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim lWork As Long If Button = vbMiddleButton Then '\\ Mid.Click to start recording. '\\ Debug.Print "ping.wav DMDrums start recording" ' lWork = sndPlaySound(SoundDir & "ping.wav", flags) If TrickleLoaded Then Trickle.Hide inGrid.TimeStep.value = -Abs(inGrid.TimeStep.value) If inGrid.mnuViewAutoRedraw.Enabled Then inGrid_mnuViewAutoRedraw_Checked = True inGrid.DrawState.value = vbChecked inGridClick_mnuViewAutoRedraw End If params True, True '\\ in order to track mouse movements flush the mouse ScreenOff '\\ and set the flag MouseState.Buttons(Zero) = vbLeftButton End If End Sub Private Sub CommandGridArt_GotFocus() SetStatus CommandGridArt End Sub Private Sub CommandGridArt_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' CommandGridArt.SetFocus End Sub Private Sub cmdBeatmix_GotFocus() SetStatus cmdBeatmix End Sub Private Sub cmdBeatmix_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) cmdBeatmix.SetFocus End Sub Private Sub CPUUsage_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me If Button = vbLeftButton Then '\\ toggle TimeStep between Fps and Tempo gearing. inGrid.TimeStep.value = -inGrid.TimeStep.value If inGrid.TimeStep.value < Zero Then .CPUUsage.Appearance = ccFlat Else .ManualGearing.ForeColor = vbOrange .CPUUsage.Appearance = cc3D End If ElseIf Button = vbRightButton Then '\\ Opp.click toggles enabling for Automatic Tempo gearing. If .ManualGearing.ForeColor = vbOrange Then .ManualGearing.ForeColor = vbCyan Else .ManualGearing.ForeColor = vbOrange End If End If End With End Sub Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) 'Here we will handle the DMusic callbacks Dim dmNotification As DMUS_NOTIFICATION_PMSG Dim oState As DirectMusicSegmentState8 Dim oSeg As DirectMusicSegment8 Dim lCount As Long On Error GoTo FailedOut '\\ Process all events Do While perf.GetNotificationPMSG(dmNotification) If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGEND Then '\\ The segment has ended '\\ First we need to figure out which segment Set oState = dmNotification.USER '\\ The user field holds the segment state on segment notifications Set oSeg = oState.GetSegment '\\ Get the segment from the state '\\ Is this the primary segment? If oSeg Is dmSegMotif Then '\\ Yup UpdateStatus "Primary Segment stopped playing." EnablePlayUI True Else '\\ Go through all of the other segments For lCount = Zero To UBound(moMotifs) If oSeg Is moMotifs(lCount).Motif Then UpdateStatus moMotifs(lCount).name & " stopped playing." '\\ Now update the listbox lstMotif.list(moMotifs(lCount).ListIndex) = moMotifs(lCount).name End If Next End If End If If dmNotification.lNotificationOption = DMUS_NOTIFICATION_SEGSTART Then '\\ The segment has started '\\ First we need to figure out which segment Set oState = dmNotification.USER '\\ The user field holds the segment state on segment notifications Set oSeg = oState.GetSegment '\\ Get the segment from the state '\\ Is this the primary segment? If oSeg Is dmSegMotif Then '\\ Yup UpdateStatus "Primary Segment started playing." Else '\\ Go through all of the other segments For lCount = Zero To UBound(moMotifs) If oSeg Is moMotifs(lCount).Motif Then UpdateStatus moMotifs(lCount).name & " motif started playing." '\\ Now update the listbox lstMotif.list(moMotifs(lCount).ListIndex) = moMotifs(lCount).name & " (Playing)" End If Next End If End If Loop Exit Sub Resume FailedOut: Static LastTime As Single If Abs(Timer - LastTime) < Half Then '\\ this is here for some strange reason LastTime = Timer Exit Sub End If LastTime = Timer If PF_Ending Or Not StartUpTypeIsNormal Then Exit Sub If ProcessingFlag = PF_Host Or ProcessingFlag = PF_Null Or ProcessingFlag = PF_InitStopD3D Then '\\ If inGrid_SendSpeech_BackColor <> OffGray Then me.Play = True Exit Sub End If If NameString = vbNullString Then SendSound "notify.wav", SND_SYNC + SND_NOSTOP '\\ MsgBoxex"Error processing this Notification", vbOKOnly Or vbInformation, "Cannot Process." End If End Sub Private Sub Drum_GotFocus(ByRef Index As Integer) SetStatus Drum(Index) End Sub Private Sub Drum_MouseMove(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If ScheduleMth > Zero Then If GetForegroundWindow <> fDoc(ScheduleMth).hwnd Then '\\ because "select all" from a context menu can leave mouse on a drum If fToolTips Is Nothing Then Exit Sub ResetDrum Index End If End If End Sub Private Sub Drum_MouseUp(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) On Error GoTo errorline If Button = vbRightButton Then If fPushKeys Is Nothing Then Set fPushKeys = frmPushKeys End If With fPushKeys .Left = Me.Left + Drum(Index).Left + Drum(Index).Width .Top = Me.Top + Drum(Index).Top + Drum(Index).Height .Show vbModeless End With ProcessMacro Index ElseIf Button = vbMiddleButton Then Me.Drum(Index).Font.Strikethrough = True End If Exit Sub Resume errorline: ' stop WarningError Err, "Mouse Macro" End Sub Private Sub DTPicker1_Change() Me.MonthView1.value = Me.DTPicker1.value End Sub Private Sub DTPicker1_DblClick() StartUpChime = Zero Me.DTPicker1.value = Now Me.MonthView1.Visible = False Front , fDoc(ScheduleMth) End Sub Private Sub DTPicker1_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) DTPicker1.SetFocus End Sub Private Sub DTPicker1_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me If Button = vbLeftButton Then Exit Sub '\\ LockWindowUpdate .hWnd Dim DiffTime As Single DiffTime = DateDiff("s", .DTPicker1.value, Now) If Button = vbMiddleButton Or (Button = vbRightButton And Shift = vbCtrlMask) Then If StartUpChime = Zero And Abs(DiffTime) > Sixty Or Not .MonthView1.Visible Then StartUpChime = DiffTime '\\ If Abs(StartUpChime) > Sixty And Abs(StartUpChime) < DEG * Thirty Then '\\ short range diary '\\ .MonthView1.Value = .DTPicker1.Value SyncSchedule (.DTPicker1.value) .MonthView1.Visible = True If ScheduleMth > Zero Then Front False, fDoc(ScheduleMth) fDoc(ScheduleMth).Table.SetFocus End If Exit Sub Else .MonthView1.Visible = False End If If Abs(DiffTime) < Sixty And .MonthView1.Visible = True Then StartUpChime = Zero .DTPicker1.value = Now End If SyncSchedule (.MonthView1.value) ElseIf Button = vbRightButton And Shift = Zero Then .MonthView1.value = .DTPicker1.value Front False, .MonthView1 .MonthView1.Visible = True ElseIf Button = vbRightButton And Shift = vbShiftMask Then date = .DTPicker1.value time = .DTPicker1.value End If End With End Sub Private Sub EDIT_Tempo_GotFocus() SetStatus EDIT_Tempo End Sub Private Sub EDIT_Tempo_MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbMiddleButton Then ' StringFromOCR = vbNullString ScraperRectLeft = Zero SongTime 5, True Play = True End If End Sub Private Sub EDIT_Volume_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) With Me If Button = vbLeftButton And Shift = Zero Then If .UpDown_Volume.value < 25 Then If .UpDown_Volume.value = One Then SelectedVolume = 83 .UpDown_Volume.value = 25 ElseIf .UpDown_Volume.value = 25 Then .UpDown_Volume.value = 50 ElseIf .UpDown_Volume.value = 50 Then .UpDown_Volume.value = SelectedVolume ElseIf .UpDown_Volume.value = SelectedVolume Then .UpDown_Volume.value = Hundred ElseIf .UpDown_Volume.value = Hundred Then .UpDown_Volume.value = One 'Zero End If ElseIf Button = vbMiddleButton Or Button = vbLeftButton And Shift = vbShiftMask Then If LastSecondHand = DaySeconds Then '\\ else will reset "LessVolume" LastSecondHand = Zero End If If .EDIT_Volume.ForeColor = .LabelVol.ForeColor Then Call SettingsSave(iniName, RegSettings, "FadeVolume", True) Call WinAmpControls("LessVolume", , False) Else Call SettingsSave(iniName, RegSettings, "FadeVolume", False) Call WinAmpControls("SetVol", , False) Call SettingsSave(iniName, RegSettings, "SetVolume", .UpDown_Volume.value) If .UpDown_Volume.value = Hundred And Left(SpeechThing, Five) <> "Agent" Then KarmaGunAfterStartup = True End If End If ElseIf Button = vbRightButton Then If .UpDown_Volume.value < 25 Then If .UpDown_Volume.value = One Then SelectedVolume = 83 .UpDown_Volume.value = Hundred ElseIf .UpDown_Volume.value = 25 Then .UpDown_Volume.value = One 'Zero ElseIf .UpDown_Volume.value = 50 Then .UpDown_Volume.value = 25 ElseIf .UpDown_Volume.value = SelectedVolume Then .UpDown_Volume.value = 50 ElseIf .UpDown_Volume.value = Hundred Then .UpDown_Volume.value = SelectedVolume End If End If EDIT_Volume.BorderStyle = One End With End Sub Private Sub Form_KeyDown(ByRef KeyCode As Integer, ByRef Shift As Integer) If KeyCode > 64 And KeyCode < 90 Then '\\ sndPlaySound App.path & "\wav\S-" & chr$(KeyCode) & ".wav", SND_ASYNC '\\ fmDirectSnd.MediaFile = "\wav\S-" & chr$(KeyCode) & ".wav" '\\ fmDirectSnd.cmdPlay = True Dim Letter As Long, DrumBackground As Long Letter = KeyCode - 65 DrumBackground = Me.Drum(Letter).BackColor SetCursorPos (Me.Left + Me.Drum(Letter).Left) / xPixel + Twenty, (Me.Top + Me.Drum(Letter).Top + 430) / yPixel + Five HitDrum (Letter) Drum(KeyCode - 65) = True Me.Drum(Letter).BackColor = DrumBackground ' Call MouseupFormDrumColor(vbLeftButton, Shift, CInt(MousePos.x), CInt(MousePos.y)) '\\ Exit Sub End If '\\ If KeyCode = 72 Then '\\ Me.Hide '\\ Exit Sub '\\ End If '\\ If Not inGrid Is Nothing Then '\\ inGrid.Show vbModeless '\\ inGrid.SetFocus '\\ End If '\\ keybd_event KeyCode, End Sub Private Sub Form_Load() p_LabelBPM_ForeColor = vbWhite '\\ gets around a startup problem setting black. Load frmDrumDown With frmDrumDown .SetDrumDownPictures End With With Me Dim lWork As Long LastSecondHand = DaySeconds If PF_Ending Then '\\ Unload Me Exit Sub End If If TrickleLoaded Then lblClose(Zero).Caption = " X" lblClose(One).Caption = " X" Else lblClose(Zero).Caption = " i" lblClose(One).Caption = " i" End If .BongoMan.move .AutoTempo.Left, .AutoTempo.Top, .AutoTempo.Width, .AutoTempo.Height .Slider2.move .AutoTempo.Left, .AutoTempo.Top, .AutoTempo.Width, .AutoTempo.Height '\\ Set AutoIt = CreateObject("AutoItX.Control") StartDrumRoll = -8 .Drum(Seven).Font.Strikethrough = True On Error GoTo FailedInit TempoFactor = One TempoIndex = One ChDir App.path Dim dmA As DMUS_AUDIOPARAMS, lCount As Long Dim MotifName As String ExternalHelper = Abs(SettingsGet(iniName, "Music", "ExternalHelper", Zero)) ' MouseUp_cmdExternalHelper ExternalHelper, vbMiddleButton, Zero If ExternalHelper = One Then cmdExternalHelper(Zero).Visible = False cmdExternalHelper(Zero).Enabled = False Else cmdExternalHelper(One).Visible = False cmdExternalHelper(One).Enabled = False End If cmdExternalHelper(ExternalHelper).ZOrder Zero 'ExternalHelper ' One - cmdExternalHelper(Index).ZOrder '20260124 cmdExternalHelper(ExternalHelper).Visible = True cmdExternalHelper(ExternalHelper).Enabled = True m_TempoSelector = SettingsGet(iniName, "Preferences", "TempoSelector", -One) If m_TempoSelector <> -One Then Me.TempoMultiplier(m_TempoSelector).BackColor = vbGreen cdlOpen.InitDir = GetFolder(SettingsGet(iniName, "Music", "Filename", App.path & "\")) If cdlOpen.InitDir = vbNullString Then mediapath = FindMediaDir("Drums!.sgt") Else mediapath = FindMediaDir(cdlOpen.InitDir & "Drums!.sgt") End If Set perf = g_dx.DirectMusicPerformanceCreate() Set loader = g_dx.DirectMusicLoaderCreate() Set composer = g_dx.DirectMusicComposerCreate() '\\ Make sure we can init the audio as well '\\ Initialize performance object to use its own DirectSound object perf.InitAudio .hwnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128 '\\ SetMasterAutoDownload indicates we the perofmance object '\\ to attempt to auto download DLS collections when reference in '\\ sgt and sty files Call perf.SetMasterAutoDownload(True) Set style = loader.LoadStyle(mediapath & "drums!.sty") Set dmSegDrum = loader.LoadSegment(mediapath & "drums!.sgt") Get_Bands LIST_Grooves.AddItem ("Alternative") LIST_Grooves.AddItem ("Blues") '\\ 12 bar LIST_Grooves.AddItem ("Country") LIST_Grooves.AddItem ("Dance - Pop") LIST_Grooves.AddItem ("Hard Rock") LIST_Grooves.AddItem ("Hip Hop") LIST_Grooves.AddItem ("Jazz") LIST_Grooves.AddItem ("Latin") LIST_Grooves.AddItem ("R & B") LIST_Grooves.AddItem ("Rap") LIST_Grooves.AddItem ("Soft Rock") LIST_Grooves.AddItem ("World") UpDown_Volume.Enabled = False UpDown_Volume.value = 50 '\\ SelectedVolume DelayTempoSliderFlag = True UpDown_Fine_Tempo.value = m_Fine_Tempo If LabelBPM.ForeColor = vbBlack Then ListAdvanceColor = vbBlue End If ' EDIT_Tempo.Enabled = False ' lCount = SettingsGet(iniName, "Music", "Tempo", EDIT_Tempo.Caption) ' If lCount > 200 Then ' lCount = lCount - Hundred ' If Rnd > PointSeven Then ' lCount = lCount - Hundred ' End If ' End If ' EDIT_Tempo.Caption = lCount ManualGearing.ForeColor = Val(SettingsGet(iniName, "Music", "GearsEnabled")) '\\ , ManualGearing.ForeColor)) If ManualGearing.ForeColor <> vbOrange Then ManualGearing.ForeColor = vbCyan End If SaveX = SettingsGet(iniName, "Music", "Drums.Left", DefaultBot(-300, -300)) SaveY = SettingsGet(iniName, "Music", "Drums.Top", DefaultBot(6390, 6390)) .Height = SettingsGet(iniName, "Music", "Drums.Height", DefaultBot(6615, 2790)) If SaveX < Zero Then .frmPicture1(One).Top = Zero If SaveY < Zero Then .Height = 2790 End If End If If SaveY < Zero Then If .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height + .Top > Screen.Height Then .frmPicture1(One).Top = Zero .Height = 2790 Else .Height = .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height End If End If .move Abs(SaveX), Abs(SaveY) '.Height = 6615 .CPUUsage.Appearance = SettingsGet(iniName, "Music", "CPUUsage", .CPUUsage.Appearance) chkReverb.value = SettingsGet(iniName, "Music", "Reverb", chkReverb.value) chkLoop.value = SettingsGet(iniName, "Music", "Loop", chkLoop.value) SetStation LIST_Grooves.ListIndex = SettingsGet(iniName, "Music", "Groove", LIST_Grooves.ListIndex) LIST_Bands.ListIndex = SettingsGet(iniName, "Music", "Bands", LIST_Bands.ListIndex) UpDown_Volume.Enabled = True ' EDIT_Tempo.Enabled = True If .CPUUsage.Appearance = ccFlat Then inGrid.TimeStep.value = -Abs(inGrid.TimeStep.value) Else inGrid.TimeStep.value = Abs(inGrid.TimeStep.value) End If '\\ Download the default band so that we can play the drum pads immediately ChangeBands ChangeVolume UpDown_Volume.value ReDim segMotif(style.GetMotifCount() - 1) For lCount = Zero To style.GetMotifCount() - 1 MotifName = style.GetMotifName(lCount) '\\ We could set the drum name here (but we'll just leave them hard coded) '\\ Drum(lCount).Caption = MotifName Set segMotif(lCount) = style.GetMotif(MotifName) Next LIST_Grooves.ListIndex = Zero LIST_Bands.ListIndex = Zero '\\ on error GoTo FailedInit '\\ Dim dma As DMUS_AUDIOPARAMS Dim sMedia As String '\\ Create our objects '\\ Set perf = g_dx.DirectMusicPerformanceCreate '\\ Set loader = g_dx.DirectMusicLoaderCreate '\\ Set up a default audio path '\\ perf.InitAudio .hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128 '\\ Create an event handle mlSeg = g_dx.CreateEvent(Me) perf.AddNotificationType DMUS_NOTIFY_ON_SEGMENT perf.SetNotificationHandle mlSeg '\\ Don't let them play a motif yet cmdPlayMotif.Enabled = False '\\ Now let's load our default segment sMedia = FindMediaDir("sample.sgt") loader.SetSearchDirectory sMedia If sMedia = vbNullString Then sMedia = AddDirSep(CurDir) LoadSegment sMedia & "sample.sgt" EnablePlayMotif False If inGrid.WindowState = vbMinimized Then '\\ ie after Hibernate inGrid.WindowState = vbNormal .Width = inGrid.Width ' - Thirty '-30 = 20150506 Windows 10 inGrid.WindowState = vbMinimized ' .Hide'20120226 Else .Width = inGrid.Width ' - Thirty '-30 = 20150506 Windows 10 .lblClose(Zero).Left = inGrid.Width - .lblClose(Zero).Width .lblClose(One).Left = inGrid.Width - .Frame2.Left - .lblClose(One).Width If inGrid.mnuViewDMDrums.Checked And StartUpTypeIsNormal And Not InStr(CmdStr, "shut") > Zero Then ' .Show vbModeless dmDrums.WindowState = vbNormal End If End If Dim MacroCounts As Variant MacroCounts = Array() MacroCounts = GetAllSettings(App.Title, "MacroCount") On Error Resume Next If Not MacroCounts = Empty Then If Not MacroCounts(Zero, Zero) = Empty Then For lCount = Zero To UBound(MacroCounts) If MacroCounts(lCount, One) > Zero Then .Drum(MacroCounts(lCount, Zero)).Font.Italic = True End If Next End If End If anyName Me Label3(Zero).ForeColor = ForeFace GdiSetupDMGraphics DJReady = True lWork = SettingsGet(iniName, RegSettings, "DeviceToControl", -One) ' If lWork = -One Then 'when should this happen? Option1(5).value = True If .VolSlider1.value <> -80 Then .VolSlider1.value = -80 ' If lWork <> -One Then SpeakThis "Reader set WAV volume to 80%" lWork = Zero End If Option1(lWork).value = True If chkMute.value = vbChecked And lWork = Zero Then 'master volume? Select Case MsgBox("do you want to un-Mute VolumeControl " & lWork, vbYesNoCancel) Case vbYes VolumeControl1.Mute = False chkMute.value = vbUnchecked Case vbCancel HIDJOut End Select End If Call SettingsSave(iniName, RegSettings, "DiaryAnnounce", vbUnchecked) dmDrumsLoaded = True PlaylistAdvance If (Not ListAdvanceColor = vbGreen) And WA_IsPlaying <> One Then '(Not 1) If Not SlaveBot Then '20120808 TrackSelected = True LikeLessThanThirtySecondsLeft '20120823 20110906 - put here to try to avoid repeat of first song when ListAdvanceColor = vbGreen Else ' DelayTrackSelection = -Thirty '20120823 - will this hold long enough past the next call End If End If ' ListAdvanceToGreenOnPlay = SettingsGet(iniName, RegSettings, "ListAdvanceToGreenOnPlay", ListAdvanceToGreenOnPlay) VolSlider1.value = -VolumeControl1.Volume If InitialVolume = Zero Then InitialVolume = VolumeControl1.Volume End If LowerVolume = SettingsGet(iniName, RegSettings, "LowerVolume", LowerVolume) UpperVolume = SettingsGet(iniName, RegSettings, "UpperVolume", Hundred) Label3(Five).ForeColor = ForeFace Exit Sub Resume FailedInit: gCancel = True If inDesign Then Stop MsgBoxEx "Error " & Err & ". Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "PF_Ending..." inGrid_SendSpeech_BackColor = OffGray If inGrid_ForDoEvents_BackColor <> vbBlack Then inGrid_ForDoEvents_BackColor = vbGreen '\\ inGrid_ForDoEvents_BackColor = inGrid.ForDoevents.BackColor End If inGrid.ForDoevents.MousePointer = One '\\ Unload Me End With End Sub Private Sub Form_MouseDown(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbLeftButton Then Call GetCursorPos(MousePos) SaveX = MousePos.x SaveY = MousePos.y ElseIf Button = vbMiddleButton Then If Not IngridLoaded Then Unload Me Exit Sub End If If Abs(inGrid.Top - Me.Top) < Sixty Or inGrid.WindowState <> vbNormal Then inGrid.WindowState = vbNormal inGrid.Show vbModeless inGrid.move Val(SettingsGet(iniName, RegSettings, "MainLeft", DefaultBot(300, 300))), Val(SettingsGet(iniName, RegSettings, "MainTop", DefaultBot(1890, 1890))) inGrid.Visible = True IngridHidden = Zero Else If inGrid.WindowState = vbNormal Then inGrid.move Me.Left, Me.Top inGrid.Visible = False '\\ Hide IngridHidden = One End If Else End If End Sub Private Sub Form_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbLeftButton Then Static inMove As Boolean If inMove Then Exit Sub inMove = True Call GetCursorPos(MousePos) SaveX = (MousePos.x - SaveX) * xPixel SaveY = (MousePos.y - SaveY) * yPixel DrumsMove Call GetCursorPos(MousePos) SaveX = MousePos.x SaveY = MousePos.y inMove = False ElseIf Me.imgLogo.Visible = False Then '\\ Me.Slider2.Enabled = Me.Frame2.Visible = False Me.imgLogo.Visible = True Me.BongoMan.Enabled = True End If End Sub Private Sub Form_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Call MouseupFormDrumColor(Button, Shift, x, y) End Sub Private Sub Form_Unload(ByRef Cancel As Integer): LoseControl Me With Me Dim lWork As Long On Error Resume Next Call SettingsSave(iniName, RegSettings, "DeviceToControl", VolumeControl1.DeviceToControl) .Visible = False If Not StartUpTypeIsPreview Then If .WindowState = vbNormal Then SaveX = .Left SaveY = .Top If .frmPicture1(One).Top = Zero Then SaveX = -SaveX End If If .Height = .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height Then SaveY = -SaveY End If If .Left Mod Screen.Width = .Left Then SettingsSave iniName, "Music", "Drums.Left", SaveX SettingsSave iniName, "Music", "Drums.Top", SaveY SettingsSave iniName, "Music", "Drums.Height", .Height End If End If If (UpDown_Volume.value Mod 50) > One And UpDown_Volume.value <> 25 Then SettingsSave iniName, "Music", "Volume", UpDown_Volume.value SettingsSave iniName, "Music", "Reverb", chkReverb.value SettingsSave iniName, "Music", "Loop", chkLoop.value ' SettingsSave iniName, "Music", "Tempo", EDIT_Tempo.Caption SettingsSave iniName, "Music", "Groove", LIST_Grooves.ListIndex SettingsSave iniName, "Music", "Bands", LIST_Bands.ListIndex SettingsSave iniName, "Music", "GearsEnabled", ManualGearing.ForeColor SettingsSave iniName, "Music", "CPUUsage", .CPUUsage.Appearance End If If Not perf Is Nothing Then .StopCmd = True .cmdStop = True End If Dim lCount As Long On Error Resume Next ReDim path(Zero) If Not (segBand Is Nothing) Then perf.StopEx segBand, Zero, Zero segBand.Unload perf.GetDefaultAudioPath End If If Not (dmSegDrum Is Nothing) Then perf.StopEx dmSegDrum, Zero, Zero Set dmSegDrum = Nothing For lCount = LBound(segMotif) To UBound(segMotif) If Not (segMotif(lCount) Is Nothing) Then perf.StopEx segMotif(lCount), Zero, Zero Set segMotif(lCount) = Nothing Next Set segBand = Nothing Set style = Nothing Set composer = Nothing '\\ Set loader = Nothing If Not (band Is Nothing) Then Call band.Unload(perf) End If Set band = Nothing '\\ Set perf = Nothing '\\ on error Resume Next '\\ Get rid of our event perf.RemoveNotificationType DMUS_NOTIFY_ON_SEGMENT g_dx.DestroyEvent mlSeg Call CloseHandle(mlSeg) '\\ Unload our segment dmSegMotif.Unload perf.GetDefaultAudioPath Set dmSegMotif = Nothing If Not (perf Is Nothing) Then perf.CloseDown '\\ Get rid of our motifs ReDim moMotifs(Zero) '\\ Cleanup '\\ perf.CloseDown Set perf = Nothing Set loader = Nothing DJHandle = Zero '\\ Set Grid_Amp = Nothing If gAns <> -Sixty Then '\\ precarious hibernate flag If Not (m_oHeyIngridDJ Is Nothing) Then m_oHeyIngridDJ.quitunload '\\ False Set m_oHeyIngridDJ = Nothing End If End If If m_lAfterWinampOnEngaging = vbUnchecked Then Exit Sub ElseIf .LabelAlign.Caption = "exit WinampTV" Or m_lAfterWinampOnEngaging = vbGrayed Then Dim lhandle As Long lhandle = GetWAHandleWinampTV If lhandle <> Zero Then Call PostMessageByNum(lhandle, WM_CLOSE, vbNull, vbNull) If FindWindow(NotString, "ManyCam Options") <> Zero And m_bCamon Then Shell "taskkill.exe /f /t /im ManyCam.exe" End If If FindWindow(NotString, "mIRC") <> Zero Then Shell "taskkill.exe /f /t /im mIRC.exe" End If End If End If GDIDeleteDMgraphics dmDrumsLoaded = False End With End Sub Public Sub EnablePlayUI(ByRef fEnable As Boolean) 'Enable/Disable the buttons If fEnable Then chkLoop.Enabled = True cmdStop.Enabled = False cmdExternalHelper(ExternalHelper).Enabled = True ' 20260124 'cmdMovingPicturesXML cmdSegment.Enabled = True cmdStop.ZOrder One Else chkLoop.Enabled = False cmdStop.Enabled = True cmdExternalHelper(ExternalHelper).Enabled = False ' 20260124 'cmdMovingPicturesXML cmdSegment.Enabled = False cmdStop.ZOrder Zero End If If lstMotif.ListCount > Zero And lstMotif.ListIndex <> -One Then EnablePlayMotif Not fEnable Else EnablePlayMotif False End If End Sub Public Sub EnablePlayMotif(ByVal fEnable As Boolean) cmdPlayMotif.Enabled = fEnable End Sub Private Sub LoadSegment(ByVal sFile As String) Dim lTrack As Long, lCount As Long Dim oStyle As DirectMusicStyle8 Dim lTotalStyle As Long, lTempTotalStyle As Long On Error GoTo LeaveProc ReDim moMotifs(Zero) lstMotif.Clear Set dmSegMotif = loader.LoadSegment(sFile) dmSegMotif.Download perf.GetDefaultAudioPath txtSegment.Text = sFile EnablePlayUI True '\\ Now let's get the motifs in this segment Do While True Set oStyle = dmSegMotif.GetStyle(lTrack) lTotalStyle = lTotalStyle + oStyle.GetMotifCount - 1 ReDim Preserve moMotifs(lTotalStyle) For lCount = Zero To oStyle.GetMotifCount - 1 lstMotif.AddItem oStyle.GetMotifName(lCount) Set moMotifs(lTempTotalStyle + lCount).Motif = oStyle.GetMotif(oStyle.GetMotifName(lCount)) moMotifs(lTempTotalStyle + lCount).name = oStyle.GetMotifName(lCount) moMotifs(lTempTotalStyle + lCount).ListIndex = lstMotif.ListCount - 1 Next lTrack = lTrack + One lTempTotalStyle = lTotalStyle Loop LeaveProc: If lstMotif.ListCount > Zero Then lstMotif.ListIndex = Zero UpdateStatus "File loaded." End Sub Private Sub UpdateStatus(sStat As String) txtMotifStatus.Text = sStat End Sub Public Sub GrooveUp() On Error GoTo errorline '\\ me.EDIT_Tempo.caption = me.EDIT_Tempo.caption + cyclez * Int(xaxis) If Mp3PlayDoc > Zero Then Dim i As Long, k As Long '\\ , J As Long, m As Long k = Genre.ListIndex If k < Zero Then Exit Sub If Not Me.Genre.Selected(k) And DMStatus = Zero Then If Not HIDJNext Then Exit Sub If Not Perturbate Then Exit Sub Exit Sub End If i = Genre.ItemData(k) If i < Zero Then '\\ get the mod of groove and band '\\ -999 says the is no data so do nothing LIST_Grooves.ListIndex = (-i Mod Thousand) - One '\\ (LIST_Grooves.ListCount) LIST_Bands.ListIndex = lMax(Zero, Int(-i / Thousand) - One) '\\ Mod (LIST_Bands.ListCount) Else If LabelGrooves(One).ToolTipText Like "###.##%" Then Populist (Int(Left(LabelGrooves(One).ToolTipText, Six)) - 55) End If End If Else If Rnd > PointSeven Then LIST_Grooves.ListIndex = (LIST_Grooves.ListIndex + One) Mod (LIST_Grooves.ListCount) If Rnd > PointSeven Then LIST_Bands.ListIndex = (LIST_Bands.ListIndex + One) Mod (LIST_Bands.ListCount) End If perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * Eight) + One) ChangeBands Exit Sub errorline: ' stop End Sub Public Sub Whack(ByRef itemtype As Long, ByVal r1 As Long, Optional ByRef lFlags As Long = Zero) '\\ , ByVal Volume As Long, ByRef x As Single, ByRef y As Single, ByRef z As Single If PF_Ending Then Exit Sub On Error Resume Next Static DrumHit As Long, MeterHeight As Long If lFlags = Zero Then lFlags = DMUS_SEGF_SECONDARY If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_BEAT If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_DEFAULT If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_GRID If Rnd > PointSeven Then lFlags = lFlags Or DMUS_SEGF_MEASURE End If If r1 > Thousand Then r1 = r1 Mod Thousand Else r1 = (Abs(r1) + Abs(xaxis) - Two + StartDrumRoll) Mod 25 End If If r1 = -One Then Exit Sub If itemtype = Construct Then r1 = Abs(24 - r1) Mod 25 If Abs(r1 + One) = Abs(StartDrumRoll) Then If StartDrumRoll < Zero Then Exit Sub Else StartDrumRoll = -StartDrumRoll If Rnd < PointSeven Then Exit Sub End If End If End If '\\ Call perf.PlaySegmentEx(segMotif(Abs(r1)), lFlags, Zero) If Spiral <= UBound(path) Then Set path(Spiral) = Nothing Set path(Spiral) = perf.GetDefaultAudioPath '\\ path(Spiral).SelectedVolume Volume, 0 '\\ If itemtype = element Then Me.Drum(DrumHit).Font.Bold = False '\\ If DrumHit = r1 Then Call perf.StopEx(segMotif(Abs(r1)), Zero, DMUS_SEGF_BEAT Or DMUS_SEGF_VALID_START_MEASURE Or DMUS_SEGF_ALIGN) '\\ '\\ Else Call perf.PlaySegmentEx(segMotif(Abs(r1)), lFlags, Zero, , path(Spiral)) DrumHit = Abs(r1) '\\ End If Me.Drum(Abs(r1)).Font.Bold = True If MeterHeight < ConstMeterHeight Then MeterHeight = (MeterHeight + ConstMeterHeight) * Half Me.CPUUsage.Height = MeterHeight End If End If Me.Drum(Abs(r1)).BackColor = MyBrush.lbColor End Sub Private Sub Drum_Click(ByRef Index As Integer) If Me.UpDown_Volume = One Then Me.UpDown_Volume.value = Hundred End If HitDrum Index End Sub Private Sub EDIT_Tempo_KeyPress(KeyAscii As Integer) Dim lWork As Long If KeyAscii = vbKeyReturn Then If Val(EDIT_Tempo.Caption) > Zero And Val(EDIT_Tempo.Caption) < 1001 And IsNumeric(EDIT_Tempo.Caption) Then lWork = ChangeTempo(EDIT_Tempo.Caption) End If End If If KeyAscii = vbKeyReturn Then KeyAscii = Zero End Sub Private Sub EDIT_Tempo_LostFocus() Dim lWork As Long If Not IngridLoaded Then Exit Sub If Val(EDIT_Tempo.Caption) > Zero And Val(EDIT_Tempo.Caption) < 1001 And IsNumeric(EDIT_Tempo.Caption) Then lWork = ChangeTempo(EDIT_Tempo.Caption) End If End Sub Private Sub Get_Bands() Dim BandCount As Integer Dim counter As Integer BandCount = style.GetBandCount() For counter = Zero To (BandCount - 1) LIST_Bands.AddItem (style.GetBandName(BandCount - counter - 1)) Next counter End Sub 'Private Sub frmPicture2_Click() ' 'End Sub ' Private Sub frmPicture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then Call GetCursorPos(MousePos) SaveX = MousePos.x SaveY = MousePos.y ElseIf Button = vbMiddleButton Then If Not IngridLoaded Then Unload Me Exit Sub End If If Abs(inGrid.Top - Me.Top) < Sixty Or inGrid.WindowState <> vbNormal Then inGrid.WindowState = vbNormal inGrid.Show vbModeless inGrid.move Val(SettingsGet(iniName, RegSettings, "MainLeft", 300)), Val(SettingsGet(iniName, RegSettings, "MainTop", 1890)) inGrid.Visible = True IngridHidden = Zero Else If inGrid.WindowState = vbNormal Then inGrid.move Me.Left, Me.Top inGrid.Visible = False '\\ Hide IngridHidden = One End If ElseIf Button = vbRightButton Then Me.move inGrid.Left End If End Sub Private Sub frmPicture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Me.cmdSave.Enabled = False Then Exit Sub 'stupid bug 20170721 see "weird 2" If Button = vbLeftButton Then Static inMove As Boolean If inMove Then Exit Sub inMove = True Call GetCursorPos(MousePos) SaveX = (MousePos.x - SaveX) * xPixel SaveY = (MousePos.y - SaveY) * yPixel DrumsMove SaveX = MousePos.x SaveY = MousePos.y inMove = False ElseIf Me.imgLogo.Visible = False Then '\\ Me.Slider2.Enabled = Me.Frame2.Visible = False Me.imgLogo.Visible = True Me.BongoMan.Enabled = True End If End Sub Private Sub frmPicture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbRightButton And Index = Zero Then Dim Color As Long Color = Int(((GetPixel(Me.frmPicture1(Index).hdc, x / xPixel, y / yPixel) - vbBlue) Mod vbGreen) / Eight) If Color <= 31 And Color >= Zero Then If Color < Two Then Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") Else Color = ScheduleCol + Format(date + Color, "d") - Format(date, "d") If Color <= ScheduleCol + One Then Color = Color - One End If End If fDoc(ScheduleMth).ZOrder Zero fDoc(ScheduleMth).Visible = True ScheduleSync Color, (x - (Me.Drum((Color - Three) Mod Seven).Left - Sixty)) / Me.Drum(Zero).Width * TwentyFour End If End If End Sub Private Sub Genre_GotFocus() SetStatus Me.Genre End Sub Private Sub Genre_ItemCheck(ByRef item As Integer) If Me.GenreEnabled Then SetDirty True, Mp3PlayDoc End Sub Private Sub Genre_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbMiddleButton Then ShellExecute Zero, "open", "explorer", Quotes & Left$(Mp3FilenameNowPlaying, InStrRev(Mp3FilenameNowPlaying, "\")) & Quotes, Zero, One WA_OpenFileInfoBox End If End Sub Private Sub Genre_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Left$(Me.Genre.ToolTipText, Len(Me.Genre.list(Me.Genre.ListIndex))) = Me.Genre.list(Me.Genre.ListIndex) Then Exit Sub Me.Genre.ToolTipText = Me.Genre.list(Me.Genre.ListIndex) & " - " & Trim$(Mid$(Me.Genre.ToolTipText, InStr(Me.Genre.ToolTipText, "-") + One)) Me.Genre.SetFocus End Sub Private Sub Genre_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then PopupMenu inGrid.mnuGenre Else If Not Me.Genre.Selected(Me.Genre.ListIndex) And Me.cmdBeatmix.Caption = "Biasmix" Then If Me.LabelBPM_ForeColor >= vbBlue Then '\\ see PreparingNextTrack If WA_GetShuffle = Zero Then WA_SetShuffle One SpeakThis "Shuffling on " & Me.Genre.list(Me.Genre.ListIndex) End If End If End If FreshPlot "Perturbate", , True '\\ ensures accurate track length End If End Sub Private Sub Label3_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Dim lWork As Long If Index = Two Then SetTrickle Trickle.chkEngage.value = vbChecked ' WA_CloseWinamp ' Call WritePrivateProfileStringKey("Winamp", "dspplugin_name", "dsp_djHelp.dll", WinampInidir) ' Call WritePrivateProfileStringKey("Winamp", "dspplugin_num", "0", WinampInidir) ElseIf Button = vbMiddleButton Then CrossFadeTime = m_lCrossfadeTime 'Twenty ' Me.Label3(One).ToolTipText = CrossFadeTime If Me.UpperVolPreset Then lWork = WinAmpControls("LessVolume") Else lWork = WinAmpControls("SetVol") End If End If End Sub Private Sub LabelGrooves_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then Me.GenreEnabled = (Me.GenreEnabled + One) Mod Three SetGenreEnabled '\\ SetGenreSelected ElseIf Button = vbMiddleButton Then Me.lblDrumSize.Caption = "- drums ^" Me.frmPicture1(One).Top = DRUMPADSIZE Me.Height = 6615 Me.Top = fHIDJ.Top + fHIDJ.Height ElseIf Button = vbRightButton And Index = Zero Then If LabelGrooves(Zero).ForeColor = vbOrange Then ' KarmaGunAfterStartup = True RecordingNow = True ' LabelGrooves(zero).ForeColor = vbGreen ElseIf LabelGrooves(Zero).ForeColor = vbGreen Then ' KarmaGunAfterStartup = True RecordingNow = True LabelGrooves(Zero).ForeColor = vbYellow Else RecordingNow = False ' LabelGrooves(Zero).ForeColor = vbOrange ' KarmaGunAfterStartup = False 'this causes a delayed off for Recording at end of track End If End If End Sub Private Sub LabelVol_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim lWork As Long If Button = vbLeftButton Then lWork = WinAmpControls("VolUp", , False) ElseIf Button = vbRightButton Then lWork = WinAmpControls("VolDn", , False) End If End Sub Private Sub LabelVol_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim lWork As Long If Button = vbMiddleButton Then CrossFadeTime = m_lCrossfadeTime 'Twenty ' Me.Label3(One).ToolTipText = CrossFadeTime If Me.UpperVolPreset Then lWork = WinAmpControls("LessVolume") ElseIf Me.LowerVolPreset Then lWork = WinAmpControls("SetVol") If DMStatus <> One Then PlayWinamp End If ElseIf Button = vbLeftButton Then lWork = WinAmpControls("VolUp", , False) ElseIf Button = vbRightButton Then lWork = WinAmpControls("VolDn", , False) End If End Sub Private Sub lblClose_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Close_MouseUp Button End Sub Private Sub lblStatus_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_lblStatus Button End Sub Private Sub LIST_Bands_GotFocus() SetStatus Me.LIST_Bands End Sub Private Sub LIST_Bands_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.LIST_Bands.SetFocus End Sub Private Sub LIST_Bands_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) SetMp3playing End Sub Private Sub LIST_Grooves_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) SetMp3playing End Sub Private Sub lstMotif_GotFocus() SetStatus lstMotif End Sub Private Sub ManualGearing_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.ManualGearing.ZOrder End Sub Private Sub imgLogo_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me Dim lWork As Long If Button <> vbMiddleButton Then '\\ inoperable due to proc ' .Frame2.Visible = True ' .imgLogo.Visible = False Else If .BongoMan.Width = .Frame2.Width + Sixty Then GridOut.Visible = True inGrid.Visible = True PictureLoaded = False lWork = SetParent(GridOut.Picture2.hwnd, GridOut.hwnd) .BongoMan.move .AutoTempo.Left - 15, .txtMotifStatus.Top, 870, 1800 End If End If End With End Sub Private Sub imgLogo_OLEDragDrop(ByRef data As DataObject, ByRef Effect As Long, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Call OLEDragDropEx(data, Effect, Button, Shift, x, y) '\\ fDoc(gDoc),fDoc(gDoc), End Sub Private Sub LabelBPM_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MouseUp_LabelBPM Button End Sub Private Sub LIST_Bands_Click() ChangeBands End Sub Private Sub LIST_Grooves_Click() perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * 8) + One) End Sub Private Sub LIST_Grooves_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MakeForegroundWindow Me.hwnd Me.Slider1.ZOrder One Me.Slider1.Visible = True Me.Slider1.SetFocus End Sub Private Sub lstMotif_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me If OnTop Then Exit Sub If .Height <> .frmPicture1(One).Top + .cmdBeatmix.Top + .cmdBeatmix.Height Then ElseIf .frmPicture1(One).Top = Zero Then .lblDrumSize.Caption = "- drums ^" .Height = 2790 '2340 Else .lblDrumSize.Caption = "- drums ^" .Height = 6615 '6165 End If If Button = vbLeftButton Then cmdPlayMotif = True lstMotif.SetFocus End With End Sub Private Sub BongoMan_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) BongoMan.SetFocus If OnTop Then Exit Sub On Error Resume Next If TrickleLoaded Then If Trickle.WindowState <> vbNormal Then Trickle.WindowState = vbNormal inGrid.Show vbModeless Trickle.Show vbModeless End If If Not inGrid.Visible Then inGrid.WindowState = vbNormal inGrid.Show vbModeless inGrid.ZOrder Zero End If End If End Sub Private Sub BongoMan_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) With Me On Error GoTo errorline If Button = vbMiddleButton Then '\\ code not finished due to serious Proc bug .BongoMan.Enabled = True .BongoMan.AutoRedraw = True .BongoMan.move -20, -20, .Frame2.Width + Sixty, .Frame2.Height + Sixty WindowMe .BongoMan.hwnd .BongoMan.ZOrder FrontFlipper = Ten ElseIf Button = vbLeftButton Then If Not DJHandle = Zero Then If HIDJstatus = One Then If .UpDown_Volume.value = Zero Then MsgBoxEx "Drum volume set to zero disables BPM Learning" Exit Sub End If .AutoTempo.ZOrder dmdrums_autotempo_backcolor = vbButtonFace workbuffer = MP3ID3v1Tag.Comment If Shift = vbShiftMask Then Mid$(workbuffer, One, Seven) = "000.00%" MP3ID3v1Tag.Comment = workbuffer MP3ID3v1Tag.Update End If '\\ mid$(MP3Tag.Comment, one, seven) = "000.00%" '\\ Call PutTagV1(Mp3FilenameNowPlaying, MP3Tag) .AutoTempo.ZOrder End If End If ElseIf Button = vbRightButton Then ToggleWinamp End If Exit Sub Resume errorline: ' stop End With End Sub Private Sub ManualGearing_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' Click toggles Automatic Tempo gearing. If Me.ManualGearing.ForeColor = vbOrange Then Me.ManualGearing.ForeColor = vbCyan Else Me.ManualGearing.ForeColor = vbOrange End If End Sub Private Sub MonthView1_DateDblClick(ByVal DateDblClicked As Date) Me.DTPicker1.value = Me.MonthView1.value SyncSchedule (Me.DTPicker1.value) End Sub Private Sub MonthView1_GetDayBold(ByVal StartDate As Date, ByVal count As Integer, state() As Boolean) If PF_Ending Then Exit Sub If DateValue(Now) = DateValue(MonthView1.value) Then If StartUpChime = Zero Then DTPicker1.value = Now Else DTPicker1.value = MonthView1.value End If Call SyncSchedule(Me.DTPicker1.value) If ScheduleMth > Zero Then Front True, fDoc(ScheduleMth) End If End Sub Private Sub MonthView1_GotFocus() SetStatus MonthView1 End Sub Private Sub MonthView1_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) MonthView1.SetFocus End Sub Private Sub MonthView1_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Me.DTPicker1.value = Me.MonthView1.value If Button = vbLeftButton Then Exit Sub If Button = vbRightButton Then Me.MonthView1.Visible = False: Exit Sub End If If Button = vbMiddleButton Then Me.DTPicker1.value = Now Me.MonthView1.Visible = False End If Call SyncSchedule(Me.DTPicker1.value) End Sub Private Sub MonthView1_SelChange(ByVal StartDate As Date, ByVal EndDate As Date, Cancel As Boolean) If Day(DTPicker1.value) <> Day(MonthView1.value) And DateValue(MonthView1.value) <> DateValue(MonthView1.VisibleDays(One)) Then DTPicker1.value = MonthView1.value SyncSchedule DTPicker1.value '\\ schedulecol attempted bug correction End If End Sub Private Sub optBeat_GotFocus() SetStatus optBeat End Sub Private Sub optDefault_GotFocus() SetStatus optDefault End Sub Private Sub optGrid_GotFocus() SetStatus optGrid End Sub Private Sub optImmediate_GotFocus() SetStatus optImmediate End Sub Private Sub optMeasure_GotFocus() SetStatus optMeasure End Sub Private Sub Slider1_GotFocus() SetStatus Me.LIST_Grooves End Sub Private Sub Slider1_Scroll() With Me Do While True .Slider1.Max = .LIST_Grooves.ListCount - One If .Slider1.value < One Then If .Slider1.value = -One Then .LIST_Grooves.ListIndex = Zero .Slider1.value = .Slider1.Max Exit Do Else .Slider1.value = .Slider1.Max - One End If ElseIf .Slider1.value = .Slider1.Max Then .Slider1.value = Zero End If .LIST_Grooves.ListIndex = .Slider1.value Exit Do Loop .Play = True End With End Sub Private Sub Slider2_GotFocus() SetStatus AutoTempo End Sub Private Sub Slider2_Scroll() SongTime 6, False Me.Slider2.Max = Me.AutoTempo.ListCount - One If Me.Slider2.value < Zero Then Me.Slider2.value = Zero '\\ Me.AutoTempo.ListIndex End If SetAutoTempoListIndex Me.Slider2.value workbuffer = MP3ID3v1Tag.Comment Mid$(workbuffer, One, Seven) = Left$(AutoTempo.list(dmDrums.AutoTempo.ListIndex), Six) & "%" MP3ID3v1Tag.Comment = workbuffer MP3ID3v1Tag.Update SongTime 7, True Me.Play = True End Sub Private Sub StopCmd_Click() On Error Resume Next perf.StopEx dmSegDrum, Zero, Zero chkReverb.Enabled = True End Sub Public Sub TempoMultiplier_Click(ByRef Index As Integer) If TempoIndex > Index And Index = Zero Then If Not SendSound("changedn.wav", , True, One) Then Exit Sub ElseIf TempoIndex < Index And Index = Three Then Call SendSound("changeup.wav", , True) End If Me.ManualGearing.ForeColor = vbOrange TempoIndex = Index Select Case Index Case Zero TempoFactor = One / Four If Me.ManualGearing.ForeColor = vbCyan And inGrid_ForDoEvents_BackColor <> OffGray Then If Not Perturbate Then Exit Sub TempoFactor = 0.5001 '\\ this is a flag not to change into Low until upshifted TempoMultiplier(One) = True Exit Sub End If Case One If TempoFactor <> 0.5001 Then TempoFactor = Half Case Two If TempoFactor <> 1.0001 Then TempoFactor = One Case Three TempoFactor = Two '\\ One + Half If Me.ManualGearing.ForeColor = vbCyan And inGrid_ForDoEvents_BackColor <> OffGray Then If Not Perturbate Then Exit Sub TempoFactor = 1.0001 '\\ this is a flag not to change into overdrive until downshifted TempoMultiplier(Two) = True Exit Sub End If End Select SongTime 8, False '\\ True End Sub Private Sub Play_Click() PlaySeg ChangeBands chkReverb.Enabled = False If inGrid_SendSpeech_BackColor <> vbYellow Then If Me.cmdExternalHelper(One).Enabled = False And Me.cmdSave.Enabled = False Then ' 20260124 'cmdMovingPicturesXML Me.cmdSave.Enabled = True End If inGrid_SendSpeech_BackColor = vbYellow End If End Sub Private Sub TempoMultiplier_DblClick(ByRef Index As Integer) TempoIndex = Index Select Case Index Case Zero TempoFactor = One / Four Case One TempoFactor = Half Case Two TempoFactor = One Case Three TempoFactor = Two '\\ One + Half End Select SongTime 9, True End Sub Private Sub TempoMultiplier_MouseMove(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) Dim PseudoTempo As Single Select Case Index Case Zero PseudoTempo = One / Four Case One PseudoTempo = Half Case Two PseudoTempo = One Case Three PseudoTempo = Two '\\ One + Half End Select '\\ determine base by knowing which tempo selector is visible PseudoTempo = Me.EDIT_Tempo * PseudoTempo / TempoFactor ' Me.TempoMultiplier(Index).ToolTipText = "Opp.Click (" & Index & ") sets " & format(PseudoTempo, "000.00") & " into ID3v1Tag.Comment" End Sub Private Sub TempoMultiplier_MouseUp(ByRef Index As Integer, ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then If Not m_TempoSelector = -One Then Me.TempoMultiplier(m_TempoSelector).BackColor = CoalFace If Index = m_TempoSelector Then m_TempoSelector = -One Else m_TempoSelector = Index Me.TempoMultiplier(m_TempoSelector).BackColor = vbGreen m_CurrentGenreSorting = SettingsGet(iniName, "Preferences", "GenreSortMask" & m_TempoSelector, m_CurrentGenreSorting) SetStation End If Call SettingsSave(iniName, "Preferences", "TempoSelector", m_TempoSelector) End If End Sub Private Sub txtSegment_GotFocus() SetStatus txtSegment End Sub Private Sub txtSegment_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) txtSegment.SetFocus End Sub Private Sub txtMotifStatus_GotFocus() SetStatus txtMotifStatus End Sub Private Sub txtMotifStatus_MouseMove(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) txtMotifStatus.SetFocus End Sub Private Sub txtMotifStatus_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbMiddleButton Then MP3ID3v2Tag.MP3File = Mp3FilenameNowPlaying txtMotifStatus.Text = "http://www.allmusic.com/cg/amg.dll?P=amg&opt1=1&sql=" & TrimNull(MP3ID3v2Tag.artist) Allmusic = txtMotifStatus.Text txtMotifStatus.SelStart = Zero txtMotifStatus.SelLength = Len(txtMotifStatus.Text) DocSetupAllmusic If AllmusicDoc > Zero Then fDoc(AllmusicDoc).PopupMenu fDoc(AllmusicDoc).mnuSong2text End If ' Set MP3ID3v2Tag = Nothing End If End Sub Private Sub UpDown_Fine_Tempo_Change() Dim lWork As Long LabelBPM.Caption = Format(UpDown_Fine_Tempo.value / Ten, "0.0") & "%BPM" lWork = BPMcolor(UpDown_Fine_Tempo.value / Ten) LabelBPM_ForeColor = lWork '\\ the following factors are used by Sub DoItToIt to change the state space of the DJHelper Tempo Slider TempoSliderAdjustmentLength = Twenty '\\ If UpDown_Fine_Tempo.Enabled And LabelBPM_Enabled Then EndTempoSlider = UpDown_Fine_Tempo.value DelayTempoSliderFlag = True StartTempoSliderTimer = Timer Else DelayTempoSliderFlag = False End If ' Label3(Five).ForeColor = ForeFace '(lblDrumSize.ForeColor + Label3(One).ForeColor) * Half lblDrumSize.ForeColor = LabelBPM_ForeColor ' lblDrumSize.Caption = "drums" End Sub Private Sub UpDown_Fine_Tempo_MouseUp(ByRef Button As Integer, ByRef Shift As Integer, ByRef x As Single, ByRef y As Single) If Button = vbRightButton Then Me.EDIT_Tempo.ZOrder ElseIf Button = vbLeftButton Then DelayTempoSliderFlag = False SetSliderDJTempo False End If End Sub Private Sub UPDOWN_Volume_Change() EDIT_Volume.Caption = UpDown_Volume.value ' If UpDown_Volume.value = 50 Then Stop If (UpDown_Volume.value Mod 50) > One And UpDown_Volume.value <> 25 Then SelectedVolume = UpDown_Volume.value Select Case UpDown_Volume.value Case 25 EDIT_Volume.BackColor = vbBlack EDIT_Volume.ForeColor = vbGreen Case 100, 50 EDIT_Volume.BackColor = vbBlack EDIT_Volume.ForeColor = vbWhite Case Is < 2 EDIT_Volume.BackColor = vbWhite EDIT_Volume.ForeColor = vbBlack Case Else EDIT_Volume.BackColor = vbBlack EDIT_Volume.ForeColor = vbCyan End Select EDIT_Volume.BorderStyle = One If UpDown_Volume.Enabled = True Then Call ChangeVolume(UpDown_Volume.value) End Sub Private Sub ChangeBands() On Error Resume Next If Not (band Is Nothing) Then Call band.Unload(perf) Set band = Nothing End If If Not (segBand Is Nothing) Then Call segBand.Unload(perf) Set segBand = Nothing End If If LIST_Bands = vbNullString Then Set band = style.GetBand("Standard") Else Set band = style.GetBand(LIST_Bands) End If Call band.Download(perf) Set segBand = band.CreateSegment() segBand.Download perf.GetDefaultAudioPath Call perf.PlaySegmentEx(segBand, DMUS_SEGF_SECONDARY, Zero) End Sub Private Sub PlaySeg() On Error Resume Next Call perf.PlaySegmentEx(dmSegDrum, Zero, Zero) End Sub Public Function ChangeTempo(ByVal Tempo As Single) '\\ , Optional ByVal NowFineTempo As Double = Infini) As Single On Error Resume Next ChangeTempo = Tempo * TempoFactor * (One + UpDown_Fine_Tempo.value / Thousand) If inGrid.TimeStep.value < Zero Then inGrid.TimeStep.value = -250 / (ChangeTempo / Sixty) '\\ why -250? End If perf.SendTempoPMSG Zero, DMUS_PMSGF_MUSICTIME, ChangeTempo End Function Sub ChangeItemVolume(ByVal n As Long) If n = Zero Then n = -10000 Else n = (-50 * (100 - n)) End If End Sub Sub ChangeVolume(ByVal n As Long) If n = Zero Then n = -10000 Else n = (-50 * (100 - n)) End If If Me.UpDown_Volume.value = Zero Then '\\ And Me.AutoTempo.Enabled SetScrollText "Drum volume set to zero disables BPM Learning" End If If Not perf Is Nothing Then perf.SetMasterVolume n '20120813 bug End Sub Public Property Get LabelBPM_Enabled() As Boolean LabelBPM_Enabled = m_bLabelBPM_Enabled End Property Public Property Let LabelBPM_Enabled(ByVal bLabelBPM_Enabled As Boolean) m_bLabelBPM_Enabled = bLabelBPM_Enabled ' wtf? unchangeable while another form is shown vbmodal LabelBPM.Enabled = m_bLabelBPM_Enabled If m_bLabelBPM_Enabled = False Then SetLabelKeyForeColor vbRed End If End Property