Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)

[Eleкtro]

Devolvuelve la Key equivalente de un Value de un dictionary:

Código (vbnet) [Seleccionar] Expandir

    Public Function FindKeyByValue(Of TKey, TValue)(dictionary As Dictionary(Of TKey, TValue), value As TValue) As TKey

        For Each pair As KeyValuePair(Of TKey, TValue) In dictionary
            If value.Equals(pair.Value) Then Return pair.Key
        Next

        ' Throw New Exception("The value is not found in the dictionary.")
        Return Nothing
    End Function

[Novlucker]

Algo como esto en C#, aunque como digo, me resulta tan corto que no me gusta ponerlo en funciones/métodos

Código (csharp) [Seleccionar] Expandir

public K FindKeyByValue<K, V>(Dictionary<K, V> dictionary, V value)
{
    return dictionary.FirstOrDefault(k => k.Value.Equals(value)).Key;
}

Saludos

[z3nth10n]

Perdón por desvirtuar,

http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1857514#msg1857514

Siempre me salta la Excepción de Could not set keyboard hook

Que puedo hacer? :S

[Eleкtro]

Algo como esto en C#

Muy bueno Nov!, gracias, la verdad es que necesitaba simplificar esa función y eres el único de todo stackoverflow que ha llegado a conseguirlo xD.

Lo mismo pero en VB:

Código (vbnet) [Seleccionar] Expandir

    Public Function Find_Dictionary_Key_By_Value(Of K, V)(Dictionary As Dictionary(Of K, V), Value As V) As K

        Dim Key = Dictionary.FirstOrDefault(Function(x) x.Value.Equals(Value)).Key

        If Key Is Nothing Then
            Throw New Exception("The value is not found in the dictionary.")
        End If

        Return Key

    End Function

http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1857514#msg1857514

Siempre me salta la Excepción de Could not set keyboard hook

Que puedo hacer? :S

Se me olvidó mencionar este detalle:

Project -> Properties -> Debug -> Uncheck "Enable the Visual Studio hosting process"

Saludos!

[Eleкtro]

Modifica el color de un Bitmap

Código (vbnet) [Seleccionar] Expandir

#Region " Fill Bitmap Color "

   ' [ Fill Bitmap Color Function ]
   '
   ' Examples :
   '
   ' IMPORTANT: use ARGB colors as the parameter.
   ' PictureBox1.BackgroundImage = Fill_Bitmap_Color(bmp, Color.FromArgb(255, 255, 255, 255), Color.Red)

   Private Function Fill_Bitmap_Color(ByVal Image As Bitmap, ByVal FromColor As Color, ByVal ToColor As Color)

       Dim bmp As New Bitmap(Image)

       Dim x As Integer = 0, y As Integer = 0

       While x < bmp.Width
           y = 0
           While y < bmp.Height
               If Image.GetPixel(x, y) = FromColor Then bmp.SetPixel(x, y, ToColor)
               Math.Max(Threading.Interlocked.Increment(y), y - 1)
           End While
           Math.Max(Threading.Interlocked.Increment(x), x - 1)
       End While

       Return bmp

   End Function

#End Region





Mueve el slider de un "GTrackBar" de forma progresiva al mantener presionada una tecla de dirección.

Se necesita el control extendido GTrackBar: http://www.codeproject.com/Articles/35104/gTrackBar-A-Custom-TrackBar-UserControl-VB-NET

Código (vbnet) [Seleccionar] Expandir

