|
51
|
Programación / Programación Visual Basic / Re: Ejecutar un archivo seleccionado desde resource
|
en: 16 Junio 2016, 17:09 pm
|
Hola Deberías especificar si lo quieres para VB6 o VB.NET En VB6 puedes usar esta función para extraer el archivo: Public Function CrearArchivoBinario(strPath As String, strNameFile As String, idRes As Variant, TypeRes As String) On Error GoTo EvitarError Dim Path As String Dim numFile As Integer Dim aDatos() As Byte numFile = FreeFile Path = strPath & "\" & strNameFile ' lee los datos en el array de bytes aDatos = LoadResData(idRes, TypeRes) ' abre un archivo para escribir los datos en modo binario Open Path For Binary Access Write As #numFile ' escribe el array de bytes para Put #numFile, , aDatos ' cierra el fichero Close 'MsgBox "Datos guardados con éxito", vbInformation, "Información" EvitarError: If Err.Number <> vbNull Then MsgBox Err.Description, vbCritical, "Error" End If End Function
Y la forma de usarlo es esta: CrearArchivoBinario DIRECTORIO, "ARCHIVO", ID, "TIPO" Ejemplo: CrearArchivoBinario "C:\MyBinFile", "Aplicación.exe", 101, "CUSTOM" NOTA: El directorio debe existir. Esta función no crea directorios. Por ejemplo si pones "C:\MyBinFile" y la carpeta "MyBinFile" no existe se produce un error. Para ejecutarlo puedes usar Shell()s2s
|
|
|
52
|
Programación / .NET (C#, VB.NET, ASP) / Re: Terminar evento MouseDown con el botón del ratón pulsado
|
en: 16 Junio 2016, 02:34 am
|
Hola Lekim.
Si me equivoco en mis suposiciones, corrígeme, pero según leo en ese comentario das a entender que lo que realmente quieres hacer (ahora) es conseguir que se dispare el evento MouseDown en un control mientras mantienes presionado el botón izquierdo del mouse sobre el Form y arrastras el puntero hasta ese control. ¿es así?.
No no es eso Elektro, pero parece que lo que has puesto puede servir, me lo voy a mirar.
Pero bueno que ya está hecho y tampoco es tanto código. - Es código administrado - He reducido el código considerablemente - No tiene errores - Es puro Net - 100% cosecha propia ¿Cuál es la queja? XD Lo que has puesto es a la inversa en un principio quería enviar el mensaje WM_LBUTTONUP y Down desde un evento. Usé Mouse_Event para hacerlo, aunque ahora veo por lo que as posteado que también podía haber usado SendMessage. Pero era un parche por no poder capturar el índice del label en el cual estaba posado el cursor con el botón del Mouse apretado al arrastrarlo por los labels. Si reproduces el útlimo código que he posteado lo verás. Y si has usado mi piano pues es el efecto de arrastrar el dedo por las teclas. Apretas y arrastras, suena cada nota por la que va pasando el dedo, a la vez que se apagan por las que ya a pasado y a la vez que se cambia el color de la tacla en la que se encuentra el dedo (el puntero), se pone la tecla de nuevo blanca la que ya no tiene el dedo (el puntero) y todo sin soltar. Facilísimo!!!
|
|
|
53
|
Programación / .NET (C#, VB.NET, ASP) / Re: Terminar evento MouseDown con el botón del ratón pulsado
|
en: 16 Junio 2016, 01:13 am
|
Hola Bueno, pues ya lo he hecho y sin código no administrado. Ahora saldrá el listo que dirá, pero si es muy fácil no hace falta hacer tanta historia... Cuando he preguntado y nadie me resolvía la papeleta. Incluso en otro foro (en inglés) un usuario me ha puesto de los nervios porque no hacía más que decirme que era muy fácil, que usara MouseEnter, MouseLeave. Yo le dije que estos eventos no fucionan cuando arrastras el puntero con el bóton del ratón presionado, que no devuelven el índice del control donde se encuentra el puntero. De nuevo me contesta - ten encuenta el OOP, bla, bla, bla...-, jolines si es tan fácil teclea un poco y lo pones maldito hijo de la gran.... Igual se penseava que es sólo el clic. Pero si es que hasta le puse imágenes de demostración. Total que está hecho. No fuerzo la cancelación del evento, como hacía con Mouse_Event que era una alternativa para hacer lo que quería. Lo he hecho usando lógica matemática, mediante un algoritmo obtengo el índice del Label en el que se encuentra el cursor, estando el botón pulsado y arrastrandose a través del array de Labels. Que repito, cuando haces esto los eventos se estancan en el primer label donde se ha hecho MouseDown y no devuelven una porra. Como demuestra este gif animado El algoritmo: -[(-Index)-int(X/20)] Donde: Index= Indice actual (que no cambia hasta que no se colorea un nuevo label, por eso se obtiene en el evento Paint) X = Posición X del cursor dentro del formulario 20 = Ancho del Label. Option Strict On Imports System.Runtime.InteropServices Public Class Form1 Dim lblkey(5) As Label Dim index As Integer Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim locLBL As New Point(10, 10) Dim inc As Integer For I As Integer = 0 To 5 lblkey(I) = New Label lblkey(I).Size = CType(New Point(20, 100), Drawing.Size) lblkey(I).BorderStyle = BorderStyle.FixedSingle lblkey(I).Location = New Point(locLBL.X + inc, locLBL.Y) Me.Controls.Add(lblkey(I)) inc += 19 Next For I As Integer = 0 To 5 AddHandler lblkey(I).MouseDown, AddressOf lblkey_MouseDown AddHandler lblkey(I).MouseUp, AddressOf lblkey_MouseUp AddHandler lblkey(I).MouseMove, AddressOf lblkey_MouseMove AddHandler lblkey(I).Paint, AddressOf lblkey_Paint Next End Sub Private Sub lblkey_Paint(ByVal sender As Object, ByVal e As System.EventArgs) index = Array.IndexOf(lblkey, sender) End Sub Private Sub lblkey_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim lblPoint As New _ Point(lblkey(index).PointToClient(Cursor.Position).X, _ lblkey(index).PointToClient(Cursor.Position).Y) If e.Button = System.Windows.Forms.MouseButtons.Left Then Dim newIndex As Double = - ((- index) - Conversion.Int(lblPoint.X / 20)) Try Dim AllIndexs As New List(Of Integer)({0, 1, 2, 3, 4, 5}) AllIndexs.Remove(CInt(newIndex)) For Each El As Integer In AllIndexs lblkey(El).BackColor = Color.Transparent Next lblkey(CInt(newIndex)).BackColor = Color.Red Catch ex As Exception End Try End If End Sub Private Sub lblkey_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim indexDwn As Integer = Array.IndexOf(lblkey, sender) lblkey(indexDwn).BackColor = Color.Red End Sub Private Sub lblkey_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) For I As Integer = 0 To lblkey.Count - 1 lblkey(I).BackColor = Color.Transparent Next End Sub End Class
lo que hay en Form_Load es para crear los Labels, configurarlos, y los eventos . S2s Había una errata en Mouse_Down, ya está corregida (Al hacer clic se activaba el siguiente) Acabo de darme cuenta que el algoritmo funciona incluso aunque pongas 0 o 1 en lugar del máximo índice (N), de hecho se puede eliminar N. Ya lo he quitado. Dim newIndex As Double = N - ((N -index) - Conversion.Int(lblPoint.X / 20))
Mejor así: Dim newIndex As Double = - ((-index) - Conversion.Int(lblPoint.X / 20))
También se podría poner así: Dim newIndex As Double = ((index * (-1)) - Conversion.Int(lblPoint.X / 20)) * (-1)
|
|
|
54
|
Programación / .NET (C#, VB.NET, ASP) / Re: Disfruta tocando el Piano con este programa
|
en: 14 Junio 2016, 23:57 pm
|
Hola Gracias por los consejos, muy buenos. La verdad es que esas cosas me hace falta saberlas, para que el código sea profesional, ya que yo he aprendido de forma autodidacta y lo pongo todo de cualquier manera aunque he mejorado. Además que el 80% de lo que se lo he aprendido aquí y con la MSDN, porque no he cogido un libro de NET en la vida. Si en su día de VB6 y algunos aún los conservo. En el primer código cometiste una errata sin importancia, pero todo hay que mencionarlo, tienes declarado un método que se llama "ConstruyeTeclado",
Bueno, yo quería ponerlo todo en inglés, pero eso se me pasó y encima con errata. Ya lo he corregido. La idea es mostrar una forma de crear sonidos sin necesidad de incrustar archivos de sonido a nuestro programa y que no fuera tampoco el típico Beep, que se escucha a través del altavoz interno. Por cierto que curiosamente creo que de todos los sonidos no está el sonido "pulse" que creo que es así como se llama a sonido que produce el Beep. S2s
6. No uses el keyword Call, ¡jamás!. No necesitas hacerlo, tampoco se recomiendo hacerlo, y aparte, está mal visto hacerlo, ya que es sinónimo de un acercamiento a las costumbres de VB6. Corregido
Creo que he corregido más o menos todo. Gracias de nuevo. Lo del mouse_event estoy en ello, casi está, pero me voy a dormir
|
|
|
55
|
Programación / .NET (C#, VB.NET, ASP) / Re: Quitar enfoque al salir de un objeto y en MouseDown
|
en: 14 Junio 2016, 10:01 am
|
Me hubiera gustado también hacerlo sin "código no manejado", realmente llevo varios días ocupado y no he tenido tiempo de intentarlo! Parece que @Eleкtro también ha estado ocupado, de seguro hubiéramos visto una respuesta de el.
En cuanto tenga un chance voy a probar!
Salu2s
Gracias De seguro que @Eleкtro sabría hacerlo, y lo que hiciera no se si lo entendería pero mientras funcioné chapó. He estado probando con System.Windows.Forms.MouseEventArgs y Sender, creo que por ahí van los tiros pero sin éxito. Lo que quiero hacer no es algo que la gente demande y se encuentre buscando en google. Hay que tirar de ingenio. s2s
|
|
|
56
|
Programación / .NET (C#, VB.NET, ASP) / Código para reproducir notas musicales mediante midiOutShortMsg
|
en: 14 Junio 2016, 00:12 am
|
Hola Quiero compartir este programa que he desarrollado. Se trata de un teclado musical, un piano que utiliza el parche Standard MIDI Patch Assignments del MIDI Manufacturers Association (MMA) con 128 sonidos de instrumentos diferentes. Standard MIDI Patch AssignmentsPermite tanto tocar con el ratón como con el teclado del ordenador. Puedes descargarte el código aquí: Musical_Keyboard.zip*Elige el botón de la derecha, el que pone 'Descargar con el navegador'
Si lo prefieres puedes hacer simplemente un copia y pega en un nuevo proyecto 'Aplicación de Windows Form' No necesitas crear controles, tan solo deja todo en blanco en el editor de código de Form1.vb, y pegas este código: '////////////////////////////// '// Date: 13/06/2016 // '// Programmed by LEKIM // '////////////////////////////// Option Strict On Imports System.Runtime.InteropServices Imports System.Text Imports System.Security Public Class Form1 Dim lblMuscKey(61) As Label Dim lblInstruments(127) As Label Dim lblOctave(5) As Label Dim FlLayPanel As FlowLayoutPanel Dim lblTitle As New Label Dim ttip As New ToolTip Dim numKeysBlack() As Integer = _ {2, 4, 7, 9, 11, 14, 16, 19, 21, 23, 26, 28, 31, _ 33, 35, 38, 40, 43, 45, 47, 50, 52, 55, 57, 59} Dim numKeysWhite() As Integer = _ {1, 3, 5, 6, 8, 10, 12, 13, 15, 17, 18, 20, 22, _ 24, 25, 27, 29, 30, 32, 34, 36, 37, 39, 41, 42, _ 44, 46, 48, 49, 51, 53, 54, 56, 58, 60, 61} Dim hMidiOut As IntPtr Dim intMsg As Integer Dim Msg As NativeMethods.MidiMsg Dim Octave As Byte = 1 'Octave from where begins the first key of the musical keyboard Dim ListKeyPress As New List(Of Integer) Dim VolumeKey As Byte = 127 'min=0; max=127 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load CreateMusicalKeyBoard() CreatePanelInstruments() CreateOctaveButtons() With lblTitle .Text = "Standard MIDI Patch Assignments" .BackColor = Color.Transparent .ForeColor = Color.WhiteSmoke .Font = New Font("Arial", 20, FontStyle.Bold) .TextAlign = ContentAlignment.MiddleLeft .Size = CType(New Point(470, 40), Drawing.Size) .Location = New Point(5, 5) End With With Me .Controls.Add(lblTitle) .KeyPreview = True .BackColor = System.Drawing.Color.FromArgb(40, 40, 40) .Size = CType(New Point(835, 440), Drawing.Size) .Text = "Demo Musical Keyboard" .MaximizeBox = False .FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle .StartPosition = FormStartPosition.CenterScreen .SetBounds(CInt((Screen.PrimaryScreen.Bounds.Width - .Width) / 2), CInt((Screen.PrimaryScreen.Bounds.Height - .Height) / 2) - 50, .Width, .Height) End With 'Show a tooltip message ttip.AutoPopDelay = 2000 ttip.InitialDelay = 1000 ttip.ReshowDelay = 500 For I As Integer = 1 To 5 ttip.SetToolTip(Me.lblOctave(I), "Octave") Next NativeMethods.midiOutOpen(hMidiOut, _ NativeMethods.MIDI_MAPPER, CType(0, IntPtr), _ CType(0, IntPtr), NativeMethods.CALLBACK_NULL) End Sub Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown If ListKeyPress.Contains(e.KeyCode) = True Then Exit Sub ' Key is already pressed If Key(e.KeyCode) = 0 Then Exit Sub PlayMusicalNote(CByte(Key(e.KeyCode)), VolumeKey, Octave) ListKeyPress.Add(e.KeyCode) End Sub Private Sub Form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyUp OffMusicalNote(CByte(Key(e.KeyCode)), Octave) ListKeyPress.Remove(e.KeyCode) Try If numKeysWhite.Contains(Msg.Note) Then lblMuscKey(Msg.Note).BackColor = Color.White Else lblMuscKey(Msg.Note).BackColor = Color.Black End If Catch ex As Exception End Try End Sub #Region "Octave Buttons" Sub CreateOctaveButtons() Dim pOct As New Point(30, 265) Dim inc As Integer = 0 For I = 1 To 5 lblOctave(I) = New Label With lblOctave(I) .Text = CStr(I) .Font = New Font("Arial", 10, FontStyle.Bold) .Size = CType(New Point(20, 20), Drawing.Size) .BorderStyle = BorderStyle.FixedSingle .Location = New Point(pOct.X + inc, pOct.Y) .ForeColor = System.Drawing.Color.FromArgb(120, 120, 120) .BackColor = System.Drawing.Color.FromArgb(20, 20, 20) .TextAlign = ContentAlignment.MiddleCenter AddHandler .MouseDown, AddressOf lblOctave_MouseDown AddHandler .MouseEnter, AddressOf lblOctave_MouseEnter AddHandler .MouseLeave, AddressOf lblOctave_MouseLeave End With inc = inc + 19 Me.Controls.Add(lblOctave(I)) Next lblOctave(1).BackColor = System.Drawing.Color.FromArgb(150, 150, 150) lblOctave(1).ForeColor = System.Drawing.Color.FromArgb(10, 10, 10) End Sub Private Sub lblOctave_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim Index As Integer = Array.IndexOf(lblOctave, sender) For I As Integer = 1 To 5 lblOctave(I).BackColor = System.Drawing.Color.FromArgb(20, 20, 20) lblOctave(I).ForeColor = System.Drawing.Color.FromArgb(120, 120, 120) Next lblOctave(Index).BackColor = System.Drawing.Color.FromArgb(150, 150, 150) lblOctave(Index).ForeColor = System.Drawing.Color.FromArgb(10, 10, 10) Octave = CByte(Index) End Sub Private Sub lblOctave_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Dim Index As Integer = Array.IndexOf(lblOctave, sender) Cursor = Cursors.Hand End Sub Private Sub lblOctave_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Dim Index As Integer = Array.IndexOf(lblOctave, sender) Cursor = Cursors.Default End Sub #End Region #Region "Panel of Instruments" ''' <summary> ''' Create a panel of instruments ''' </summary> ''' <remarks></remarks> Public Sub CreatePanelInstruments() FlLayPanel = New FlowLayoutPanel With FlLayPanel .AutoScroll = True .VerticalScroll.Visible = False .BorderStyle = BorderStyle.FixedSingle .Size = CType(New Point(808, 205), Drawing.Size) .Location = New Point(5, 50) .FlowDirection = FlowDirection.TopDown .BackColor = System.Drawing.Color.FromArgb(10, 10, 10) End With Me.Controls.Add(FlLayPanel) For I As Integer = 0 To lblInstruments.Count - 1 lblInstruments(I) = New Label With lblInstruments(I) .Width = 155 .Font = New Font("Arial", 8, FontStyle.Bold) .ForeColor = System.Drawing.Color.FromArgb(120, 120, 120) .BorderStyle = BorderStyle.FixedSingle .TextAlign = ContentAlignment.MiddleLeft End With FlLayPanel.Controls.Add(lblInstruments(I)) Next (I) 'Standard MIDI Patch Assignments Dim strInstruments() As String = _ {"000 Acoustic grand piano", "001 Bright acoustic piano", "002 Electric grand piano", "003 Honky-tonk piano", "004 Rhodes(piano)", "005 Chorused(piano)", "006 Harpsichord", "007 Clavinet", "008 Celesta", "009 Glockenspiel", "010 Music(box)", "011 Vibraphone", "012 Marimba", "013 Xylophone", "014 Tubular(bells)", "015 Dulcimer", "016 Hammond(organ)", "017 Percussive(organ)", "018 Rock(organ)", "019 Church(organ)", "020 Reed(organ)", "021 Accordion", "022 Harmonica", "023 Tango(accordion)", "024 Acoustic guitar (nylon)", "025 Acoustic(guitar(steel))", "026 Electric(guitar(jazz))", "027 Electric(guitar(clean))", "028 Electric(guitar(muted))", "029 Overdriven(guitar)", "030 Distortion(guitar)", "031 Guitar(harmonics)", "032 Acoustic bass", "033 Electric bass (finger)", "034 Electric bass (pick)", "035 Fretless bass", "036 Slap bass 1", "037 Slap bass 2", "038 Synth bass 1", "039 Synth bass 2", "040 Violin", "041 Viola", "042 Cello", "043 Contrabass", "044 Tremolo strings", "045 Pizzicato strings", "046 Orchestral harp", "047 Timpani", "048 String ensemble 1", "049 String ensemble 2", "050 Synth.strings(1)", "051 Synth.strings(2)", "052 Choir(Aahs)", "053 Voice(Oohs)", "054 Synth(voice)", "055 Orchestra(hit)", "056 Trumpet", "057 Trombone", "058 Tuba", "059 Muted(trumpet)", "060 French(horn)", "061 Brass(section)", "062 Synth.brass(1)", "063 Synth.brass(2)", "064 Soprano sax", "065 Alto sax", "066 Tenor sax", "067 Baritone sax", "068 Oboe", "069 English horn", "070 Bassoon", "071 Clarinet", "072 Piccolo", "073 Flute", "074 Recorder", "075 Pan flute", "076 Bottle blow", "077 Shakuhachi", "078 Whistle", "079 Ocarina", "080 Lead 1 (square)", "081 Lead 2 (sawtooth)", "082 Lead 3 (calliope lead)", "083 Lead 4 (chiff lead)", "084 Lead 5 (charang)", "085 Lead 6 (voice)", "086 Lead 7 (fifths)", "087 Lead 8 (brass + lead)", "088 Pad 1 (new age)", "089 Pad 2 (warm)", "090 Pad 3 (polysynth)", "091 Pad 4 (choir)", "092 Pad 5 (bowed)", "093 Pad 6 (metallic)", "094 Pad 7 (halo)", "095 Pad 8 (sweep)", "096 FX 1 (rain)", "097 FX 2 (soundtrack)", "098 FX 3 (crystal)", "099 FX 4 (atmosphere)", "100 FX 5 (brightness)", "101 FX 6 (goblins)", "102 FX 7 (echoes)", "103 FX 8 (sci-fi)", "104 Sitar", "105 Banjo", "106 Shamisen", "107 Koto", "108 Kalimba", "119 Bagpipe", "110 Fiddle", "111 Shanai2", "112 Tinkle Bell", "113 Agogo", "114 Steel Drums", "115 Woodblock", "116 Taiko Drum", "117 Melodic Tom", "118 Synth Drum2", "119 Reverse Cymbal", "120 Guitar fret noise", "121 Breath noise", "122 Seashore", "123 Bird tweet", "124 Telephone ring", "125 Helicopter", "126 Applause", "127 Gunshot"} For I = 0 To 127 lblInstruments(I).Text = strInstruments(I) Next For I As Integer = 0 To lblInstruments.Count - 1 AddHandler lblInstruments(I).MouseDown, AddressOf lblInstruments_MouseDown Next End Sub Private Sub lblInstruments_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim Index As Integer = Array.IndexOf(lblInstruments, sender) For I = 0 To lblInstruments.Count - 1 lblInstruments(I).BackColor = Color.Transparent lblInstruments(I).ForeColor = System.Drawing.Color.FromArgb(120, 120, 120) Next lblInstruments(Index).BackColor = System.Drawing.Color.FromArgb(150, 150, 150) lblInstruments(Index).ForeColor = System.Drawing.Color.FromArgb(0, 0, 0) ChangeInstrument(Index) End Sub #End Region #Region "Musical Keyboard" ''' <summary> ''' Create the keys of the musical keyboard ''' </summary> ''' <remarks></remarks> Sub CreateMusicalKeyBoard() Dim wKeyWhite As New Point(22, 80) Dim wKeyBlack As New Point(12, 50) Dim PosKeyWhite As New Point(30, 300) Dim PosKeyBlack As New Point(25, 300) For Index As Integer = 1 To lblMuscKey.Count - 1 lblMuscKey(Index) = New Label With lblMuscKey(Index) .BorderStyle = BorderStyle.FixedSingle Dim incWhiteKeyPosX As Integer 'White keys If numKeysWhite.Contains(Index) Then .Size = New Size(wKeyWhite) .BackColor = Color.White .Location = _ New Point(PosKeyWhite.X + incWhiteKeyPosX, PosKeyWhite.Y) incWhiteKeyPosX = incWhiteKeyPosX + 21 .SendToBack() 'send to back End If 'Black keys If numKeysBlack.Contains(Index) Then .BackColor = Color.Black .Size = New Size(wKeyBlack) .Location = _ New Point(PosKeyBlack.X + incWhiteKeyPosX, PosKeyBlack.Y) End If Me.Controls.Add(lblMuscKey(Index)) If numKeysBlack.Contains(Index) Then lblMuscKey(Index).BringToFront() End If AddHandler .MouseDown, AddressOf lblMuscKey_MouseDown AddHandler .MouseUp, AddressOf lblMuscKey_MouseUp AddHandler .MouseMove, AddressOf lblMuscKey_MouseMove AddHandler .MouseLeave, AddressOf lblMuscKey_MouseLeave End With Next End Sub Private Sub lblMuscKey_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim Index As Integer = Array.IndexOf(lblMuscKey, sender) lblMuscKey(Index).BackColor = Color.Gray 'Change color of the key PlayMusicalNote(CByte(Index), VolumeKey, Octave) End Sub Private Sub lblMuscKey_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim Index As Integer = Array.IndexOf(lblMuscKey, sender) If numKeysWhite.Contains(Index) Then lblMuscKey(Index).BackColor = Color.White 'Change color of the key Else lblMuscKey(Index).BackColor = Color.Black 'Change color of the key End If OffMusicalNote(Index, Octave) End Sub Private Sub lblMuscKey_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Dim Index As Integer = Array.IndexOf(lblMuscKey, sender) Dim mPoint As New Point(Me.PointToClient(Cursor.Position).X, Me.PointToClient(Cursor.Position).Y) Dim X As Integer = mPoint.X Cursor = Cursors.Hand If X < CInt(lblMuscKey(Index).Left) Or X > (CInt(lblMuscKey(Index).Left) + _ CInt(lblMuscKey(Index).Width)) Then EventoUp() EventoDown() End If End Sub Private Sub lblMuscKey_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Cursor = Cursors.Default End Sub #End Region #Region "Play Sounds Functions" ''' <summary> ''' Play a musical note ''' </summary> ''' <param name="Note">Value of musical note</param> ''' <param name="Volume">Volume musical note</param> ''' <param name="bOct">Octave</param> ''' <returns></returns> Public Function PlayMusicalNote(ByVal Note As Integer, ByVal Volume As Byte, ByVal bOct As Byte) As Boolean Note += 23 + (12 * bOct) intMsg = CInt(Volume * Convert.ToInt32(CStr(10000), 16) _ + Note * Convert.ToInt32(CStr(100), 16) + NativeMethods.KeyOn) Return CBool(NativeMethods.midiOutShortMsg(hMidiOut, intMsg)) End Function ''' <summary> ''' Off a musical note ''' </summary> ''' <param name="Note">Value of musical note</param> ''' <param name="bOct">Octave</param> ''' <returns></returns> ''' <remarks></remarks> Public Function OffMusicalNote(ByVal Note As Integer, ByVal bOct As Integer) As Boolean Note += 23 + (12 * bOct) intMsg = Note * Convert.ToInt32(CStr(100), 16) + NativeMethods.KeyOff Return CBool(NativeMethods.midiOutShortMsg(hMidiOut, intMsg)) End Function ''' <summary> ''' Change the instrument ''' </summary> ''' <param name="instCode"></param> ''' <returns></returns> ''' <remarks></remarks> Public Function ChangeInstrument(ByVal instCode As Integer) As Boolean intMsg = instCode * Convert.ToInt32(CStr(100), 16) + NativeMethods.Instruments Return CBool(NativeMethods.midiOutShortMsg(hMidiOut, intMsg)) Return Nothing End Function #End Region #Region "Computer keyboard keys" ''' <summary> ''' Assigning Computer keyboard keys ''' </summary> ''' <param name="keycode"></param> ''' <returns></returns> ''' <remarks></remarks> Public Function Key(ByVal keycode As Integer) As Integer Dim BlackHalfKey() As Keys = {Keys.W, Keys.E, Keys.T, Keys.Y, Keys.U} Dim WhiteHalfKey() As Keys = {Keys.A, Keys.S, Keys.D, Keys.F, Keys.G, Keys.H, Keys.J, Keys.K} Dim BassKey() As Keys = {Keys.Z, Keys.X, Keys.C, Keys.V, Keys.B, Keys.N, Keys.M, Keys.Oemcomma} Dim AltoKey() As Keys = {Keys.D1, Keys.D2, Keys.D3, Keys.D4, Keys.D5, Keys.D6, Keys.D7, Keys.D8} If BlackHalfKey.Contains(CType(keycode, Keys)) Or _ WhiteHalfKey.Contains(CType(keycode, Keys)) Or _ BassKey.Contains(CType(keycode, Keys)) Or _ AltoKey.Contains(CType(keycode, Keys)) Then For I As Integer = 10 To 14 If keycode = BlackHalfKey(I - 10) Then Msg.Note = CByte(numKeysBlack(I)) Next For I As Integer = 14 To 21 If keycode = WhiteHalfKey(I - 14) Then Msg.Note = CByte(numKeysWhite(I)) Next For I As Integer = 0 To 7 If keycode = BassKey(I) Then Msg.Note = CByte(numKeysWhite(I)) Next For I As Integer = 28 To 35 If keycode = AltoKey(I - 28) Then Msg.Note = CByte(numKeysWhite(I)) Next lblMuscKey(Msg.Note).BackColor = Color.Gray Return Msg.Note Else Return 0 End If End Function #End Region End Class Module MouseEvents ''' <summary> ''' Simulate MouseDown the left mouse button ''' </summary> ''' <remarks></remarks> Public Sub EventoDown() NativeMethods.mouse_event(NativeMethods.MouseEventFlags.MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) End Sub ''' <summary> ''' Simulate MouseUp the left mouse button ''' </summary> ''' <remarks></remarks> Public Sub EventoUp() NativeMethods.mouse_event(NativeMethods.MouseEventFlags.MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0) End Sub End Module <SuppressUnmanagedCodeSecurity()> Friend NotInheritable Class NativeMethods Inherits Attribute Private Sub New() End Sub #Region "API MIDI message" <DllImport("winmm.dll")> Public Shared Function midiOutOpen(ByRef lphMidiOut As IntPtr, ByVal uDeviceID As Integer, ByVal dwCallback As IntPtr, ByVal dwInstance As IntPtr, ByVal dwFlags As UInteger) As UInteger End Function <DllImport("winmm.dll")> Public Shared Function midiOutShortMsg(ByVal hMidiOut As IntPtr, ByVal dwMsg As Integer) As UInteger End Function <DllImport("winmm.dll")> Public Shared Function midiOutClose(ByVal hMidiOut As IntPtr) As Integer End Function <StructLayout(LayoutKind.Auto)> _ Public Structure MidiMsg Dim status As Byte Dim Note As Byte Dim Volume As Byte Dim Data3 As Byte End Structure Public Const MIDI_MAPPER As Int32 = -1 Public Const CALLBACK_NULL = &H0 Public Const KeyOn As Integer = &H90 Public Const KeyOff As Integer = &H80 Public Const Instruments As Integer = &HC0 #End Region #Region "API Mouse Events" <DllImport("user32.dll", CharSet:=CharSet.Auto)> _ Friend Shared Sub mouse_event(ByVal dwFlags As UInteger, _ ByVal dx As UInteger, _ ByVal dy As UInteger, _ ByVal dwData As UInteger, _ ByVal dwExtraInfo As Integer) End Sub <Flags()> _ Public Enum MouseEventFlags As UInteger MOUSEEVENTF_ABSOLUTE = &H8000 MOUSEEVENTF_LEFTDOWN = &H2 MOUSEEVENTF_LEFTUP = &H4 MOUSEEVENTF_MIDDLEDOWN = &H20 MOUSEEVENTF_MIDDLEUP = &H40 MOUSEEVENTF_MOVE = &H1 MOUSEEVENTF_RIGHTDOWN = &H8 MOUSEEVENTF_RIGHTUP = &H10 MOUSEEVENTF_XDOWN = &H80 MOUSEEVENTF_XUP = &H100 MOUSEEVENTF_WHEEL = &H800 MOUSEEVENTF_HWHEEL = &H1000 End Enum #End Region End Class
CÓDIGO BÁSICO PARA REPRODUCIR SONIDOS MIDICrea un Button, y pegas esto. Al pulsar el botón se escucha un sonido C2 (Do 2ª escala), que su valor es 47. Option Strict On Imports System.Runtime.InteropServices Imports System.Security Public Class Form1 Dim hMidiOut As IntPtr Dim intMsg As Integer Dim msg As New NativeMethods.MidiMsg Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed 'Cierra los mensajes midi NativeMethods.midiOutClose(hMidiOut) End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'Abre los mensajes midi NativeMethods.midiOutOpen(hMidiOut, NativeMethods.MIDI_MAPPER, CType(0, IntPtr), CType(0, IntPtr), NativeMethods.CALLBACK_NULL) 'Cambiar instrumento Dim MyInstr As Integer = 1 'min:0 (piano) ; max:127 (Gunshot) intMsg = MyInstr * Convert.ToInt32(CStr(100), 16) + NativeMethods.Instruments NativeMethods.midiOutShortMsg(hMidiOut, intMsg) End Sub Private Sub Button1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseDown 'Reproduce un sonido los mensajes midi msg.status = NativeMethods.KeyOn msg.Volume = 127 msg.Note = 47 '<---Sonido intMsg = msg.Volume * Convert.ToInt32(CStr(10000), 16) + _ msg.Note * Convert.ToInt32(CStr(100), 16) + _ msg.status NativeMethods.midiOutShortMsg(hMidiOut, intMsg) End Sub Private Sub Button1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button1.MouseUp 'Apaga el sonido al soltar el botón '**El sonido debe ser el mismo que el que se quiere apagar msg.status = NativeMethods.KeyOff msg.Volume = 0 msg.Data3 = 0 msg.Note = 47 '<---Sonido intMsg = msg.Volume * Convert.ToInt32(CStr(10000), 16) _ + msg.Note * Convert.ToInt32(CStr(100), 16) + _ msg.status NativeMethods.midiOutShortMsg(hMidiOut, intMsg) End Sub End Class <SuppressUnmanagedCodeSecurity()> Friend NotInheritable Class NativeMethods Inherits Attribute Private Sub New() End Sub #Region "API MIDI message" <DllImport("winmm.dll")> Public Shared Function midiOutOpen(ByRef lphMidiOut As IntPtr, ByVal uDeviceID As Integer, ByVal dwCallback As IntPtr, ByVal dwInstance As IntPtr, ByVal dwFlags As UInteger) As UInteger End Function <DllImport("winmm.dll")> Public Shared Function midiOutShortMsg(ByVal hMidiOut As IntPtr, ByVal dwMsg As Integer) As UInteger End Function <DllImport("winmm.dll")> Public Shared Function midiOutClose(ByVal hMidiOut As IntPtr) As Integer End Function <StructLayout(LayoutKind.Auto)> _ Public Structure MidiMsg Dim status As Byte Dim Note As Byte Dim Volume As Byte Dim Data3 As Byte End Structure Public Const MIDI_MAPPER As Int32 = -1 Public Const CALLBACK_NULL = &H0 Public Const KeyOn As Integer = &H90 Public Const KeyOff As Integer = &H80 Public Const Instruments As Integer = &HC0 #End Region End Class
Espero que disfrutéis del programa. No soy un programador experto así que supongo que los más avispados veréis cosas corregibles. Me he visto obligado a usar APIs. He estado buscando la forma de no tener que usarlo y usar puro código .NET, pero no lo he conseguido. A no ser que use mi propia biblioteca MIDI de sonidos. [ DESLIZANDO EL CURSOR]He preguntado en varios sitios incluido aquí como crear el efecto de arrastrar el dedo por las teclas de un piano usando el puntero del ratón y con puro código NET. Pero no he tenido éxito, por ahora. Como alternativa, de nuevo me he visto obligado a usar llamada API. La razón es que cuando pulsas una tecla del piano y mantienes pulsado el botón izquierdo al pasar a otra tecla se mantiene el evento de la tecla inicial ignorando por completo el hecho de que el puntero se haya en una nueva tecla. Con la imposibilidad de usar MouseEnter, ya que el que trabaja es el evento MouseEnter de la primera tecla. Usando Mouse_Event emulo la acción de soltar el botón, aunque en realidad aun lo tenga pulsado justo al entrar en la otra tecla. De nuevo emulo el evento de pulsar y la nueva tecla captura el evento. Es fácil conseguirlo con elementos que no forma parte de una matriz, pero se complica al usar un array de controles. Por esta razón he tenido que usar Mouse_Event. S2s
|
|
|
58
|
Seguridad Informática / Seguridad / Re: Hackear de forma remota un ordenador sin Internet es posible
|
en: 13 Junio 2016, 11:57 am
|
Estoy comprobandolo mientras escribo y no oigo nada, la verdad que oigo el ruido de cuando tecleo las teclas pero por los auriculares no se oye nada.
Ya me imagino a todo el mundo que entre aquí haciendo lo mismo. No en serio, tenía que enchufar la cadena en otro sitio para no escuchar los ruiditos tipo fax que producía el ordenador, claro que fue hace bastante tiempo el ordenador era más viejo, de esos con el disco duro ata, de los primeros que hacia unos ruiditos cuando trabajaba, y se podía oír el sonido 'fax' en los auriculares. Lo he probado ahora con el portatil y el PC y tampoco escucho nada
|
|
|
59
|
Programación / .NET (C#, VB.NET, ASP) / Re: Calcular media Aritmética, Geométrica, Armónica.
|
en: 12 Junio 2016, 20:46 pm
|
hola para poner esto: n ^ √ en código vb.net es así: n ^ Math.Sqrt(x)
Por ejemplo esto : 25 ^ √12Se podría así: 25 ^ Math.Sqrt(12)
y devuelve esto: 69599,5195898361
Espero sirva.. Creo que está todo bien, si eso comentais y corrijo. Option Strict On Public Class Form1 Dim lstValorMedAritmetica As New List(Of Double) 'Variable para los valores de la media aritmética Dim indice As Integer Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim myFont As New Font("Arial", 10, FontStyle.Bold) RadioButton1.Checked = True RadioButton1.Text = "Media Aritmética" RadioButton2.Text = "Media Armónica" RadioButton3.Text = "Media Geométrica" RadioButton4.Text = "Moda" RadioButton5.Text = "Mediana " RadioButton1.Font = myFont RadioButton2.Font = myFont RadioButton3.Font = myFont RadioButton4.Font = myFont RadioButton5.Font = myFont Me.Text = "Medidas de centralizaciónl" Me.MaximizeBox = False btAgregar.Text = "<< Agregar" btCalcMed.Text = "Calcular" txtValue.TextAlign = HorizontalAlignment.Right End Sub Private Sub btAgregar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btAgregar.Click Try 'Si no hay nada en la lista borra el listbox y el resultado anterior If lstValorMedAritmetica.Count = 0 Then ListBox1.Items.Clear() txtResultMedArit.Text = "" End If 'Añade un valor a la lista lstValorMedAritmetica.Add(CDbl(txtValue.Text)) 'Añade un valor a listbox ListBox1.Items.Add(txtValue.Text) btCalcMed.Enabled = True Catch ex As Exception MessageBox.Show("Valor no válido", _ "Atención", _ MessageBoxButtons.OK, _ MessageBoxIcon.Exclamation) End Try End Sub Private Sub btCalcMed_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btCalcMed.Click 'Calcula la media aritmética If RadioButton1.Checked = True Then txtResultMedArit.Text = CStr(modEstadisticFunctions.MediaAritmetica(lstValorMedAritmetica).ToString("0.00")) End If 'Calcula la media armónica If RadioButton2.Checked = True Then txtResultMedArit.Text = CStr(modEstadisticFunctions.MediaArmonica(lstValorMedAritmetica).ToString("0.00")) End If 'Calcula Media Geométrica If RadioButton3.Checked = True Then txtResultMedArit.Text = CStr(modEstadisticFunctions.MediaGeometrica(lstValorMedAritmetica).ToString("0.00")) End If 'Calcula moda If RadioButton4.Checked = True Then txtResultMedArit.Text = CStr( modEstadisticFunctions.Moda(lstValorMedAritmetica)) End If 'Calcula mediana If RadioButton5.Checked = True Then txtResultMedArit.Text = modEstadisticFunctions.Mediana(lstValorMedAritmetica) End If lstValorMedAritmetica.Clear() btCalcMed.Enabled = False End Sub Private Sub txtArtimetica_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtValue.Click txtValue.SelectAll() End Sub End Class Module modEstadisticFunctions ''' <summary> ''' Función para calcular la media aritmética ''' </summary> ''' <param name="dblValue">Variable array List</param> ''' <returns></returns> ''' <remarks></remarks> Public Function MediaAritmetica(ByVal dblValue As List(Of Double)) As Double Try Dim Valor As Double Dim md As Double For I As Integer = 0 To dblValue.Count - 1 Valor += +dblValue(I) Next md = Valor / dblValue.Count Return md Catch ex As Exception MessageBox.Show("Valor no válido", _ "Atención", _ MessageBoxButtons.OK, _ MessageBoxIcon.Exclamation) Return Nothing End Try End Function ''' <summary> ''' Función para calcular la media armónica ''' </summary> ''' <param name="dblValue">Variable array List</param> ''' <returns></returns> ''' <remarks></remarks> Public Function MediaArmonica(ByVal dblValue As List(Of Double)) As Double Try Dim Valor As Double Dim md As Double For I As Integer = 0 To dblValue.Count - 1 Valor += +(1 / dblValue(I)) Next md = dblValue.Count / Valor Return md Catch ex As Exception MessageBox.Show("Valor no válido", _ "Atención", _ MessageBoxButtons.OK, _ MessageBoxIcon.Exclamation) Return Nothing End Try End Function ''' <summary> ''' Función para calcular la media geométrica ''' </summary> ''' <param name="dblValue">Variable array List</param> ''' <returns></returns> ''' <remarks></remarks> Public Function MediaGeometrica(ByVal dblValue As List(Of Double)) As Double Try Dim Valor As Double = 1 Dim md As Double For I As Integer = 0 To dblValue.Count - 1 Valor = Valor * dblValue(I) Next md = Valor ^ (1 / dblValue.Count) Return md Catch ex As Exception MessageBox.Show("Valor no válido", _ "Atención", _ MessageBoxButtons.OK, _ MessageBoxIcon.Exclamation) Return Nothing End Try End Function ''' <summary> ''' Función para calcular la Moda ''' </summary> ''' <param name="dblValue">Variable array List</param> ''' <returns></returns> ''' <remarks></remarks> Public Function Moda(ByVal dblValue As List(Of Double)) As Double Try Return dblValue.Max() 'Obtiene el número mayor Catch ex As Exception MessageBox.Show("Valor no válido", _ "Atención", _ MessageBoxButtons.OK, _ MessageBoxIcon.Exclamation) Return Nothing End Try End Function ''' <summary> ''' Función para calcular la Mediana ''' </summary> ''' <param name="dblValue">Variable array List</param> ''' <returns></returns> ''' <remarks></remarks> Public Function Mediana(ByVal dblValue As List(Of Double)) As String Try Dim par As Double Dim Madn As String = Nothing dblValue.Sort() If (dblValue.Count / 2) = CInt(dblValue.Count / 2) Then par = CDbl(True) Else par = CDbl(False) End If Select Case par Case CDbl(True) : Madn = String.Format("{0}-{1}", CStr(dblValue(CInt((dblValue.Count / 2) - 1))), CStr(dblValue(CInt(dblValue.Count / 2)))) Case CDbl(False) : Madn = String.Format("{0}", CStr(dblValue(CInt(Conversion.Int(dblValue.Count / 2))))) End Select Return Madn Catch ex As Exception MessageBox.Show("Valor no válido", _ "Atención", _ MessageBoxButtons.OK, _ MessageBoxIcon.Exclamation) Return Nothing End Try End Function End Module
Faltaría la media aritmética ponderada, pero no la he puesto porque requiere hacerlo aparte y añadir más código. Ya que se necesitan dos datos, los valores y los coeficientes de importancia. Error corregidoHabía un error en el cálculo de la mediana. Se me olvidó ordenar la lista de valores. He añadido dblValue.Sort()
Mis disculpas S2s
|
|
|
60
|
Seguridad Informática / Seguridad / Re: Hackear de forma remota un ordenador sin Internet es posible
|
en: 12 Junio 2016, 20:34 pm
|
La idea es escuchar el proceso del ordenador a través de la red eléctrica. Hay que conectar cualquier aparato de música (una cadena, un radiocasete) con salida de auriculares, en el mismo enchufe en el que está conectado el ordenador usando un ladrón múltiple o regleta ladrón: Entonces pones el ordenador a trabajar en algo, y subes el volumen del aparato musical a tope (sin música, repito) y puede que escuches el proceso de trabajo del ordenador que se transmite a través de la red eléctrica.
|
|
|
|
|
|
|