Snippets Vault

Posts 61–75 of 113 · Page 5 of 8

Move image inside small picturebox with mouse:

This will allow you to move a large image around inside a smaller picturebox without scrollbars, using your mouse.

Add a Panel to your form. Name it Panel1.
Add a Picturebox inside this panel. Name it Picturebox1.

Put this anywhere as long as it is OUTSIDE of any functions or subs.

Code:

Private neopoint As New Point

Put this under Picturebox1_MouseDown()

Code:

neopoint = New Point(e.X, e.Y)

Put this under Picturebox1_MouseMove()

Code:

If e.Button = Windows.Forms.MouseButtons.Left Then
Dim picX As Integer = (neopoint.X - e.X)
Dim picY As Integer = (neopoint.Y - e.Y)
Panel1.AutoScrollPosition = New Drawing.Point((picX - Panel1.AutoScrollPosition.X), (picY - Panel1.AutoScrollPosition.Y))
End If

Finally, add this to Form1_Load().

Code:

Panel1.AutoScroll = True
PictureBox1.SizeMode = SizeMode.AutoSize
Picturebox1.cursor = cursors.Hand
PictureBox1.SizeMode = PictureBoxSizeMode.AutoSize

Horizontal tabs:

Create a TabControl named TabControl1. Set Alignment to Left. Make sure this is the TabControl, not the TabPage. Now, set DrawMode to OwnerDrawFixed.

Add this code into your form.

Code:

Private Sub TabControl1_DrawItem(ByVal sender As Object, ByVal e As System.Windows.Forms.DrawItemEventArgs) Handles tabcontrol1.DrawItem
        Dim g As Graphics = e.Graphics
        Dim TextBrush As Brush
        Dim TabPage As TabPage = tabcontrol1.TabPages(e.Index)
        Dim TabBounds = tabcontrol1.GetTabRect(e.Index)
        If e.State = DrawItemState.Selected Then
            TextBrush = New SolidBrush(Color.Black)
            g.FillRectangle(Brushes.White, e.Bounds)
        Else
            TextBrush = New System.Drawing.SolidBrush(Color.Gray)
            e.DrawBackground()
        End If
        Dim TabFont As New Font("Arial", 12, FontStyle.Bold, GraphicsUnit.Pixel) 'replace arial with any font.
        Dim StringFlags As New StringFormat()
        StringFlags.Alignment = StringAlignment.Center
        StringFlags.LineAlignment = StringAlignment.Center
        g.DrawString(TabPage.Text, TabFont, TextBrush, TabBounds, New StringFormat(StringFlags))
    End Sub

File Splitting/File Joining.

Split and join files in VB.NET similarly to HJSplit (except in this you specify how many parts you want).

Tags: split, join, files, simple, HJSplit, master131.

[highlight=vb.net]'==========================
'Simple File Splitting/Joining code for VB.NET
'Created and coded by master131
'==========================

'Usage:
'SplitFile("C:\test.exe", 2)
'JoinFile("C:\test.exe.001")

Private Sub JoinFile(ByVal path As String)
If Not IO.File.Exists(path) Then
Throw New ArgumentException("The file '" & path & "' does not exist!")
Exit Sub
End If

If Not path.EndsWith(".001") Then
Throw New ArgumentException("'" & path & "' is not a valid .001 file!")
Exit Sub
End If

Dim joinList As New List(Of String)
Dim joinIndex As Integer = 1
Dim joinName As String = IO.Path.Combine(IO.Path.GetDirectoryName(path), IO.Path.GetFileNameWithoutExtension(path) & "." & joinIndex.ToString("D3"))
While IO.File.Exists(joinName)
joinName = IO.Path.Combine(IO.Path.GetDirectoryName(path), IO.Path.GetFileNameWithoutExtension(path) & "." & joinIndex.ToString("D3"))
If IO.File.Exists(joinName) Then joinList.Add(joinName)
joinIndex += 1
End While

Dim finalFile(0) As Byte
For Each file In joinList
Dim fileBytes() As Byte = IO.File.ReadAllBytes(file)
Dim currentIndex As Integer = finalFile.Length - 1
ReDim Preserve finalFile(finalFile.Length + fileBytes.Length - 1)
For i As Integer = 0 To fileBytes.Length - 1
finalFile(currentIndex + i) = fileBytes(i)
Next
Next

IO.File.WriteAllBytes(IO.Path.Combine(IO.Path.GetD irectoryName(path), IO.Path.GetFileNameWithoutExtension(path)), finalFile)
End Sub

Private Sub SplitFile(ByVal path As String, ByVal parts As Integer)
If Not IO.File.Exists(path) Then
Throw New ArgumentException("The file '" & path & "' does not exist!")
Exit Sub
End If

Dim fInfo As New IO.FileInfo(path)

If parts > fInfo.Length - 1 Then
Throw New ArgumentException("The amount of parts specified (" & parts & ") is too big!")
Exit Sub
End If

Dim fileContents() As Byte = IO.File.ReadAllBytes(path)
Dim bytesPerFile As Integer = fileContents.Length / parts
Dim remainingBytes As Integer = fileContents.Length Mod parts
Dim currentOffset As Integer = 0
While currentOffset <= fileContents.Length - 1
For i As Integer = 1 To parts
Dim bufferLength As Integer = bytesPerFile
If i = parts Then
bytesPerFile += remainingBytes
bufferLength = bytesPerFile
End If

Dim byteBuffer(bufferLength - 1) As Byte
For index As Integer = 0 To bufferLength - 1
byteBuffer(index) = fileContents(currentOffset + index)
Next

Dim finalPath As String = path & "." & i.ToString("D3")
IO.File.WriteAllBytes(finalPath, byteBuffer)
currentOffset += bytesPerFile
If i = parts Then currentOffset = fInfo.Length
Next
End While
End Sub[/highlight]

Copy and paste friendly link - [VisualBasic] VB.NET File Splitting/Joining - Pastebin.com

Snippet Name: CA Direct Start
Snippet Description: Simple snippet to start Combat Arms Directly (NOTE: The actually startup params weren't found by me)
Keywords: CA, weiner, bumhole, start.

Also note, the "Catch" block should really have a nested try/catch because if someone enters a wrong directory in the inputbox it'll crash.
[highlight=vb.net]
Dim myStr As String
Try
If Environment.GetEnvironmentVariable("PROCESSOR_ARCH ITECTURE") = "AMD64" Then
myStr = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\ SOFTWARE\Wow6432Node\Nexon\Combat Arms\Ver_US", "RootPath", "")
Else
myStr = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\ SOFTWARE\Nexon\Combat Arms\Ver_US", "RootPath", "")
End If
Process.Start(myStr & "\Engine.exe", "-windowtitle ""CombatArms"" -rez Engine.REZ -rez Game -authip 208.85.111.14 -authport 10001 -pcroom 0 -UserId ")
Catch ex As *********enceException
Dim result As String = InputBox("Unable to find the install location of CA, please type in your CA folder location below.", "Error: Unable to find install path", "xxx")
If result <> "xxx" Then
Process.Start(result & "\Engine.exe", "-windowtitle ""CombatArms"" -rez Engine.REZ -rez Game -authip 208.85.111.14 -authport 10001 -pcroom 0 -UserId ")
End If
End Try
[/highlight]

Snippet Name: Getting your default Browser's Argument
Snippet Description: A basic function to get your default browser's argument
Keywords: Getting, Default, Browser

Here a basic code that I wrote to get your browser's argument.
This can be used to direct websites through default browsers.

Code:

    Public Function DefaultBrowser() As String

        Dim GetLink As String = My.Computer.Registry.GetValue("HKEY_CLASSES_ROOT\.htm", "", "")
        'Gets the default value of the .htm extension for locating the browser

         Dim Result As String = My.Computer.Registry.GetValue("HKEY_CLASSES_ROOT\" + GetLink + "\shell\open\command", "", "")
        'Gets the shell argument of the browser to be returned

        Return Result.ToString

    End Function

How to open a website through the default browser:

Code:

Dim WebLocation As String = DefaultBrowser().Replace("%1","http://www.mpgh.net/forum/33-visual-basic-programming/")
Shell(WebLocation)

Originally Posted by nathanael890

Snippet Name: Getting your default Browser's Argument
Snippet Description: A basic function to get your default browser's argument
Keywords: Getting, Default, Browser

Here a basic code that I wrote to get your browser's argument.
This can be used to direct websites through default browsers.

Code:

Public Function DefaultBrowser() As String Dim GetLink As String = My.Computer.Registry.GetValue("HKEY_CLASSES_ROOT\.htm", "", "") 'Gets the default value of the .htm extension for locating the browser Dim Result As String = My.Computer.Registry.GetValue("HKEY_CLASSES_ROOT\" + GetLink + "\shell\open\command", "", "") 'Gets the shell argument of the browser to be returned Return Result.ToString End Function

How to open a website through the default browser:

Code:

Dim WebLocation As String = DefaultBrowser().Replace("%1","http://www.mpgh.net/forum/33-visual-basic-programming/") Shell(WebLocation)

Thats nice

But if you want to open something with your browser
just do:

Code:

Process.Start("http://WBSITE.COM")

or if you want just the browser without any sites..

Code:

Process.Start("http:") ' Opens ur default browser..

Originally Posted by nathanael890

Code:

    Public Function DefaultBrowser() As String

        Dim GetLink As String = My.Computer.Registry.GetValue("HKEY_CLASSES_ROOT\.htm", "", "")
        'Gets the default value of the .htm extension for locating the browser

         Dim Result As String = My.Computer.Registry.GetValue("HKEY_CLASSES_ROOT\" + GetLink + "\shell\open\command", "", "")
        'Gets the shell argument of the browser to be returned

        Return Result.ToString

    End Function

How to open a website through the default browser:

Code:

Dim WebLocation As String = DefaultBrowser().Replace("%1","http://www.mpgh.net/forum/33-visual-basic-programming/")
Shell(WebLocation)

I found a better solution tonight in relation to another thread so I thought I may as well post it here too:

[highlight=vb.net]
Private Function getDefaultBrowser() As String
Dim retVal As String = String.Empty
Using baseKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Softw are\Clients\StartmenuInternet")
Dim baseName As String = baseKey.GetValue("").ToString
Dim subKey As String = "SOFTWARE\" & IIf(Environment.GetEnvironmentVariable("PROCESSOR_ ARCHITECTURE") = "AMD64", "Wow6432Node\", "") & "Clients\StartMenuInternet\" & baseName
Using browserKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey(subKe y)
retVal = browserKey.GetValue("").ToString
End Using
End Using
Return retVal
End Function
[/highlight]

Why is this dead already?

• "Open with..." Effect
• Effect: Opens file then checks if it's correct ex: mp3/mp4
then adds them to a listbox

Makes it possible to edit registry to make default programs

[highlight=vb.net]
'////In form load/////
Dim Args As System.Collections.ObjectModel.ReadOnlyCollection( Of String) = My.Application.CommandLineArgs
For Each arg As String In Args
Dim result
result = arg.Substring(Math.Max(0, arg.Length - 4))
If result = ".mp4" Then
ListBox1.Items.Add(arg)
End If
If result = ".mp3" Then
ListBox1.Items.Add(arg)
End If
Next
[/highlight]

Really it just gets a last text in the string and checks it

still works the same

***Will add more later***

◘ How to get the correct MD5 in vb

◘ Tags: How, to, get, real md5, vb, epic, obtain, do, hash, value

[highlight=vb] Private Shared Function GetFileStream(ByVal pathName As String) As System.IO.FileStream
Return New System.IO.FileStream(pathName, System.IO.FileMode.Open, System.IO.FileAccess.Read, System.IO.FileShare.ReadWrite)
End Function
Public Shared Function GetMD5Hash(ByVal pathName As String) As String
Dim strResult As String = ""
Dim strHashData As String = ""

Dim arrbytHashValue As Byte()
Dim oFileStream As System.IO.FileStream = Nothing

Dim oMD5Hasher As New System.Security.Cryptography.MD5CryptoServiceProvi der()

Try
oFileStream = GetFileStream(pathName)
arrbytHashValue = oMD5Hasher.ComputeHash(oFileStream)
oFileStream.Close()

strHashData = System.BitConverter.ToString(arrbytHashValue)
strHashData = strHashData.Replace("-", "")
strResult = strHashData
Catch ex As System.Exception
MsgBox("Error!")
End Try

Return (strResult)
End Function
[/highlight]

Then

[highlight=vb]
'////gets the file location then gets the md5 of that file then pastes it on textbox2
TextBox2.Text = GetMD5Hash(TextBox1.Text)
[/highlight]

Still dead huh?

well here:

How too add a custom cursor:
{all I ask is some credit if you use it maybe 0.01%?}

Code:

Imports System.Runtime.InteropServices

    <DllImport("user32.dll")> _
    Private Shared Function LoadCursorFromFile(ByVal path As String) As IntPtr
    End Function

        'form load?
        Dim DDcursor As String = The location of your cursor file
        Try
            Me.Cursor = New Cursor(LoadCursorFromFile(DDcursor))
        Catch ex As Exception
        'credits internet?
        End Try

There are quite a few tutorials on youtube how to make on in vb with vb express 2010.

Here's probably what 90% you the browsers code looks like:
(semi-pseudo coded)

stop button{
webbrowser1.stop()
}

refresh button{
webbrowser1.refresh()
}

go button{
webbrowser1.navigate(textbox1.text)
}

back button{
webbrowser1.back()
}

forward button{
webbrowser1.forward()
}

--------------

------------------
The ability to use a proxy is cool

I have code here:

Code:

#Region "Using Proxy"
    <Runtime.InteropServices.DllImport("wininet.dll", SetLastError:=True)> _
    Private Shared Function InternetSetOption(ByVal hInternet As IntPtr, ByVal dwOption As Integer, ByVal lpBuffer As IntPtr, ByVal lpdwBufferLength As Integer) As Boolean
    End Function

    Public Structure Struct_INTERNET_PROXY_INFO
        Public dwAccessType As Integer
        Public proxy As IntPtr
        Public proxyBypass As IntPtr
    End Structure

    Private Sub UseProxy(ByVal strProxy As String)
        Const INTERNET_OPTION_PROXY As Integer = 38
        Const INTERNET_OPEN_TYPE_PROXY As Integer = 3

        Dim struct_IPI As Struct_INTERNET_PROXY_INFO

        struct_IPI.dwAccessType = INTERNET_OPEN_TYPE_PROXY
        struct_IPI.proxy = Marshal.StringToHGlobalAnsi(strProxy)
        struct_IPI.proxyBypass = Marshal.StringToHGlobalAnsi("local")

        Dim intptrStruct As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(struct_IPI))

        Marshal.StructureToPtr(struct_IPI, intptrStruct, True)

        Dim iReturn As Boolean = InternetSetOption(IntPtr.Zero, INTERNET_OPTION_PROXY, intptrStruct, System.Runtime.InteropServices.Marshal.SizeOf(struct_IPI))
    End Sub
#End Region

^you have to include interopServices to use that. That is NOT my code, I found it on youtube.

Cool stuff though.

[Snippet] Age Carculator

Don't wanna explain anything xd
Code will explain it =)

Code:

rb_by = Radiobutton birth year
rb_yo = Radiobutton years old

by_txt = Textbox birth year
yo_txt = Textbox years old

Code:

    Public Sub CarculateAge(ByVal currentyear As Long, ByVal bornyear As Long)
        If rb_by.Checked Then
            yo_txt.Text = currentyear - bornyear
        ElseIf rb_yo.Checked Then
            by_txt.Text = currentyear - yo_txt.Text
        End If
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Try
            CarculateAge(Year(Today), by_txt.Text)
        Catch ex As Exception
            MsgBox("The following error occoured: " & vbCrLf & ex.Data.ToString )
        End Try
    End Sub

    Private Sub rb_by_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rb_by.CheckedChanged
        If rb_by.Checked Then
            by_txt.ReadOnly = False
            yo_txt.ReadOnly = True
        ElseIf rb_yo.Checked Then
            by_txt.ReadOnly = True
            yo_txt.ReadOnly = False
        End If
    End Sub

Easy shit ^^
Enjoy

Toggle (CapsLock, ScrollLock, NumLock)

Code:

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)

Private Const VK_CAPITAL As Integer = &H14
Private Const VK_SCROLL As Integer = &H91
Private Const VK_NUMLOCK As Integer = &H90

Private Const KEYEVENTF_EXTENDEDKEY As Integer = &H1
Private Const KEYEVENTF_KEYUP As Integer = &H2

Code:

' Enabled
keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)
keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)
keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0)

' Disabled
keybd_event(VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
keybd_event(VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
keybd_event(VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)

Edited with code

Move a File

Code:

My.Computer.FileSystem.CopyFile("FileLocaion", "FileDestination")

Save Window Size Settings

Code:

If Me.WindowState = FormWindowState.Normal Then My.Settings.WindowSize = Me.Size End If

Save Windows Location

Code:

If Me.WindowState = FormWindowState.Normal Then My.Settings.WindowLocation = Me.Location End If

Loads a windows previous size from settings

Code:

If Not My.Settings.WindowSize.Width = 0 Then Me.Size = My.Settings.WindowSize End If

Loads Previous Locations From Settings

Code:

If Not My.Settings.WindowLocation.X = 0 Then Me.Location = My.Settings.WindowLocation End If

Auto Update Previous Version Settings

Code:

If My.Settings.CallUpgrade = True Then My.Settings.Upgrade() My.Settings.CallUpgrade = False End If

Minimize to tray

Form Load (Set Icon)

Code:

Me.NotifyIcon1.Icon = Me.Icon

Form Load, Set it true

Code:

Me.NotifyIcon1.Visible = true

VB Syntax for Minimizing to System Tray

Code:

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load NotifyIcon1.Visible = False End Sub Private Sub NotifyIcon1_MouseDoubleClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick Try Me.Show() Me.WindowState = FormWindowState.Normal NotifyIcon1.Visible = False Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize Try If Me.WindowState = FormWindowState.Minimized Then Me.WindowState = FormWindowState.Minimized NotifyIcon1.Visible = True Me.Hide() End If Catch ex As Exception MsgBox(ex.Message) End Try End Sub

Show Balloon Tip
(use on minimize, but can be adjusted for anything

Code:

notifyIcon1.ShowBalloonTip(3000, "Your App", ("Application has not closed" & DirectCast((13), [Char]) & "You can access it from System tray") + DirectCast((13), [Char]) & "Right click the Icon to exit.", ToolTipIcon . info

Save Checkbox Settings

Form Load

Code:

CheckBox1.Checked = GetSetting(Application.ProductName, Application.ProductName, "CheckBox1")

Form Closing

Code:

SaveSetting(Application.ProductName, Application.ProductName, "CheckBox1", CheckBox1.Checked)

This can be changed/modified for other components as well

Get and Save Settings

Get Setting:

Code:

MySettingValue = My.Settings.Default.SettingName

Code:

My.Settings.Default.SettingName = ConnString My.Settings.Save()

Send Input to Send Mouse Clicks

Declare

Code:

Public Structure MOUSEINPUT Public dx As Integer Public dy As Integer Public mouseData As Integer Public dwFlags As Integer Public dwtime As Integer

Code:

Code:

Public Sub MouseClick() Dim inputme(0) As INPUT_TYPE inputme(0).xi.dx = 0 inputme(0).xi.dy = 0 inputme(0).xi.mouseData = 0 inputme(0).xi.dwFlags = M_MOVE + M_LD + M_LU inputme(0).xi.dwtime = 0 inputme(0).xi.dwExtraInfo = 0 inputme(0).dwType = INPUT_MOUSE SendInput(1, inputme(0), Len(inputme(0))) SetCursorPos(xyC) End Sub

Get Windows Title

Declaration:This works with one textbox and one Button, But the code can be used where ever you like.

Code:

Dim mce As Boolean Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Module

Code:

Type POINTAPI x As Long y As Long End Type

Code

Code:

Private Sub Button1_Click() mse = True intRetVal = SetCapture(hwnd) End Sub Private Sub Form_Load() mse = False End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim window As Long Dim buffer As String * 1024 Dim ptPoint As POINTAPI If mse Then ptPoint.x = x ptPoint.y = y retval = ClientToScreen(hwnd, ptPoint) window = WindowFromPoint(ptPoint.x, ptPoint.y) lngRetVal = GetWindowText(window, buffer, 1024) Text1.Text = buffer End If End Sub

Play Wav File

Declarations

Code:

Public Const SND_ALIAS = &H10000 Public Const SND_ASYNC = &H1 Public Const SND_LOOP = &H8 Public Const SND_NOWAIT = &H2000 Public Const SND_SYNC = &H0

Code
(place in any event or trigger you like)

Code:

Dim sps As Long sps = sndPlaySound("location/file.wav", SND_SYNC)

Detect of computer has a wav compatible Sound Card...

Declarations

Code:

Private Declare Function waveOutGetNumDevs Lib "winmm" () As Long

Code

Code:

Dim w As Long w = waveOutGetNumDevs() If i > 0 Then (there would have to be atleast 1 sound card) MsgBox "Wav Compatible" Else MsgBox "Non Wav Comp." End If

A Collection Of UI Code Snippets to enhance your users interface.

Check Mouse Click

Code:

Dim clickd As String clickd = e.Button() Select Case clickd Case 2097152 '(right mouse Value) MsgBox("You Right Clicked") Case 1048576 '(left Mouse Value) MsgBox("You Left Clicked") End Select MsgBox(clicktext)

Disable (X) On form
(I have a full tutorial in my sig, but here is the code snippet, I wanted to include it in this list because it comes in handy)

Code:

Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As IntPtr, ByVal nPosition As Integer, ByVal wFlags As Long) As IntPtr Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As IntPtr, ByVal bRevert As Boolean) As IntPtr Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As IntPtr) As Integer Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As IntPtr) As Boolean Private Const MF_BYPOSITION = &H400 Private Const MF_REMOVE = &H1000 Private Const MF_DISABLED = &H2 Public Sub DisableCloseButton(ByVal hwnd As IntPtr) Dim hMenu As IntPtr Dim menuItemCount As Integer hMenu = GetSystemMenu(hwnd, False) menuItemCount = GetMenuItemCount(hMenu) Call RemoveMenu(hMenu, menuItemCount - 1, _ MF_DISABLED Or MF_BYPOSITION) Call RemoveMenu(hMenu, menuItemCount - 2, _ MF_DISABLED Or MF_BYPOSITION) Call DrawMenuBar(hwnd) End Sub

