Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Mayıs 2012 Pazar

midiOutShortMsg Function


'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) Image1, Label1, Label2
'2) CommandButton1, Label3, Label4, label5, Label6, Label7
'3) ComboBox1, ComboBox2, ComboBox3, ComboBox4, Label8
Private i As Single
Private hTime As Long
Private hMidiOut As Long
Private hSound As Long
Private Bellek(1 To 128, 1 To 2)
Private V1 As Double
Private V2 As Double
Private V3 As Double
Private V4 As Double
Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] midiOutShortMsg Function"
Call Bellek_Kur
Call Ekran_Kur
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
Call StopMidiOut
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
V1 = ComboBox1.List(ComboBox1.ListIndex, 1)
V2 = ComboBox2.Value
V3 = ComboBox3.Value - 1
V4 = ComboBox4.Value
Call OpenMidiOut(0)
Call StopNote(V1, V2, V3)
Call PlayNote(V1, V2, V3)
End Sub
Private Function OpenMidiOut(ByVal hMidiOutID As Integer) As Integer
On Error Resume Next
Call StopMidiOut
midiOutOpen hMidiOut, hMidiOutID, 0, 0, 0
End Function
Private Function StopMidiOut() As Integer
On Error Resume Next
If hMidiOut <> 0 Then
midiOutClose hMidiOut
hMidiOut = 0
End If
End Function
Private Function PlayNote(ByVal Patch As Long, ByVal Gam As Long, ByVal Vel As Long)
On Error Resume Next
hSound = ((Vel * &H10000) + (Gam * &H100) + (&H90 + Patch))
Label8.Caption = hSound
midiOutShortMsg hMidiOut, hSound
hTime = VBA.Timer
Do
VBA.DoEvents
Loop Until VBA.Timer > hTime + V4
midiOutClose hMidiOut
End Function
Private Function StopNote(ByVal Patch As Long, ByVal Gam As Long, ByVal Vel As Long)
On Error Resume Next
hSound = ((Vel * &H10000) + (Gam * &H100) + (&H80 + Patch))
Label8.Caption = hSound
midiOutShortMsg hMidiOut, hSound
End Function
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 92
.Width = 418
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 420
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With CommandButton1
.Left = 6
.Top = 36
.Height = 30
.Width = 72
.Caption = "Sound"
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.ForeColor = &H808000
End With
With Label3
.Left = 84
.Top = 36
.Height = 12
.Width = 120
.Caption = "Patch"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label4
.Left = 204
.Top = 36
.Height = 12
.Width = 42
.Caption = "Gam"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label5
.Left = 246
.Top = 36
.Height = 12
.Width = 42
.Caption = "Value"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label6
.Left = 288
.Top = 36
.Height = 12
.Width = 42
.Caption = "Eko"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label7
.Left = 330
.Top = 36
.Height = 12
.Width = 78
.Caption = "Sound Long"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With ComboBox1
.Left = 84
.Top = 48
.Height = 18
.Width = 120
.ColumnCount = 2
.ColumnWidths = "108;0"
.ListWidth = 120
For i = 1 To 128
.AddItem Bellek(i, 1)
.List((i - 1), 1) = Bellek(i, 2)
Next i
.ListIndex = 0
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With ComboBox2
.Left = 204
.Top = 48
.Height = 18
.Width = 42
.ColumnCount = 1
.ColumnWidths = "30"
.ListWidth = 42
For i = 1 To 128
.AddItem i
Next i
.ListIndex = 59
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With ComboBox3
.Left = 246
.Top = 48
.Height = 18
.Width = 42
.ColumnCount = 1
.ColumnWidths = "30"
.ListWidth = 42
For i = 1 To 128
.AddItem i
Next i
.ListIndex = 127
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With ComboBox4
.Left = 288
.Top = 48
.Height = 18
.Width = 42
.ColumnCount = 1
.ColumnWidths = "30"
.ListWidth = 42
For i = 1 To 6
.AddItem i
Next i
.ListIndex = 3
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With Label8
.Left = 330
.Top = 48
.Height = 18
.Width = 78
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
End With
End Sub
Private Sub Bellek_Kur()
On Error Resume Next
Bellek(1, 1) = "1 Acoustic Grand Piano": Bellek(1, 2) = 1
Bellek(2, 1) = "2 Bright Acoustic Piano": Bellek(2, 2) = 2
Bellek(3, 1) = "3 Electric Grand Piano": Bellek(3, 2) = 3
Bellek(4, 1) = "4 Honky-tonk Piano": Bellek(4, 2) = 4
Bellek(5, 1) = "5 Electric Piano 1": Bellek(5, 2) = 5
Bellek(6, 1) = "6 Electric Piano 2": Bellek(6, 2) = 6
Bellek(7, 1) = "7 Harpsichord": Bellek(7, 2) = 7
Bellek(8, 1) = "8 Clavi": Bellek(8, 2) = 8
Bellek(9, 1) = "9 Celesta": Bellek(9, 2) = 9
Bellek(10, 1) = "10 Glockenspiel": Bellek(10, 2) = 10
Bellek(11, 1) = "11 Music Box": Bellek(11, 2) = 11
Bellek(12, 1) = "12 Vibraphone": Bellek(12, 2) = 12
Bellek(13, 1) = "13 Marimba": Bellek(13, 2) = 13
Bellek(14, 1) = "14 Xylophone": Bellek(14, 2) = 14
Bellek(15, 1) = "15 Tubular Bells": Bellek(15, 2) = 15
Bellek(16, 1) = "16 Dulcimer": Bellek(16, 2) = 16
Bellek(17, 1) = "17 Drawbar Organ": Bellek(17, 2) = 17
Bellek(18, 1) = "18 Percussive Organ": Bellek(18, 2) = 18
Bellek(19, 1) = "19 Rock Organ": Bellek(19, 2) = 19
Bellek(20, 1) = "20 Church Organ": Bellek(20, 2) = 20
Bellek(21, 1) = "21 Reed Organ": Bellek(21, 2) = 21
Bellek(22, 1) = "22 Accordion": Bellek(22, 2) = 22
Bellek(23, 1) = "23 Harmonica": Bellek(23, 2) = 23
Bellek(24, 1) = "24 Tango Accordion": Bellek(24, 2) = 24
Bellek(25, 1) = "25 Acoustic Guitar (nylon)": Bellek(25, 2) = 25
Bellek(26, 1) = "26 Acoustic Guitar (steel)": Bellek(26, 2) = 26
Bellek(27, 1) = "27 Electric Guitar (jazz)": Bellek(27, 2) = 27
Bellek(28, 1) = "28 Electric Guitar (clean)": Bellek(28, 2) = 28
Bellek(29, 1) = "29 Electric Guitar (muted)": Bellek(29, 2) = 29
Bellek(30, 1) = "30 Overdriven Guitar": Bellek(30, 2) = 30
Bellek(31, 1) = "31 Distortion Guitar": Bellek(31, 2) = 31
Bellek(32, 1) = "32 Guitar harmonics": Bellek(32, 2) = 32
Bellek(33, 1) = "33 Acoustic Bass": Bellek(33, 2) = 33
Bellek(34, 1) = "34 Electric Bass (finger)": Bellek(34, 2) = 34
Bellek(35, 1) = "35 Electric Bass (pick)": Bellek(35, 2) = 35
Bellek(36, 1) = "36 Fretless Bass": Bellek(36, 2) = 36
Bellek(37, 1) = "37 Slap Bass 1": Bellek(37, 2) = 37
Bellek(38, 1) = "38 Slap Bass 2": Bellek(38, 2) = 38
Bellek(39, 1) = "39 Synth Bass 1": Bellek(39, 2) = 39
Bellek(40, 1) = "40 Synth Bass 2": Bellek(40, 2) = 40
Bellek(41, 1) = "41 Violin": Bellek(41, 2) = 41
Bellek(42, 1) = "42 Viola": Bellek(42, 2) = 42
Bellek(43, 1) = "43 Cello": Bellek(43, 2) = 43
Bellek(44, 1) = "44 Contrabass": Bellek(44, 2) = 44
Bellek(45, 1) = "45 Tremolo Strings": Bellek(45, 2) = 45
Bellek(46, 1) = "46 Pizzicato Strings": Bellek(46, 2) = 46
Bellek(47, 1) = "47 Orchestral Harp": Bellek(47, 2) = 47
Bellek(48, 1) = "48 Timpani": Bellek(48, 2) = 48
Bellek(49, 1) = "49 String Ensemble 1": Bellek(49, 2) = 49
Bellek(50, 1) = "50 String Ensemble 2": Bellek(50, 2) = 50
Bellek(51, 1) = "51 SynthStrings 1": Bellek(51, 2) = 51
Bellek(52, 1) = "52 SynthStrings 2": Bellek(52, 2) = 52
Bellek(53, 1) = "53 Choir Aahs": Bellek(53, 2) = 53
Bellek(54, 1) = "54 Voice Oohs": Bellek(54, 2) = 54
Bellek(55, 1) = "55 Synth Voice": Bellek(55, 2) = 55
Bellek(56, 1) = "56 Orchestra Hit": Bellek(56, 2) = 56
Bellek(57, 1) = "57 Trumpet": Bellek(57, 2) = 57
Bellek(58, 1) = "58 Trombone": Bellek(58, 2) = 58
Bellek(59, 1) = "59 Tuba": Bellek(59, 2) = 59
Bellek(60, 1) = "60 Muted Trumpet": Bellek(60, 2) = 60
Bellek(61, 1) = "61 French Horn": Bellek(61, 2) = 61
Bellek(62, 1) = "62 Brass Section": Bellek(62, 2) = 62
Bellek(63, 1) = "63 SynthBrass 1": Bellek(63, 2) = 63
Bellek(64, 1) = "64 SynthBrass 2": Bellek(64, 2) = 64
Bellek(65, 1) = "65 Soprano Sax": Bellek(65, 2) = 65
Bellek(66, 1) = "66 Alto Sax": Bellek(66, 2) = 66
Bellek(67, 1) = "67 Tenor Sax": Bellek(67, 2) = 67
Bellek(68, 1) = "68 Baritone Sax": Bellek(68, 2) = 68
Bellek(69, 1) = "69 Oboe": Bellek(69, 2) = 69
Bellek(70, 1) = "70 English Horn": Bellek(70, 2) = 70
Bellek(71, 1) = "71 Bassoon": Bellek(71, 2) = 71
Bellek(72, 1) = "72 Clarinet": Bellek(72, 2) = 72
Bellek(73, 1) = "73 Piccolo": Bellek(73, 2) = 73
Bellek(74, 1) = "74 Flute": Bellek(74, 2) = 74
Bellek(75, 1) = "75 Recorder": Bellek(75, 2) = 75
Bellek(76, 1) = "76 Pan Flute": Bellek(76, 2) = 76
Bellek(77, 1) = "77 Blown Bottle": Bellek(77, 2) = 77
Bellek(78, 1) = "78 Shakuhachi": Bellek(78, 2) = 78
Bellek(79, 1) = "79 Whistle": Bellek(79, 2) = 79
Bellek(80, 1) = "80 Ocarina": Bellek(80, 2) = 80
Bellek(81, 1) = "81 Lead 1 (square)": Bellek(81, 2) = 81
Bellek(82, 1) = "82 Lead 2 (sawtooth)": Bellek(82, 2) = 82
Bellek(83, 1) = "83 Lead 3 (calliope)": Bellek(83, 2) = 83
Bellek(84, 1) = "84 Lead 4 (chiff)": Bellek(84, 2) = 84
Bellek(85, 1) = "85 Lead 5 (charang)": Bellek(85, 2) = 85
Bellek(86, 1) = "86 Lead 6 (voice)": Bellek(86, 2) = 86
Bellek(87, 1) = "87 Lead 7 (fifths)": Bellek(87, 2) = 87
Bellek(88, 1) = "88 Lead 8 (bass + lead)": Bellek(88, 2) = 88
Bellek(89, 1) = "89 Pad 1 (new age)": Bellek(89, 2) = 89
Bellek(90, 1) = "90 Pad 2 (warm)": Bellek(90, 2) = 90
Bellek(91, 1) = "91 Pad 3 (polysynth)": Bellek(91, 2) = 91
Bellek(92, 1) = "92 Pad 4 (choir)": Bellek(92, 2) = 92
Bellek(93, 1) = "93 Pad 5 (bowed)": Bellek(93, 2) = 93
Bellek(94, 1) = "94 Pad 6 (metallic)": Bellek(94, 2) = 94
Bellek(95, 1) = "95 Pad 7 (halo)": Bellek(95, 2) = 95
Bellek(96, 1) = "96 Pad 8 (sweep)": Bellek(96, 2) = 96
Bellek(97, 1) = "97 FX 1 (rain)": Bellek(97, 2) = 97
Bellek(98, 1) = "98 FX 2 (soundtrack)": Bellek(98, 2) = 98
Bellek(99, 1) = "99 FX 3 (crystal)": Bellek(99, 2) = 99
Bellek(100, 1) = "100 FX 4 (atmosphere)": Bellek(100, 2) = 100
Bellek(101, 1) = "101 FX 5 (brightness)": Bellek(101, 2) = 101
Bellek(102, 1) = "102 FX 6 (goblins)": Bellek(102, 2) = 102
Bellek(103, 1) = "103 FX 7 (echoes)": Bellek(103, 2) = 103
Bellek(104, 1) = "104 FX 8 (sci-fi)": Bellek(104, 2) = 104
Bellek(105, 1) = "105 Sitar": Bellek(105, 2) = 105
Bellek(106, 1) = "106 Banjo": Bellek(106, 2) = 106
Bellek(107, 1) = "107 Shamisen": Bellek(107, 2) = 107
Bellek(108, 1) = "108 Koto": Bellek(108, 2) = 108
Bellek(109, 1) = "109 Kalimba": Bellek(109, 2) = 109
Bellek(110, 1) = "110 Bag pipe": Bellek(110, 2) = 110
Bellek(111, 1) = "111 Fiddle": Bellek(111, 2) = 111
Bellek(112, 1) = "112 Shanai": Bellek(112, 2) = 112
Bellek(113, 1) = "113 Tinkle Bell": Bellek(113, 2) = 113
Bellek(114, 1) = "114 Agogo": Bellek(114, 2) = 114
Bellek(115, 1) = "115 Steel Drums": Bellek(115, 2) = 115
Bellek(116, 1) = "116 Woodblock": Bellek(116, 2) = 116
Bellek(117, 1) = "117 Taiko Drum": Bellek(117, 2) = 117
Bellek(118, 1) = "118 Melodic Tom": Bellek(118, 2) = 118
Bellek(119, 1) = "119 Synth Drum": Bellek(119, 2) = 119
Bellek(120, 1) = "120 Reverse Cymbal": Bellek(120, 2) = 120
Bellek(121, 1) = "121 Guitar Fret Noise": Bellek(121, 2) = 121
Bellek(122, 1) = "122 Breath Noise": Bellek(122, 2) = 122
Bellek(123, 1) = "123 Seashore": Bellek(123, 2) = 123
Bellek(124, 1) = "124 Bird Tweet": Bellek(124, 2) = 124
Bellek(125, 1) = "125 Telephone Ring": Bellek(125, 2) = 125
Bellek(126, 1) = "126 Helicopter": Bellek(126, 2) = 126
Bellek(127, 1) = "127 Applause": Bellek(127, 2) = 127
Bellek(128, 1) = "128 Gunshot": Bellek(128, 2) = 128
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç()
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul