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

[Eleкtro]

· Mover un control
Con opciones de Dirección, velocidad, intervalo, timeout, y hacer búcle sobre el form.


[youtube=640,360]http://www.youtube.com/watch?v=iPKwIZDFnIo&feature=youtu.be[/youtube]

Código (vbnet) [Seleccionar] Expandir


#Region " Move control "

   ' [ Move control ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MoveControl(Label1, Direction.Right, 100, 1000, 10, True)
   ' MoveControl(Label1, Direction.Left, 1, 9999999, 2, True)

   Dim ControlToMove As Control
   Dim ControlLoop As Boolean
   Dim StartMove As New Timer
   Dim EndMove As New Timer

   Public Enum Direction
       Up = 1
       Down = 2
       Left = 3
       Right = 4
   End Enum

   Public Sub MoveControl(ByVal Control As Control, _
                          ByVal Direction As Direction, _
                          ByVal Interval As Int64, _
                          ByVal TimeOut As Int64, _
                          ByVal Speed As Int16, _
                          ByVal LoopInsideForm As Boolean)

       ControlToMove = Control
       ControlLoop = LoopInsideForm
       StartMove.Tag = Direction
       'TimeOut = TimeOut * 1000 ' If want to use seconds instead of Milliseconds.
       StartMove.Interval = Interval
       EndMove.Interval = TimeOut

       For x = 1 To Speed ' Add X amount of handles
           AddHandler StartMove.Tick, AddressOf StartMove_Tick
       Next

       AddHandler EndMove.Tick, AddressOf EndMove_Tick
       StartMove.Start() : EndMove.Start()

   End Sub

   ' Start/continue moving
   Private Sub StartMove_Tick(Sender As Object, e As EventArgs)

       If ControlLoop Then ' Loop inside form
           Select Case Sender.tag
               Case 1 ' Up
                   If ControlToMove.Location.Y <= (0 - ControlToMove.Size.Height) Then
                       ControlToMove.Location = New Point(ControlToMove.Location.X, Me.Size.Height)
                   End If
               Case 2 ' Down
                   If ControlToMove.Location.Y >= (Me.Size.Height) Then
                       ControlToMove.Location = New Point(ControlToMove.Location.X, -0)
                   End If
               Case 3 ' Left
                   If ControlToMove.Location.X <= (0 - ControlToMove.Size.Width) Then
                       ControlToMove.Location = New Point(Me.Size.Width, ControlToMove.Location.Y)
                   End If
               Case 4 ' Right
                   If ControlToMove.Location.X >= (Me.Size.Width) Then
                       ControlToMove.Location = New Point(-ControlToMove.Width, ControlToMove.Location.Y)
                   End If
           End Select
       End If

       Select Case Sender.Tag ' Direction
           Case 1 : ControlToMove.Location = New Point(ControlToMove.Location.X, ControlToMove.Location.Y - 1) ' Up
           Case 2 : ControlToMove.Location = New Point(ControlToMove.Location.X, ControlToMove.Location.Y + 1) ' Down
           Case 3 : ControlToMove.Location = New Point(ControlToMove.Location.X - 1, ControlToMove.Location.Y) ' Left
           Case 4 : ControlToMove.Location = New Point(ControlToMove.Location.X + 1, ControlToMove.Location.Y) ' Right
       End Select

   End Sub

   ' End Moving
   Private Sub EndMove_Tick(sender As Object, e As EventArgs)
       StartMove.Stop()
       EndMove.Stop()
       RemoveHandler StartMove.Tick, AddressOf StartMove_Tick
       RemoveHandler EndMove.Tick, AddressOf EndMove_Tick
   End Sub

#End Region

[Eleкtro]

Obtener las familias de las fuentes instaladas:

EDITO: MEJORADO Y SIMPLIFICADO

Código (vbnet) [Seleccionar] Expandir

#Region " Get Installed Fonts Function "

    ' [ Get Installed Fonts Function ]
    '
    ' Examples :
    ' For Each Font As FontFamily In Get_Installed_Fonts() : MsgBox(Font.Name) : Next
    '
    ' For Each FontFam As FontFamily In Get_Installed_Fonts()
    '     Dim MyFont As New Font(FontFam.Name, 8)
    '     MsgBox(MyFont.Italic)
    '     MsgBox(MyFont.OriginalFontName)
    '     MyFont.Dispose()
    ' Next

    Private Function Get_Installed_Fonts() As FontFamily()
        Using AllFonts As New Drawing.Text.InstalledFontCollection ' Get the installed fonts collection.
            Return AllFonts.Families ' Return an array of the system's font familiies.
        End Using
    End Function

#End Region





Unas de las típicas y quemadísimas funciones para convertir un string a binário:

Código (vbnet) [Seleccionar] Expandir

#Region " ASCII To Binary Function "

   ' [ ASCII To Binary Function ]
   '
   ' Examples :
   ' MsgBox(ASCII_To_Binary("Test"))

   Private Function ASCII_To_Binary(ByVal str As String) As String
       Dim Binary_String As String = Nothing

       For i As Integer = 0 To str.Length - 1
           Binary_String &= LongToBinary(Asc(str.Substring(i, 1))).Substring(LongToBinary(Asc(str.Substring(i, 1))).Length - 8)
       Next i

       Return Binary_String
   End Function

   ' Convert this Long value into a Binary string.
   Private Function LongToBinary(ByVal long_value As Long, Optional ByVal separate_bytes As Boolean = True) As String

       ' Convert into hex.
       Dim hex_string As String = long_value.ToString("X")

       ' Zero-pad to a full 16 characters.
       hex_string = hex_string.PadLeft(16, "0")

       ' Read the hexadecimal digits one at a time from right to left.
       Dim result_string As String = ""
       For digit_num As Integer = 0 To 15

           ' Convert this hexadecimal digit into a binary nibble.
           Dim digit_value As Integer = Integer.Parse(hex_string.Substring(digit_num, 1), Globalization.NumberStyles.HexNumber)

           ' Convert the value into bits.
           Dim factor As Integer = 8
           Dim nibble_string As String = ""
           For bit As Integer = 0 To 3
               If digit_value And factor Then
                   nibble_string &= "1"
               Else
                   nibble_string &= "0"
               End If
               factor \= 2
           Next bit

           ' Add the nibble's string to the left of the result string.
           result_string &= nibble_string
       Next digit_num

       ' Add spaces between bytes if desired.
       If separate_bytes Then
           Dim tmp As String = ""
           For i As Integer = 0 To result_string.Length - 8 Step 8
               tmp &= result_string.Substring(i, 8) & " "
           Next i
           result_string = tmp.Substring(0, tmp.Length - 1)
       End If

       ' Return the result.
       Return result_string

   End Function

#End Region





...O viceversa:

Código (vbnet) [Seleccionar] Expandir

#Region " Binary To ASCII Function "

   ' [ Binary To ASCII Function ]
   '
   ' Examples :
   ' MsgBox(Binary_To_ASCII("01010100 01100101 01110011 01110100"))
   ' MsgBox(Binary_To_ASCII("01010100011001010111001101110100"))

   Private Function Binary_To_ASCII(ByVal str As String) As String
       Dim ASCII_String As String = Nothing

       ' Strip out spaces in case the string are separated by spaces.
       str = str.Replace(" ", "")

       For i As Integer = 0 To str.Length - 1 Step 8
           ASCII_String &= Chr(BinaryToLong(str.Substring(i, 8)))
       Next i

       Return ASCII_String
   End Function

   ' Convert this Binary value into a Long.
   Private Function BinaryToLong(ByVal binary_value As String) As Long

       ' Remove any leading &B if present.
       binary_value = binary_value.Trim().ToUpper()
       If binary_value.StartsWith("&B") Then binary_value = binary_value.Substring(2)

       ' Strip out spaces in case the bytes are separated by spaces.
       binary_value = binary_value.Replace(" ", "")

       ' Left pad with zeros so we have a full 64 bits.
       binary_value = binary_value.PadLeft(64, "0")

       ' Read the bits in nibbles from left to right. (A nibble is half a byte)
       Dim hex_result As String = ""
       For nibble_num As Integer = 0 To 15

           ' Convert this nibble into a hexadecimal string.
           Dim factor As Integer = 1
           Dim nibble_value As Integer = 0

           ' Read the nibble's bits from right to left.
           For bit As Integer = 3 To 0 Step -1
               If binary_value.Substring(nibble_num * 4 + bit, 1).Equals("1") Then
                   nibble_value += factor
               End If
               factor *= 2
           Next bit

           ' Add the nibble's value to the right of the result hex string.
           hex_result &= nibble_value.ToString("X")
       Next nibble_num

       ' Convert the result string into a long.
       Return Long.Parse(hex_result, Globalization.NumberStyles.HexNumber)

   End Function

#End Region

[Eleкtro]

· Hexadecimal a Decimal:

Código (vbnet) [Seleccionar] Expandir

#Region " Hex To Dec Function "

   ' [ Hex To Dec Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Hex_To_Dec("0x020032")) ' Result: 131122

   Private Function Hex_To_Dec(ByVal str As String) As Int32
       Return Convert.ToInt32(str, 16)
   End Function

#End Region





· Decimal a Hexadecimal:

Código (vbnet) [Seleccionar] Expandir

#Region " Dec To Hex Function "

   ' [ Dec To Hex Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Dec_To_Hex(131122)) ' Result: 0x020032

   Private Function Dec_To_Hex(ByVal int As Int32) As String
       Return Convert.ToString(int, 16)
   End Function

#End Region





· Comprueba si una fuente está instalada:

EDITO: MEJORADO Y SIMPLIFICADO

#Region " Font Is Installed? Function "

   ' [ Font Is Installed? Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Font_Is_Installed("Lucida Console"))

   Private Function Font_Is_Installed(ByVal FontName As String) As Boolean
       Dim AllFonts As New Drawing.Text.InstalledFontCollection
       If AllFonts.Families.ToList().Contains(New FontFamily(FontName)) Then Return True Else Return False
   End Function

#End Region

Otra versión que me han proporcionado, mucho más simplificada:

Código (vbnet) [Seleccionar] Expandir

#Region " Font Is Installed? Function "

   ' [ Font Is Installed? Function ]
   '
   ' Examples :
   ' MsgBox(Font_Is_Installed("Lucida Console"))

   Public Shared Function Font_Is_Installed(ByVal FontName As String) As Boolean
       Using TestFont As Font = New Font(FontName, 8)
           Return CBool(String.Compare(FontName, TestFont.Name, StringComparison.InvariantCultureIgnoreCase) = 0)
       End Using
   End Function

#End Region

[Eleкtro]

· Mostrar un MessageBox centrado al form

Código (vbnet) [Seleccionar] Expandir

#Region " Centered Messagebox "

   ' [ Centered Messagebox Function ]
   '
   ' Instructions :
   ' 1. Add the Class
   ' 2. Use it
   '
   ' Examples :
   ' Using New Centered_MessageBox(Me)
   '     MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
   ' End Using
   
   ' Centered_MessageBox.vb
#Region " Centered MessageBox Class"

Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

   Class Centered_MessageBox
       Implements IDisposable
       Private mTries As Integer = 0
       Private mOwner As Form

       Public Sub New(owner As Form)
           mOwner = owner
           owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
       End Sub

       Private Sub findDialog()
           ' Enumerate windows to find the message box
           If mTries < 0 Then
               Return
           End If
           Dim callback As New EnumThreadWndProc(AddressOf checkWindow)
           If EnumThreadWindows(GetCurrentThreadId(), callback, IntPtr.Zero) Then
               If System.Threading.Interlocked.Increment(mTries) < 10 Then
                   mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
               End If
           End If
       End Sub
       Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
           ' Checks if <hWnd> is a dialog
           Dim sb As New StringBuilder(260)
           GetClassName(hWnd, sb, sb.Capacity)
           If sb.ToString() <> "#32770" Then
               Return True
           End If
           ' Got it
           Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
           Dim dlgRect As RECT
           GetWindowRect(hWnd, dlgRect)
           MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
           Return False
       End Function
       Public Sub Dispose() Implements IDisposable.Dispose
           mTries = -1
       End Sub

       ' P/Invoke declarations
       Private Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
       <DllImport("user32.dll")> _
       Private Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
       End Function
       <DllImport("kernel32.dll")> _
       Private Shared Function GetCurrentThreadId() As Integer
       End Function
       <DllImport("user32.dll")> _
       Private Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
       End Function
       <DllImport("user32.dll")> _
       Private Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
       End Function
       <DllImport("user32.dll")> _
       Private Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
       End Function
       Private Structure RECT
           Public Left As Integer
           Public Top As Integer
           Public Right As Integer
           Public Bottom As Integer
       End Structure
   End Class

#End Region

#End Region

[Eleкtro]

· Devuelve el título de la ventana de un proceso

Código (vbnet) [Seleccionar] Expandir

#Region " Get Process Window Title Function "

    ' [ Get Process Window Title Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Get_Process_Window_Title("cmd"))
    ' MsgBox(Get_Process_Window_Title("cmd.exe"))

    Private Function Get_Process_Window_Title(ByVal ProcessName As String) As String
        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).MainWindowTitle
    End Function

#End Region



· Devuelve el handle de un proceso

Código (vbnet) [Seleccionar] Expandir

#Region " Get Process Handle Function "

    ' [ Get Process Handle Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Get_Process_Handle("cmd"))
    ' MsgBox(Get_Process_Handle("cmd.exe"))

    Private Function Get_Process_Handle(ByVal ProcessName As String) As IntPtr
        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).MainWindowHandle
    End Function

#End Region



· Devuelve el PID de un proceso

Código (vbnet) [Seleccionar] Expandir

#Region " Get Process PID Function "

    ' [ Get Process PID Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Get_Process_PID("cmd"))
    ' MsgBox(Get_Process_PID("cmd.exe"))

    Private Function Get_Process_PID(ByVal ProcessName As String) As IntPtr
        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).Id
    End Function

#End Region

[Eleкtro]

· Cargar fuentes de texto desde los recursos:

Nota: Este code ya lo posteé pero se me olvidó agregar lo más importante, la class, así que lo vuelvo a postear xD

Código (vbnet) [Seleccionar] Expandir

#Region " Use Custom Text-Font "

   ' [ Use Custom Text-Font ]
   '
   ' Instructions :
   ' 1. Add a .TTF font to the resources
   ' 2. Add the class
   ' 3. Use it
   '
   ' Examples:
   ' Label1.Font = New Font(GameFont.Font, 10.0!)
   ' Label1.Text = "This is your custom font !!"

   Dim MyFont As New CustomFont(My.Resources.kakakaka)

   Private Sub Main_Disposed(sender As Object, e As System.EventArgs) Handles Me.Disposed
       MyFont.Dispose()
   End Sub

   ' CustomFont.vb
#Region " CustomFont Class "

Imports System.Drawing
Imports System.Drawing.Text
Imports System.Runtime.InteropServices

   ''' <summary>
   ''' Represents a custom font not installed on the user's system.
   ''' </summary>
   Public NotInheritable Class CustomFont
       Implements IDisposable

       Private fontCollection As New PrivateFontCollection()
       Private fontPtr As IntPtr

#Region "Constructor"
       ''' <summary>
       ''' Creates a new custom font using the specified font data.
       ''' </summary>
       ''' <param name="fontData">The font data representing the font.</param>
       Public Sub New(ByVal fontData() As Byte)
           'Create a pointer to the font data and copy the
           'font data into the location in memory pointed to
           fontPtr = Marshal.AllocHGlobal(fontData.Length)
           Marshal.Copy(fontData, 0, fontPtr, fontData.Length)

           'Add the font to the shared collection of fonts:
           fontCollection.AddMemoryFont(fontPtr, fontData.Length)
       End Sub
#End Region

#Region "Destructor"
       'Free the font in unmanaged memory, dispose of
       'the font collection and suppress finalization
       Public Sub Dispose() Implements IDisposable.Dispose
           Marshal.FreeHGlobal(fontPtr)
           fontCollection.Dispose()

           GC.SuppressFinalize(Me)
       End Sub

       'Free the font in unmanaged memory
       Protected Overrides Sub Finalize()
           Marshal.FreeHGlobal(fontPtr)
       End Sub
#End Region

#Region "Properties"
       ''' <summary>
       ''' Gets the font family of the custom font.
       ''' </summary>
       Public ReadOnly Property Font() As FontFamily
           Get
               Return fontCollection.Families(0)
           End Get
       End Property
#End Region

   End Class

#End Region

#End Region





· Esperar a que una aplicación termine de CARGAR

Nota : El código no está muy simplificado, pero se puede usar y funciona bien.
Nota 2: Esto sirve para aquellas aplicaciones a las que no le afecta un "Process.WaitForInputIdle", de lo contrario es una tontería usar este code tán largo y bruto.

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

   Private Sub Wait_For_Application_To_Load(ByVal APP_Path As String, Optional ByVal APP_Arguments As String = Nothing)

       Process.Start("Photoshop.exe")
       Timer_CheckCPU.Tag = "Photoshop"
       Timer_CheckCPU.Enabled = True
       While Not Timer_CheckCPU.Tag = ""
           Application.DoEvents()
       End While
   End Sub

Código (vbnet) [Seleccionar] Expandir


#Region " Wait For Application To Load (UNFINISHED AND WAITING TO BE IMPROVED)"

   Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByVal lpBuffer As Integer, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
   Private WithEvents Timer_CheckCPU As New Timer

   Dim Memory_Value_Changed As Boolean
   Dim CPU_Changed As Boolean
   Dim CPU_Time As Boolean
   Dim Running_Time As Boolean
   Private _desiredTime_ms As Integer = 1500

   Private Sub Timer_CheckCPU_Tick(sender As Object, ev As EventArgs) Handles Timer_CheckCPU.Tick
       Timer_CheckCPU.Enabled = False
       Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName(Timer_CheckCPU.Tag)
       Dim hprocess As Process = pProcess(0)
       If hprocess Is Nothing Then
           Running = False
           Timer_CheckCPU.Enabled = True
           Return
       End If
       Running = True
       Memory = hprocess.PrivateMemorySize64
       CPUTotal = hprocess.TotalProcessorTime.TotalMilliseconds

       If AllConditionsGood() Then
           If Not (_countdown.IsRunning) Then
               _countdown.Reset()
               _countdown.Start()
           End If
           Dim _elapsed As Long = _countdown.ElapsedMilliseconds
           If _elapsed >= _desiredTime_ms Then
               Timer_CheckCPU.Tag = ""
               Return
           End If
       Else
           _countdown.Reset()
       End If
       Timer_CheckCPU.Enabled = True
   End Sub

   Private Function AllConditionsGood() As Boolean
       If CPU_Time Then Return False
       If Memory_Value_Changed Then Return False
       If Running_Time Then Return False
       Return True
   End Function

   Private _countdown As New Stopwatch

   Private _Running As Boolean = False
   Public WriteOnly Property Running() As Boolean
       Set(ByVal value As Boolean)
           _Running = value
           If value Then
               Running_Time = False
           Else
               Running_Time = True
           End If
       End Set
   End Property

   Private _CPUTotal As Double
   Public WriteOnly Property CPUTotal() As Double
       Set(ByVal value As Double)
           CPU = value - _CPUTotal 'used cputime since last check
           _CPUTotal = value
       End Set
   End Property

   Private _CPU As Double
   Public WriteOnly Property CPU() As Double
       Set(ByVal value As Double)
           If value = 0 Then
               CPU_Time = False
           Else
               CPU_Time = True
           End If
           _CPU = value
       End Set
   End Property

   Private _Memory As Long
   Public WriteOnly Property Memory() As Long
       Set(ByVal value As Long)
           MemoryDiff = Math.Abs(value - _Memory)
           _Memory = value
       End Set
   End Property

   Private _MemoryDiff As Long
   Public WriteOnly Property MemoryDiff() As Long
       Set(ByVal value As Long)
           If value = _MemoryDiff Then
               Memory_Value_Changed = False
           Else
               Memory_Value_Changed = True
           End If
           _MemoryDiff = value
       End Set
   End Property

#End Region

[Eleкtro]

Cargar configuración desde un archivo INI

Código (vbnet) [Seleccionar] Expandir

Dim INI_File As String = ".\Test.ini"

Código (vbnet) [Seleccionar] Expandir