Add this to the event that will trigger the disable
Ex: Form Load, Setting , Menu Item , etc...

Code:

DisableCloseButton(Me.Handle)

Fade Out

This goes in a Non-Class are

Code:

Friend WithEvents fader As System.Windows.Forms.Timer

Call this to fade out

Code:

Public Sub fade() Me.fader = New System.Windows.Forms.Timer Me.fader.Enabled = True Me.fader.Interval = 30 End Sub

This is the actual fade

Code:

Private Sub fader_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles fader.Tick Me.Opacity -= 0.03 ('3% opacity, you can use anything youlike) ' this checks the opacity, it it is less then 5 then..end ' alot of people use 0, but I am doing it by 3% not by 1% , so check and ' see if it is less then 5 as opposed to = 0, however you can use any ' ' method you perfer, I just perfer this way (looks cleaner to me) If Me.Opacity < 2 Then End End If End Sub

Make form transparent while dragging
(this is and example of how checking the state of a mouse click can come in handy[above])

Code:

Private Const WM_NCLBUTTONDOWN As Long = &HA1 Private Const WM_NCLBUTTONUP As Long = &HA0 Private Const WM_MOVING As Long = &H216 Private Const WM_SIZE As Long = &H5 Protected Overrides Sub DefWndProc(ByRef m As System.Windows.Forms.Message) Static LButtonDown As Boolean (checks left click) If CLng(m.Msg) = WM_NCLBUTTONDOWN Then '(as long as left button is down LButtonDown returns true) LButtonDown = True ElseIf CLng(m.Msg) = WM_NCLBUTTONUP Then ' (As long as left button is up, LButtonDown returns false) LButtonDown = False End If If LButtonDown Then If CLng(m.Msg) = WM_MOVING Then 'Changes form opacity to 70% if the form is being dragged ' You can change the 0.7 to anything 0.1 = 10% 0.2 = 20 % and so on If Me.Opacity <> 0.9 Then Me.Opacity = 0.5 ElseIf CLng(m.Msg) = WM_SIZE Then 'Set the forms opacity to 60% if user is resizing the window If Me.Opacity <> 0.6 Then Me.Opacity = 0.6 End If ElseIf Not LButtonDown Then If Me.Opacity <> 1.0 Then Me.Opacity = 1.0 End If MyBase.DefWndProc(m) End Sub

Windows Shadow - (Tested in Xp)

Code:

Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams Get Const CS_DROPSHADOW = &H20000 Dim CrPa As CreateParams = MyBase.CreateParams CrPa.ClassStyle = CrPa.ClassStyle Or CS_DROPSHADOW Return CrPa End Get End Property

Snippets Part 3
I will Be adding more as I write them

Empty Recycling Bin

Declarations And Variables

Code:

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Int32, ByVal pszRootPath As String, ByVal dwFlags As Int32) As Int32 Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Int32 Private Const SHERB_NOCONFIRMATION = &H1 Private Const SHERB_NOPROGRESSUI = &H2 Private Const SHERB_NOSOUND = &H4