' By Elektro H@cker
#Region " [GTrackBar] Progressive Scroll "

   Dim TrackBar_SmallChange As Int32 = 5
   Dim TrackBar_LargeChange As Int32 = 10

   ' GTrackBar [KeyDown]
   Private Sub GTrackBar_KeyDown(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyDown

       sender.ChangeSmall = 0
       sender.ChangeLarge = 0

       Select Case e.KeyCode
           Case Keys.Left, Keys.Right, Keys.Up, Keys.Down
               MakeScroll_TrackBar(sender, e.KeyCode)
       End Select

   End Sub

   ' GTrackBar [KeyUp]
   Private Sub GTrackBar_KeyUp(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyUp
       ' Set the values on KeyUp event because the Trackbar Scroll event.
       sender.ChangeSmall = TrackBar_SmallChange
       sender.ChangeLarge = TrackBar_LargeChange
   End Sub

   ' MakeScroll TrackBar
   Private Sub MakeScroll_TrackBar(ByVal GTrackBar As gTrackBar.gTrackBar, key As Keys)

       Select Case key
           Case Keys.Left
               GTrackBar.Value -= TrackBar_SmallChange
           Case Keys.Right
               GTrackBar.Value += TrackBar_SmallChange
           Case Keys.Up
               GTrackBar.Value += TrackBar_LargeChange
           Case Keys.Down
               GTrackBar.Value -= TrackBar_LargeChange
       End Select

   End Sub

#End Region

...Lo mismo pero si tenemos múltiples GTrackbars:

Código (vbnet) [Seleccionar] Expandir

' By Elektro H@cker
#Region " [GTrackBar] Progressive Scroll MultiTrackbars "

   Dim TrackBar1_SmallChange As Int32 = 2
   Dim TrackBar1_LargeChange As Int32 = 5

   Dim TrackBar2_SmallChange As Int32 = 5
   Dim TrackBar2_LargeChange As Int32 = 10

   ' GTrackBar [KeyDown]
   Private Sub GTrackBars_KeyDown(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyDown, GTrackBar2.KeyDown

       sender.ChangeSmall = 0
       sender.ChangeLarge = 0

       Select Case e.KeyCode
           Case Keys.Left, Keys.Right, Keys.Up, Keys.Down
               MakeScroll_TrackBar(sender, e.KeyCode)
       End Select

   End Sub

   ' GTrackBar [KeyUp]
   Private Sub GTrackBars_KeyUp(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyUp, GTrackBar2.KeyUp

       ' Set the values on KeyUp event because the Trackbar Scroll event.

       Select Case sender.Name
           Case "GTrackBar1"
               sender.ChangeSmall = TrackBar1_SmallChange
               sender.ChangeLarge = TrackBar1_LargeChange
           Case "GTrackBar_2"
               sender.ChangeSmall = TrackBar2_SmallChange
               sender.ChangeLarge = TrackBar2_LargeChange
       End Select

   End Sub

   ' MakeScroll TrackBar
   Private Sub MakeScroll_TrackBar(ByVal GTrackBar As gTrackBar.gTrackBar, key As Keys)

       Dim SmallChange As Int32 = 0, Largechange As Int32 = 0

       Select Case GTrackBar.Name
           Case "GTrackBar1"
               SmallChange = TrackBar1_SmallChange
               Largechange = TrackBar1_LargeChange
           Case "GTrackBar2"
               SmallChange = TrackBar2_SmallChange
               Largechange = TrackBar2_LargeChange
       End Select

       Select Case key
           Case Keys.Left
               GTrackBar.Value -= SmallChange
           Case Keys.Right
               GTrackBar.Value += SmallChange
           Case Keys.Up
               GTrackBar.Value += Largechange
           Case Keys.Down
               GTrackBar.Value -= Largechange
       End Select

   End Sub

#End Region

[Eleкtro]

[ComboBoxTooltip] Show tooltip when text exceeds ComboBox width

(Muestra un tooltip cuando el tamaño del Item supera el tamaño del ComboBox.)

Código (vbnet) [Seleccionar] Expandir

    Dim LastSelectedItem As Int32 = -1

    Private Sub ComboBoxTooltip_DropdownItemSelected(sender As Object, e As ComboBoxTooltip.DropdownItemSelectedEventArgs) _
    Handles ComboBoxTooltip1.DropdownItemSelected

        Dim SelectedItem As Int32 = e.SelectedItem

        If SelectedItem <> LastSelectedItem Then
            ToolTip1.Hide(sender)
            LastSelectedItem = -1
        End If

        If SelectedItem < 0 OrElse e.Scrolled Then
            ToolTip1.Hide(sender)
            LastSelectedItem = -1
        Else
            If sender.Items(e.SelectedItem).Length > CInt(sender.CreateGraphics.MeasureString(0, sender.Font).Width) + 8 Then
                LastSelectedItem = SelectedItem
                ToolTip1.Show(sender.Items(SelectedItem).ToString(), sender, e.Bounds.Location)
            End If
        End If

    End Sub

Es necesario este usercontrol:

Código (csharp) [Seleccionar] Expandir

using System;
using System.Drawing;
using System.Windows.Forms;
using System.Runtime.InteropServices;

public class ComboBoxTooltip : ComboBox
{
    private DropdownWindow mDropdown;
    public delegate void DropdownItemSelectedEventHandler(object sender, DropdownItemSelectedEventArgs e);
    public event DropdownItemSelectedEventHandler DropdownItemSelected;

    protected override void OnDropDown(EventArgs e)
    {
        // Install wrapper
        base.OnDropDown(e);
        // Retrieve handle to dropdown list
        COMBOBOXINFO info = new COMBOBOXINFO();
        info.cbSize = Marshal.SizeOf(info);
        SendMessageCb(this.Handle, 0x164, IntPtr.Zero, out info);
        mDropdown = new DropdownWindow(this);
        mDropdown.AssignHandle(info.hwndList);
    }
    protected override void OnDropDownClosed(EventArgs e)
    {
        // Remove wrapper
        mDropdown.ReleaseHandle();
        mDropdown = null;
        base.OnDropDownClosed(e);
        OnSelect(-1, Rectangle.Empty, true);
    }
    internal void OnSelect(int item, Rectangle pos, bool scroll)
    {
        if (this.DropdownItemSelected != null)
        {
            pos = this.RectangleToClient(pos);
            DropdownItemSelected(this, new DropdownItemSelectedEventArgs(item, pos, scroll));
        }
    }
    // Event handler arguments
    public class DropdownItemSelectedEventArgs : EventArgs
    {
        private int mItem;
        private Rectangle mPos;
        private bool mScroll;
        public DropdownItemSelectedEventArgs(int item, Rectangle pos, bool scroll) { mItem = item; mPos = pos; mScroll = scroll; }
        public int SelectedItem { get { return mItem; } }
        public Rectangle Bounds { get { return mPos; } }
        public bool Scrolled { get { return mScroll; } }
    }

    // Wrapper for combobox dropdown list
    private class DropdownWindow : NativeWindow
    {
        private ComboBoxTooltip mParent;
        private int mItem;
        public DropdownWindow(ComboBoxTooltip parent)
        {
            mParent = parent;
            mItem = -1;
        }
        protected override void WndProc(ref Message m)
        {
            // All we're getting here is WM_MOUSEMOVE, ask list for current selection for LB_GETCURSEL
            Console.WriteLine(m.ToString());
            base.WndProc(ref m);
            if (m.Msg == 0x200)
            {
                int item = (int)SendMessage(this.Handle, 0x188, IntPtr.Zero, IntPtr.Zero);
                if (item != mItem)
                {
                    mItem = item;
                    OnSelect(false);
                }
            }
            if (m.Msg == 0x115)
            {
                // List scrolled, item position would change
                OnSelect(true);
            }
        }
        private void OnSelect(bool scroll)
        {
            RECT rc = new RECT();
            SendMessageRc(this.Handle, 0x198, (IntPtr)mItem, out rc);
            MapWindowPoints(this.Handle, IntPtr.Zero, ref rc, 2);
            mParent.OnSelect(mItem, Rectangle.FromLTRB(rc.Left, rc.Top, rc.Right, rc.Bottom), scroll);
        }
    }
    // P/Invoke declarations
    private struct COMBOBOXINFO
    {
        public Int32 cbSize;
        public RECT rcItem;
        public RECT rcButton;
        public int buttonState;
        public IntPtr hwndCombo;
        public IntPtr hwndEdit;
        public IntPtr hwndList;
    }
    [StructLayout(LayoutKind.Sequential)]
    private struct RECT
    {
        public int Left;
        public int Top;
        public int Right;
        public int Bottom;
    }
    [DllImport("user32.dll", EntryPoint = "SendMessageW", CharSet = CharSet.Unicode)]
    private static extern IntPtr SendMessageCb(IntPtr hWnd, int msg, IntPtr wp, out COMBOBOXINFO lp);
    [DllImport("user32.dll", EntryPoint = "SendMessageW", CharSet = CharSet.Unicode)]
    private static extern IntPtr SendMessageRc(IntPtr hWnd, int msg, IntPtr wp, out RECT lp);
    [DllImport("user32.dll")]
    private static extern IntPtr SendMessage(IntPtr hWnd, int msg, IntPtr wp, IntPtr lp);
    [DllImport("user32.dll")]
    private static extern int MapWindowPoints(IntPtr hWndFrom, IntPtr hWndTo, [In, Out] ref RECT rc, int points);
}


[z3nth10n]

Añadir difentes estilos a un "Label" (en realidad se usa un RichTextBox )

Código (vbnet) [Seleccionar] Expandir

'Ejemplos:

       'RichTextLabel.AddTextWithFont("algo de texto con Arial al 12", New Font("Arial", 12, FontStyle.Bold), RichTextBox1)
       'RichTextLabel.AddTextWithColor("ROOOJOOORL xD", Color.Red, RichTextBox1)
       'RichTextLabel.AddTextWithColor(vbCrLf & "nueva linea y algo de texto", Color.Black, RichTextBox1)


Public Class RichTextLabel

   Public Shared Sub AddTextWithFont(ByVal sText As String, ByVal oFont As Font, ByVal rtb As RichTextBox)

       Dim index As Integer
       index = rtb.TextLength
       rtb.AppendText(sText)
       rtb.SelectionStart = index
       rtb.SelectionLength = rtb.TextLength - index
       rtb.SelectionFont = oFont
       rtb.BorderStyle = System.Windows.Forms.BorderStyle.None
       rtb.ReadOnly = True
       rtb.ScrollBars = System.Windows.Forms.RichTextBoxScrollBars.None

   End Sub

   Public Shared Sub AddTextWithColor(ByVal sText As String, ByVal oColor As Color, ByVal rtb As RichTextBox)

       Dim index As Integer
       index = rtb.TextLength
       rtb.AppendText(sText)
       rtb.SelectionStart = index
       rtb.SelectionLength = rtb.TextLength - index
       rtb.SelectionColor = oColor
       rtb.BorderStyle = System.Windows.Forms.BorderStyle.None
       rtb.ReadOnly = True
       rtb.ScrollBars = System.Windows.Forms.RichTextBoxScrollBars.None

   End Sub

End Class


Un saludo.

[Eleкtro]

Añadir difentes estilos a un "Label" (en realidad se usa un RichTextBox )

Se puede mejorar muy mucho, para evitar todas las cosas que dije... aquí tienes:

Código (vbnet) [Seleccionar] Expandir

Add_Text_With_Color(RichTextBox1, "algo de texto con Arial al 12", RichTextBox1.ForeColor, New Font("Arial", 12, FontStyle.Bold))
Add_Text_With_Color(RichTextBox1, " ROOOJOOORL xD", Color.Red)
Add_Text_With_Color(RichTextBox1, Environment.NewLine & "nueva linea y algo de texto", Color.Black)

Código (vbnet) [Seleccionar] Expandir


   Public Sub Add_Text_With_Color(ByVal richTextBox As RichTextBox, _
                                         ByVal text As String, _
                                         ByVal color As Color, _
                                         Optional ByVal font As Font = Nothing)

       richTextBox.Enabled = False
       richTextBox.BorderStyle = BorderStyle.None
       richTextBox.ScrollBars = RichTextBoxScrollBars.None

       Dim index As Int32 = richTextBox.TextLength
       richTextBox.AppendText(text)
       richTextBox.SelectionStart = index
       richTextBox.SelectionLength = richTextBox.TextLength - index
       richTextBox.SelectionColor = color
       If font IsNot Nothing Then richTextBox.SelectionFont = font
     
   End Sub


Saludos

[z3nth10n]

Tás colao, necesitas poner un Public Shared Sub y no un Public Sub na más.
Por cierto, muchas gracias, como siempre mejorando mi Snippets... A ver si algún día es de al revés.

[Eleкtro]

Tás colao, necesitas poner un Public Shared Sub y no un Public Sub na más.

No me he colado Ikillnukes, el shared no es obligatorio, eso depende de las necesidades. En el snippet original hay una Class para meter dos mini procedimientos, en mi snippet como ves no hay ninguna Class externa y los dos procedimientos están simplificados en sólo uno, si necesitas sharearla pues hazlo.

Si lo quieres llamar desde otra class:

Código (vbnet) [Seleccionar] Expandir

Form1.Add_Text_With_Color(Form1.RichTextBox1, "lo que sea", Color.AliceBlue)

Saludos