' By Elektro H@cker

   Private Sub Load_INI_settings()

       Dim Line As String = Nothing
       Dim ValueName As String = Nothing
       Dim Value

       Dim xRead As IO.StreamReader
       xRead = IO.File.OpenText(INI_File)
       Do Until xRead.EndOfStream

           Line = xRead.ReadLine().ToLower
           ValueName = Line.Split("=")(0).ToLower
           Value = Line.Split("=")(1)

           If ValueName = "Game".ToLower Then TextBox_Game.Text = Value
           If ValueName = "SaveSettings".ToLower  Then CheckBox_SaveSettings.Checked = Value

       Loop

       xRead.Close()
       xRead.Dispose()

   End Sub

[ABDERRAMAH]

dada una lista de imágenes, un tamaño por imágen y un número de imágenes por línea devuelve un bitmap con todas las imágenes dibujadas sobre una cuadricula del tamaño indicado. Muy útil para el manejo de gráficos 2D.

Código (vbnet) [Seleccionar] Expandir

Public Function get_Image_matrix(ByRef imagelist As Bitmap(), sze As Size, imgs_per_line As Integer)
       Dim imagesize As New Size(1, 1)
       imagesize.Width = sze.Width * imgs_per_line
       imagesize.Height = Math.Ceiling((imagelist.Length / imgs_per_line) * sze.Height)

       If (imagesize.Height = 0) Then
           imagesize.Height = 1 * sze.Height
       End If
       If (imagesize.Width = 0) Then
           imagesize.Width = 1 * sze.Width
       End If

       Dim rtn As New Bitmap(imagesize.Width, imagesize.Height)
       Dim gr As Graphics = Graphics.FromImage(rtn)

       Dim xc As Integer = 0
       Dim yc As Integer = 0
       Dim index As Integer = 0

       Dim needlines As Integer = Math.Ceiling(imagelist.Length / imgs_per_line)

       Do While yc < imagesize.Height
           Do While xc < imgs_per_line * sze.Width
               Try
                   gr.DrawImage(imagelist(index), New Rectangle(xc, yc, sze.Width, sze.Height))
               
               Catch ex As Exception

               End Try
               index += 1
               xc += 1 * sze.Width
           Loop
           xc = 0
           yc += 1 * sze.Height
       Loop

       Return rtn
   End Function

[Eleкtro]

@ABDERRAMAH
Gracias por aportar!



Mi recopilación personal de snippets ha sido re-ordenada y actualizada en el post principal, ya son un total de 200 snippets!

Saludos.

[Eleкtro]

· Enviar texto a una ventana PERO sin activar el foco de esa ventana

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       ' Abrimos una instancia minimizada del bloc de notas
       Process.Start("CMD", "/C Start /MIN Notepad.exe")
       ' Y enviamos el texto a la instancia minimizada del bloc de notas!
       ' Nota: El while es para esperar a que el notepad termine de cargar, no es algo imprescindible.
       While Not SendKeys_To_App("notepad.exe", "By Elektro H@cker" & vbCrLf & "... :D") : Application.DoEvents() : End While
   End Sub

Función:

Código (vbnet) [Seleccionar] Expandir

#Region " SendKeys To App "

   ' [ SendKeys To App Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' SendKeys_To_App("notepad.exe", "By Elektro H@cker" & vbCrLf & "... :D")

   Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
   Private Const EM_REPLACESEL = &HC2

   Private Function SendKeys_To_App(ByVal App_Name As String, ByVal str As String) As Boolean
       Dim nPadHwnd As Long, ret As Long, EditHwnd As Long
       Dim APP_WindowTitle As String

       If App_Name.ToLower.EndsWith(".exe") Then App_Name = App_Name.Substring(0, App_Name.Length - 4) ' Rename APP Name

       Dim ProcessArray = Process.GetProcessesByName(App_Name)
       If ProcessArray.Length = 0 Then
           Return False ' App not found
       Else
           APP_WindowTitle = ProcessArray(0).MainWindowTitle ' Set window title of the APP
       End If

       nPadHwnd = FindWindow(App_Name, APP_WindowTitle)

       If nPadHwnd > 0 Then
           EditHwnd = FindWindowEx(nPadHwnd, 0&, "Edit", vbNullString) ' Find edit window
           If EditHwnd > 0 Then ret = SendMessage(EditHwnd, EM_REPLACESEL, 0&, str) ' Send text to edit window
           Return True  ' Text sended
       Else
           Return False ' Name/Title not found
       End If

   End Function

#End Region