Empty Recycling Bin Sub

Code:

Private Sub takeoutthetrash() SHEmptyRecycleBin(Me.Handle.ToInt32, vbNullString, SHERB_NOCONFIRMATION + SHERB_NOSOUND) SHUpdateRecycleBinIcon() End Sub

Code to call the empty recycling bin sub

Code:

takeoutthetrash()

Add a Windows User

Add 3 TextBox's

Add 1 Button

TextBox1 will be for the new Username
Textbox2 will be the password field
Textbox3 will be the verify password field

Button_Click Event for button

Code:

Dim username As String = TextBox1.Text Dim password As String = TextBox2.Text 'Match the passwords, if they match, then add user If TextBox2.Text = TextBox3.Text Then Shell("net user " & username & " " & password & " /add") MessageBox.Show("Windows User Created) Else MessageBox.Show("Passwords are different") End If

Get Hardware Serial

Create a New Class and add this code

Code:

Public Class HardDrive Private dsk_model As String Private dsk_type As String Private dsk_serialNo As String Public Property Model() As String Get Return dsk_model End Get Set(ByVal value As String) dsk_model = value End Set End Property Public Property Type() As String Get Return dsk_type End Get Set(ByVal value As String) dsk_type = value End Set End Property Public Property serialNo() As String Get Return dsk_serialNo End Get Set(ByVal value As String) dsk_serialNo = value End Set End Property End Class

Now Add a textbox to your form, set it to multiline=true

View Code

In the namespace

Code:

Imports System Imports System.Collections Imports System.Management

Variables and Declarations

'Dim appname as system.STATthreadattribute()
Dim WindowsApplication1 As System.STAThreadAttribute()

In Form1 Load add

Code:

Dim SerialHD As New ArrayList() Dim Obsearch As New ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive") Dim HDinfo As New ManagementObject() For Each HDinfo In Obsearch.Get Dim hd As New Class1.HardDrive() hd.Model = HDinfo("Model").ToString() hd.Type = HDinfo("InterfaceType").ToString() SerialHD.Add(hd) Next Dim searcher1 As New ManagementObjectSearcher("SELECT * FROM Win32_PhysicalMedia") Dim i As Integer = 0 For Each HDinfo In searcher1.Get() Dim hd As Class1.HardDrive hd = SerialHD(i) If HDinfo("SerialNumber") = "" Then hd.serialNo = "None" Else hd.serialNo = HDinfo("SerialNumber").ToString() i += 1 End If Next Dim hd1 As Class1.HardDrive Dim ii As Integer = 0 For Each hd1 In SerialHD ii += 1 TextBox1.Text = TextBox1.Text + "Serial No: " + hd1.serialNo + Chr(13) + Chr(10) + Chr(13) + Chr(10) Next

Clear All Controls in a Form (MSDN Standard CODE)

Code:

For Each objControls As Control In Me.Controls If TypeOf objControls Is TextBox Then CType(objControls, TextBox).Text = String.Empty End If If TypeOf objControls Is DropDownList Then If Not CType(objControls, DropDownList).ID.Contains("ddlUSTYear") Then CType(objControls, DropDownList).SelectedIndex = 0 End If End If If TypeOf objControls Is CheckBox Then CType(objControls, CheckBox).Checked = False End If If TypeOf objControls Is RadioButton Then CType(objControls, RadioButton).Checked = False End If Next

Read File Content

Code:

Public Shared Function ReadFileContent(ByVal sFile As String) As String Dim GetFileC As String = String.Empty If File.Exists(sFile) Then Dim ActualC As StreamReader = File.OpenText(sFile) Try ActualC = File.OpenText(sFile) GetFileC = ActualC.ReadToEnd() Catch exp As Exception Throw ex Finally If Not Nothing Is ActualC Then ActualC.Close() End If End Try End If Return GetFileC End Function

To Call it Use

ReadFileContent ("File Location")

Get File Extension

Code:

Public Shared Function GetExtension(ByVal strFileName As String) As String If (strFileName.Length > 0) Then stringDoc = strFileName.Split(characterA) Return "." + stringDoc(stringDoc.Length - 1) Else Return "" End If End Function

To use Call the Function

GetExtension ("File Location and Name")

Prevent Pasting in a Textbox with Ctrl + V

Code:

' This is Used in the Keypressed method, You can use the same concept on click , or Mouse Click, etc.... Private Sub TextBox1_KeyPress(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress System.Windows.Forms.Clipboard.Clear() End Sub

Random Password String From GUID

Code:

Public Function GetRandomPasswordUsingGUID1(ByVal length As Double) As String Dim GR As String = System.Guid.NewGuid.ToString GR = GR.Replace("-", String.Empty) If length <= 0 OrElse length > GR.Length Then Throw New ArgumentException("Length should be between 1 and " & GR.Length) End If Return GR.Substring(0, length) End Function

Use, (Sim liar to SOAP WSDL API, or Web Services in ASP.net)

GetRandomPasswordUsingGUID1(Legth Of Password)

Example

Button_Click Event

MsgBox(GetRandomPasswordUsingGUID1(25)

Encrypt Text

Code:

Public Function EnDeCrypt(ByVal Text As String) As String Dim TCr As String = "", i As Integer For i = 1 To Len(Text) If Asc(Mid$(Text, i, 1)) < 128 Then TCr = CType(Asc(Mid$(Text, i, 1)) + 128, String) ElseIf Asc(Mid$(Text, i, 1)) > 128 Then TCr = CType(Asc(Mid$(Text, i, 1)) - 128, String) End If Mid$(Text, i, 1) = Chr(CType(TCr, Integer)) Next i Return Text

To use

MsgBox (EnDecrypt("Word to encrypt")

Example:

Msgbox (Endecrypt("Food")

Will encrypt the word food, you can use this in whole textbox's etc.

Get List Of Installed Printers on your machine

Add a Combo-Box to your form

In Namespace

[code]
Imports System.Drawing

Form Load Event

<<<@!14!@>>>

Force Application To Require Admin Approval

Show All files in your Solutions Explorer

Navigate to the Bin Folder ----> Debug ----> Applicationname.Vshost.exe.Manifest File

Double Click it and

add this code

<<<@!15!@>>>

Replacing it with the existing code

or

Use the existing code

Code:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" name="MyApplication.app"/> <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2"> <security> <requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3"> <requestedExecutionLevel level="asInvoker" uiAccess="false"/> </requestedPrivileges> </security> </trustInfo> </assembly>

The information is as follows

requireAdministrator:
highestAvailable:
asInvoker: Vb.net Default

So for this particular case it would be

Code:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" name="MyApplication.app"/> <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2"> <security> <requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3"> <requestedExecutionLevel level="requireAdministrator:" uiAccess="false"/> </requestedPrivileges> </security> </trustInfo> </assembly>

Change Background Color of Form with Color Dialog

Add a Color Dialog Box to your Form
Add a button

on button click Event

Code:

Dim Bcolor As New ColorDialog() Bcolor.ShowDialog() Me.BackColor = Bcolor.Color

Print a Textbox

* Every where I go , I see all this complex code, and all these Imports and just ugly code, I think a rumor started along time ago that printing a single textbox was hard and required system.drawing and ever since then, everyone just copied and pasted everyone else's code and slightly modified it and called it as thier own. I am here to break that rumor

Simple Print TextBox 1

Code:

PrintDocument1.PrinterSettings.Copies = 1 PrintDocument1.Print()

Then Add this

Code:

Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage e.Graphics.DrawString(TextBox1.Text, TextBox1.Font, Brushes.Blue, 100, 100) End Sub

Here is how to Create your own sleep method which will pause what you want to pause, but still allow the application to function

Code:

Private Sub Sleep(ByVal PauseTime As Double) Dim Tind As Int16 For Tind = 1 To PauseTime / 50 Threading.Thread.Sleep(50) Application.DoEvents() Next End Sub

Note: the Application.DoEvents Will allow your application to function normally during sleep

Now you can call a "proper" Sleep

Code:

Sleep(time to sleep)

Changing XML Node Values

Code:

Dim root As XElement = XElement.Load("Location\Filename.xml") Dim xt As XElement = (From el In root.Descendants("Node1") _ Select el).First() xt.SetValue("New Value") root.Save("Location\Filename.xml")

You can do this dynamically as well by using the value fields with combo-box data or textbox values, etc.

Create A Tab Delimited Text File with listcheckedbox

I notated everything to help you get the basic understanding, Hope this works without special encoding. (as far as the .gct is concerned)

Using ChecklistBox

---- Add Two Buttons
---- Add One TextBox
--- Add One CheckedListBox

Button 1 Text should be - Add
Button 2 Text should be - Save as .GCT

Button One Click Event

' This adds the item of textbox1.text to your checkedlistbox

Code:

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click CheckedListBox1.Items.Add(TextBox1.Text) End Sub

Button Two Click Event
' This Calls the sub SaveCheckedlistBox which will save the checked list box of your choice
' The format is SaveCBox(clb)
' CLB = the name of the checkedlistbox you want to save as tab delimited

Code:

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click SaveCBox(CheckedListBox1) End Sub

Now add this code below the above

' This is the part of the sub that saves the checked listbox as a .GCT Text file, with tabbed delimited format

Code:

Private Sub SaveCBox(ByVal clb As CheckedListBox) ' Declares Save dialog as a new instance of Save File Dialog Dim SaveDialog As New SaveFileDialog ' Allows us to add extensions, if this is false then extensions would be *.* All Files SaveDialog.AddExtension = True ' The default extension is set to .GCT (the format you are looking for) SaveDialog.DefaultExt = ".gct" ' This sets the save as combo-box items ' The Format is "Description|Extension" SaveDialog.Filter = "GCT Files|*.GCT|All Files|*.*" SaveDialog.FilterIndex = 0 ' Sets the Text on the Title SaveDialog.Title = "Save List Box as GCT" ' Saves the listcheckedbox as a .gct in tab delimited format. If SaveDialog.ShowDialog = DialogResult.OK Then Dim sw As New System****.StreamWriter(SaveDialog.FileName) For i As Integer = 0 To clb.Items.Count - 1 Dim t As Boolean = clb.GetItemChecked(i) sw.WriteLine(clb.Items(i).ToString & ControlChars.Tab & t.ToString) Next sw.Close() End If SaveDialog.Dispose() End Sub

Run Application from Resources

Name Space

Code:

Imports System****

Now this in a button click (or whet ever triggers the event)

Code:

Dim RPath As String = Application.StartupPath & "\File.exe" 'File.exe will be a temp name given to your exe, you can make it anything you want, or keep it as is. ' Will create the file with the given name Using CreateFile As New FileStream(RPath, FileMode.Create) CreateFile.Write(My.Resources.YourResource, 0, My.Resources.YourResource.Length) End Using ' Start the application Process.Start(RPath)

Note: "Your Resource" in my code example above needs to be the EXE name without the exe extension, so for example, if you add notepad.exe as a resource, then the code would be

Code:

Dim RPath As String = Application.StartupPath & "\File.exe" Using CreateFile As New FileStream(RPath, FileMode.Create) CreateFile.Write(My.Resources.Notepad, 0, My.Resources.Notepad.Length) End Using Process.Start(RPath)

Opening and saving .txt files
Visual Basic Programming - MPGH - MultiPlayer Game Hacking

Using SAPI/Making your computer "Speak":
Visual Basic Programming - MPGH - MultiPlayer Game Hacking

Visual Basic .Net RunDll32 Commands

Display the BlueScreen Of Death

Code:

Shell ("rundll32 user,disableoemlayer")

'Open Control Panel

Code:

Shell("rundll32.exe shell32.dll Control_RunDLL")

'Add Or Remove Programs

Code:

Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1")

'Turn Off Computer

Code:

Shell ("Rundll32.exe user32.dll,LockWorkStation")

'Load Mouse Properties

Code:

Shell ("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @0")

'Keyboard Properties

Code:

Shell("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @1")

'Printer Properties

Code:

Shell( "Rundll32.exe shell32.dll,Control_RunDLL main.cpl @2")

'Fonts Folder

Code:

Shell ("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @3")

'Internet Properties

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,5")

'Keyboard Accessibility

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1")

'Sound / Accessibility

Code:

Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2")

Display Accessibility

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3")

'Display Settings

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0")

Screen Saver

Code:

Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1")

Internet Security

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,1")

Display Properties Window

Code:

Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl")

Networking

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl")

System Properties

Code:

Shell ("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl")

Lock the Keyboard

Code:

Shell ("rundll32.exe keyboard,disable")

Disable the Mouse

Code:

Shell ("rundll32.exe mouse,disable")

Swap Mouse Buttons (left = right and vice Versa )

Code:

Shell ("rundll32.exe user.dll,swapmousebutton")

Shut Down Computer

Code:

Shell ("rundll32.exe shell32.exe,SHExitWindowsEx 1")

Log Off

Code:

Shell ("rundll32.exe shell32.exe,SHExitWindowsEx 0")

Activate a Running Process By Name

Code:

AppActivate("Untitled - Notepad")

Activate Running Process by id

Code:

Dim processID As Integer processID = Shell("NOTEPAD.EXE", AppWinStyle.NormalFocus) AppActivate(processID)

SendKeys To application

Code:

SendKeys.SendWait("{ENTER}")

Write to application log file.

Code:

My.Application.Log.WriteEntry("Entry Here")

Define a Structure

Code:

Structure MyStructure Public ValueOne As Integer Public ValueTwo As Boolean End Structure

Sound

Loop a Sound

Code:

My.Computer.Audio.Play("SoundFile.wav", AudioPlayMode.BackgroundLoop)

Play Sound

Code:

My.Computer.Audio.Play("ringout.wav", AudioPlayMode.WaitToComplete)

Stop Playing Sound

Code:

My.Computer.Audio.Stop()

Code:

' Use a Graphics object to measure the button's text. Then add blanks to leave space on either side. Dim surface As Graphics = Button1.CreateGraphics Dim textSize As SizeF = surface.MeasureString(" " & Button1.Text & " ", Button1.Font) surface.Dispose() Button1.Width = CInt(textSize.Width)

Create a Pen

Code:

Dim myPen As System.Drawing.Pen myPen = New System.Drawing.Pen(Color.Black)

Display a animated Gif

Code:

PictureBox1.Image() = Image.FromFile("gifname.gif")

_______________

Convert Mouse Coordinates to screen coordinates

Code:

Private Sub Me_MouseDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.MouseEventArgs) _ Handles Me.MouseDown Dim screenPoint As Point screenPoint = Me.PointToScreen(New Point(e.X, e.Y)) End Sub

Create a Transparent form

Code:

frmTransparentForm.Opacity = 0.90

Determine modifier key pressed

Code:

Private Sub Me_KeyPress(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress If (Control.ModifierKeys And Keys.Shift) = Keys.Shift Then End If End Sub

Remove Title Bar

Code:

Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None

Create Email Message

Code:

Dim message As New MailMessage("sender@address", "from@address", "Subject", "Message Text") Dim emailClient As New SmtpClient("Email Server Name") emailClient.Send(message)

Use Serial Port To Dial A Number

Code:

Using comPort As SerialPort = My.Computer.Ports.OpenSerialPort("COM1", 2400) comPort.DtrEnable = True comPort.Write("555-555-5455" & vbCrLf) End Using

____________

Search Files for an expression

Code:

Dim files As ReadOnlyCollection(Of String) files = My.Computer.FileSystem.FindInFiles("C:\", "what you are looking for goes in here IE Food", True, FileIO.SearchOption.SearchAllSubDirectories, "*.txt")

_________________________________

A more advanced basic spammer

Add 2 Text boxes and one button

Name Space
- I notated everything

Code:

'Used to import COM and Invoke services , needed for DLL Import Imports System****ntime.InteropServices

Functions (just below public call formname

Code:

' This function will allow us to get a window and find it, by window name ' You can use this anytime you need to find a window by window name for any reason <DllImport("USER32.DLL", CharSet:=CharSet.Unicode)> _ Public Shared Function WindowName(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr End Function

and below that

Code:

' This function will allow us set the foreground window ' This will bring the window we need to send the keystrokes to upfront <DllImport("USER32.DLL")> _ Public Shared Function UpFront(ByVal hWnd As IntPtr) As Boolean End Function

On the button click event

Code:

' when you use try, it litterly means "attempt the following code before catch, if the "code is unseccesful" ' then catch the exception and display it in a message box , you can use list boxes for storing errors in a database ' but that is a little more advaced Try ' (apph = name I have chosen for the declaration, you can choose any thing you wish) ' Declaring AppH as IntPtr which is used represent a pointer or a handle, in this case we are setting = to windowname ' which is a function I created above to set the window to sendkeys to, the format is ' (ByVal lpClassName As String, ByVal lpWindowName As String) ' I Use Nothing as the IPclassname, if you know the IPclassname you can use it. ' In textbox1 you can add the name of the window to check for 'lets use notepad, the name of a unnamed notepad is Unitled - Notepad ' so if you were to open notepad without a given name, and put Unitled - Notepad in textbox1 'this would continue and function, if not you will get an error Dim AppH As IntPtr = WindowName(Nothing, TextBox1.Text) 'IntPtr is a set value so if the value is 0 [window name is wrong or not a open application, error]) If AppH = IntPtr.Zero Then MsgBox("Chosen Application is not Running") Return End If ' If successful bring the window to the foreground UpFront(AppH) 'sendkeys the content of textbox2 SendKeys.SendWait(TextBox2.Text) Catch ex As Exception MsgBox(ex.Message) End Try

• Gives noborder style a shadow

Code:

    Public CS_DROPSHADOW As Int32 = &H20000

    Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams
        Get
            Dim parameters As CreateParams = MyBase.CreateParams
            parameters.ClassStyle += CS_DROPSHADOW
            Return parameters
        End Get
    End Property

• Rounds the corners of your noborder style

Code:

'credits internet?
            Dim radius As Integer = 4
    Private Sub RoundMyCorners()
        Dim frmToRnd As System.Windows.Forms.Form = Me
        Dim regionRects(radius * 2 + 2) As System.Drawing.Rectangle
        Dim circle As New Bitmap(radius * 2, radius * 2)
        Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(circle)

        g.Clear(Color.White)
        g.FillEllipse(Brushes.Black, 0, 0, circle.Width, circle.Height)

        Dim col As Integer = 0
        For row As Integer = 0 To radius - 1
            For col = 0 To radius - 1
                If circle.GetPixel(col, row) <> System.Drawing.Color.FromArgb(255, 255, 255, 255) Then Exit For
            Next
            regionRects(row * 2) = New System.Drawing.Rectangle(col, row, frmToRnd.Width - 2 * col, 1)
            regionRects(row * 2 + 1) = New System.Drawing.Rectangle(col, frmToRnd.Height - row - 1, frmToRnd.Width - 2 * col, 1)
        Next

        regionRects(radius * 2 + 2) = New System.Drawing.Rectangle(0, radius, frmToRnd.Width, frmToRnd.Height - circle.Height)

        Dim myPath As New Drawing2D.GraphicsPath
        myPath.AddRectangles(regionRects)
        frmToRnd.Region = New Region(myPath)

        'Clean Up.
        myPath.Dispose()
        circle.Dispose()
        g.Dispose()
    End Sub

Posts 61–75 of 113 · Page 5 of 8

14568

Tags for this Thread

None

Snippets Vault

Post a Reply

Tags for this Thread