Oct 09

Code snippet to wait a thread without making it freeze vb.net source code

If you use the normal “threading.sleep” it will hang the GUI and probably make the program unstable. This function can be used to wait a thread as long as you want.

Private Sub wait(ByVal interval As Integer)
Dim sw As New Stopwatch
sw.Start()
Do While sw.ElapsedMilliseconds < interval
' Allows UI to remain responsive
Application.DoEvents()
Loop
sw.Stop()
End Sub

Usage :

wait(5000) ‘will make the thread wait for 5 seconds.

Oct 09

Custom theme for your vb.net application + complete source code in vb.net

 

 

Imports System.Drawing.Drawing2D
Imports System.ComponentModel

Enum MouseState As Byte
None = 0
Over = 1
Down = 2
Block = 3
End Enum

Module Draw
Public Function RoundRect(ByVal Rectangle As Rectangle, ByVal Curve As Integer) As GraphicsPath
Dim P As GraphicsPath = New GraphicsPath()
Dim ArcRectangleWidth As Integer = Curve * 2
P.AddArc(New Rectangle(Rectangle.X, Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), -180, 90)
P.AddArc(New Rectangle(Rectangle.Width – ArcRectangleWidth + Rectangle.X, Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), -90, 90)
P.AddArc(New Rectangle(Rectangle.Width – ArcRectangleWidth + Rectangle.X, Rectangle.Height – ArcRectangleWidth + Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), 0, 90)
P.AddArc(New Rectangle(Rectangle.X, Rectangle.Height – ArcRectangleWidth + Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), 90, 90)
P.AddLine(New Point(Rectangle.X, Rectangle.Height – ArcRectangleWidth + Rectangle.Y), New Point(Rectangle.X, Curve + Rectangle.Y))
Return P
End Function
Public Function RoundRect(ByVal X As Integer, ByVal Y As Integer, ByVal Width As Integer, ByVal Height As Integer, ByVal Curve As Integer) As GraphicsPath
Dim Rectangle As Rectangle = New Rectangle(X, Y, Width, Height)
Dim P As GraphicsPath = New GraphicsPath()
Dim ArcRectangleWidth As Integer = Curve * 2
P.AddArc(New Rectangle(Rectangle.X, Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), -180, 90)
P.AddArc(New Rectangle(Rectangle.Width – ArcRectangleWidth + Rectangle.X, Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), -90, 90)
P.AddArc(New Rectangle(Rectangle.Width – ArcRectangleWidth + Rectangle.X, Rectangle.Height – ArcRectangleWidth + Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), 0, 90)
P.AddArc(New Rectangle(Rectangle.X, Rectangle.Height – ArcRectangleWidth + Rectangle.Y, ArcRectangleWidth, ArcRectangleWidth), 90, 90)
P.AddLine(New Point(Rectangle.X, Rectangle.Height – ArcRectangleWidth + Rectangle.Y), New Point(Rectangle.X, Curve + Rectangle.Y))
Return P
End Function
End Module

Public Class VisceralButton : Inherits Control
#Region ” MouseStates ”
Dim State As MouseState = MouseState.None
Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
State = MouseState.Down : Invalidate()
End Sub
Protected Overrides Sub OnMouseUp(e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseUp(e)
State = MouseState.Over : Invalidate()
End Sub
Protected Overrides Sub OnMouseEnter(e As System.EventArgs)
MyBase.OnMouseEnter(e)
State = MouseState.Over : Invalidate()
End Sub
Protected Overrides Sub OnMouseLeave(e As System.EventArgs)
MyBase.OnMouseLeave(e)
State = MouseState.None : Invalidate()
End Sub
#End Region

Sub New()
SetStyle(ControlStyles.UserPaint Or ControlStyles.SupportsTransparentBackColor, True)
BackColor = Color.Transparent
DoubleBuffered = True
End Sub

Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
Dim ClientRectangle As New Rectangle(0, 0, Width – 1, Height – 1)

MyBase.OnPaint(e)

G.Clear(BackColor)
Dim drawFont As New Font(“Arial”, 8, FontStyle.Bold)
Select Case State
Case MouseState.None
Dim lgb As New LinearGradientBrush(ClientRectangle, Color.FromArgb(61, 61, 63), Color.FromArgb(14, 14, 14), 90S)
G.FillPath(lgb, Draw.RoundRect(ClientRectangle, 3))
Dim gloss As New LinearGradientBrush(New Rectangle(0, 0, Width – 1, Height / 2), Color.FromArgb(100, Color.FromArgb(61, 61, 63)), Color.FromArgb(12, 255, 255, 255), 90S)
G.FillPath(gloss, Draw.RoundRect(New Rectangle(0, 0, Width – 1, Height / 2), 3))
G.DrawPath(Pens.Black, Draw.RoundRect(ClientRectangle, 3))
G.DrawString(Text, drawFont, New SolidBrush(ForeColor), New Rectangle(0, 0, Width – 1, Height – 1), New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Case MouseState.Over
Dim lgb As New LinearGradientBrush(ClientRectangle, Color.FromArgb(245, 61, 61, 63), Color.FromArgb(245, 14, 14, 14), 90S)
G.FillPath(lgb, Draw.RoundRect(ClientRectangle, 3))
Dim gloss As New LinearGradientBrush(New Rectangle(0, 0, Width – 1, Height / 2), Color.FromArgb(75, Color.FromArgb(61, 61, 63)), Color.FromArgb(20, 255, 255, 255), 90S)
G.FillPath(gloss, Draw.RoundRect(New Rectangle(0, 0, Width – 1, Height / 2), 3))
G.DrawPath(Pens.Black, Draw.RoundRect(ClientRectangle, 3))
G.DrawString(Text, drawFont, New SolidBrush(ForeColor), New Rectangle(0, 0, Width – 1, Height – 1), New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Case MouseState.Down
Dim lgb As New LinearGradientBrush(ClientRectangle, Color.FromArgb(51, 51, 53), Color.FromArgb(4, 4, 4), 90S)
G.FillPath(lgb, Draw.RoundRect(ClientRectangle, 3))
Dim gloss As New LinearGradientBrush(New Rectangle(0, 0, Width – 1, Height / 2), Color.FromArgb(75, Color.FromArgb(61, 61, 63)), Color.FromArgb(5, 255, 255, 255), 90S)
G.FillPath(gloss, Draw.RoundRect(New Rectangle(0, 0, Width – 1, Height / 2), 3))
G.DrawPath(Pens.Black, Draw.RoundRect(ClientRectangle, 3))
G.DrawString(Text, drawFont, New SolidBrush(ForeColor), New Rectangle(0, 0, Width – 1, Height – 1), New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
End Select

e.Graphics.DrawImage(B.Clone(), 0, 0)
G.Dispose() : B.Dispose()
End Sub
End Class

Public Class VisceralTheme : Inherits ContainerControl
Sub New()
SetStyle(ControlStyles.UserPaint Or ControlStyles.SupportsTransparentBackColor, True)
BackColor = Color.FromArgb(25, 25, 25)
DoubleBuffered = True
End Sub
Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
Dim TopBar As New Rectangle(0, 0, Width – 1, 30)
Dim Body As New Rectangle(0, 10, Width – 1, Height – 1)

MyBase.OnPaint(e)

G.Clear(Color.Fuchsia)

‘G.SmoothingMode = SmoothingMode.HighQuality

Dim lbb As New LinearGradientBrush(Body, Color.FromArgb(19, 19, 19), Color.FromArgb(17, 17, 17), 90S)
Dim bodyhatch As New HatchBrush(HatchStyle.DarkUpwardDiagonal, Color.FromArgb(20, 20, 20), Color.Transparent)
G.FillPath(lbb, Draw.RoundRect(Body, 5))
G.FillPath(bodyhatch, Draw.RoundRect(Body, 5))
G.DrawPath(Pens.Black, Draw.RoundRect(Body, 5))

Dim lgb As New LinearGradientBrush(TopBar, Color.FromArgb(60, 60, 62), Color.FromArgb(25, 25, 25), 90S)
‘Dim tophatch As New HatchBrush(HatchStyle.DarkUpwardDiagonal, Color.FromArgb(20, 20, 20), Color.Transparent)
G.FillPath(lgb, Draw.RoundRect(TopBar, 4))
‘G.FillPath(tophatch, Draw.RoundRect(TopBar, 4))
G.DrawPath(Pens.Black, Draw.RoundRect(TopBar, 4))
G.DrawString(Text, Font, New SolidBrush(ForeColor), New Rectangle(33, 0, Width – 1, 30), New StringFormat() With {.Alignment = StringAlignment.Near, .LineAlignment = StringAlignment.Center})

G.DrawIcon(FindForm.Icon, New Rectangle(11, 8, 16, 16))

e.Graphics.DrawImage(B.Clone(), 0, 0)
G.Dispose() : B.Dispose()
End Sub

Private MouseP As Point = New Point(0, 0)
Private Cap As Boolean = False
Private MoveHeight% = 30 : Private pos% = 0
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
If e.Button = Windows.Forms.MouseButtons.Left And New Rectangle(0, 0, Width, MoveHeight).Contains(e.Location) Then
Cap = True : MouseP = e.Location
End If
End Sub
Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseUp(e) : Cap = False
End Sub
Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseMove(e)
If Cap Then
Parent.Location = MousePosition – MouseP
End If
End Sub

Protected Overrides Sub OnCreateControl()
MyBase.OnCreateControl()
Me.ParentForm.FormBorderStyle = FormBorderStyle.None
Me.ParentForm.TransparencyKey = Color.Fuchsia
Dock = DockStyle.Fill
End Sub
End Class

Public Class VisceralTextBox : Inherits Control
Dim WithEvents txtbox As New TextBox

#Region ” Control Help – Properties & Flicker Control ”
Private _passmask As Boolean = False
Public Shadows Property UseSystemPasswordChar() As Boolean
Get
Return _passmask
End Get
Set(ByVal v As Boolean)
txtbox.UseSystemPasswordChar = UseSystemPasswordChar
_passmask = v
Invalidate()
End Set
End Property
Private _maxchars As Integer = 32767
Public Shadows Property MaxLength() As Integer
Get
Return _maxchars
End Get
Set(ByVal v As Integer)
_maxchars = v
txtbox.MaxLength = MaxLength
Invalidate()
End Set
End Property
Private _align As HorizontalAlignment
Public Shadows Property TextAlignment() As HorizontalAlignment
Get
Return _align
End Get
Set(ByVal v As HorizontalAlignment)
_align = v
Invalidate()
End Set
End Property

Protected Overrides Sub OnPaintBackground(ByVal pevent As System.Windows.Forms.PaintEventArgs)
End Sub
Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
MyBase.OnTextChanged(e)
Invalidate()
End Sub
Protected Overrides Sub OnBackColorChanged(ByVal e As System.EventArgs)
MyBase.OnBackColorChanged(e)
txtbox.BackColor = BackColor
Invalidate()
End Sub
Protected Overrides Sub OnForeColorChanged(ByVal e As System.EventArgs)
MyBase.OnForeColorChanged(e)
txtbox.ForeColor = ForeColor
Invalidate()
End Sub
Protected Overrides Sub OnFontChanged(ByVal e As System.EventArgs)
MyBase.OnFontChanged(e)
txtbox.Font = Font
End Sub
Protected Overrides Sub OnGotFocus(ByVal e As System.EventArgs)
MyBase.OnGotFocus(e)
txtbox.Focus()
End Sub
Sub TextChngTxtBox() Handles txtbox.TextChanged
Text = txtbox.Text
End Sub
Sub TextChng() Handles MyBase.TextChanged
txtbox.Text = Text
End Sub
Sub NewTextBox()
With txtbox
.Multiline = False
.BackColor = Color.FromArgb(43, 43, 43)
.ForeColor = ForeColor
.Text = String.Empty
.TextAlign = HorizontalAlignment.Center
.BorderStyle = BorderStyle.None
.Location = New Point(5, 4)
.Font = New Font(“Trebuchet MS”, 8.25F, FontStyle.Bold)
.Size = New Size(Width – 10, Height – 11)
.UseSystemPasswordChar = UseSystemPasswordChar
End With

End Sub
#End Region

Sub New()
MyBase.New()

NewTextBox()
Controls.Add(txtbox)

Text = “”
BackColor = Color.FromArgb(15, 15, 15)
ForeColor = Color.Silver
Size = New Size(135, 35)
DoubleBuffered = True
End Sub

Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
G.SmoothingMode = SmoothingMode.HighQuality
Dim ClientRectangle As New Rectangle(0, 0, Width – 1, Height – 1)

Height = txtbox.Height + 11
With txtbox
.Width = Width – 10
.TextAlign = TextAlignment
.UseSystemPasswordChar = UseSystemPasswordChar
End With

G.Clear(BackColor)

G.FillRectangle(New SolidBrush(Color.FromArgb(10, 10, 10)), ClientRectangle)
G.DrawRectangle(New Pen(Color.FromArgb(53, 57, 60)), ClientRectangle)

e.Graphics.DrawImage(B.Clone(), 0, 0)
G.Dispose() : B.Dispose()
End Sub
End Class

Public Class VisceralGroupBox : Inherits ContainerControl

Private _ImageSize As Size
Protected ReadOnly Property ImageSize() As Size
Get
Return _ImageSize
End Get
End Property

Private _Image As Image
Property Image() As Image
Get
Return _Image
End Get
Set(ByVal value As Image)
If value Is Nothing Then
_ImageSize = Size.Empty
Else
_ImageSize = value.Size
End If

_Image = value
Invalidate()
End Set
End Property

Sub New()
SetStyle(ControlStyles.UserPaint Or ControlStyles.SupportsTransparentBackColor, True)
BackColor = Color.Transparent
DoubleBuffered = True
End Sub
Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
Dim TopBar As New Rectangle(10, 0, 130, 25)
Dim box As New Rectangle(0, 0, Width – 1, Height – 10)

MyBase.OnPaint(e)

G.Clear(Color.Transparent)

G.SmoothingMode = SmoothingMode.HighQuality

Dim bodygrade As New LinearGradientBrush(ClientRectangle, Color.FromArgb(15, 15, 15), Color.FromArgb(22, 22, 22), 120S)
G.FillPath(bodygrade, Draw.RoundRect(New Rectangle(1, 12, Width – 3, box.Height – 1), 1))

Dim outerBorder As New LinearGradientBrush(ClientRectangle, Color.DimGray, Color.Gray, 90S)
G.DrawPath(New Pen(outerBorder), Draw.RoundRect(New Rectangle(1, 12, Width – 3, Height – 13), 1))
Dim outerBorder2 As New LinearGradientBrush(ClientRectangle, Color.FromArgb(0, 0, 0), Color.FromArgb(0, 0, 0), 90S)
G.DrawPath(New Pen(outerBorder2), Draw.RoundRect(New Rectangle(2, 13, Width – 5, Height – 15), 1))
‘Dim outerBorder3 As New LinearGradientBrush(ClientRectangle, Color.FromArgb(0, 0, 0), Color.FromArgb(0, 0, 0), 90S)
‘G.DrawPath(New Pen(outerBorder2), Draw.RoundRect(New Rectangle(3, 14, Width – 7, Height – 17), 1))

Dim lbb As New LinearGradientBrush(TopBar, Color.FromArgb(30, 30, 32), Color.FromArgb(25, 25, 25), 90S)
G.FillPath(lbb, Draw.RoundRect(TopBar, 1))

G.DrawPath(Pens.DimGray, Draw.RoundRect(TopBar, 2))

If Not Image Is Nothing Then
G.InterpolationMode = InterpolationMode.HighQualityBicubic
G.DrawImage(Image, New Rectangle(TopBar.Width – 115, 5, 16, 16))
G.DrawString(Text, Font, Brushes.White, 35, 5)
Else
G.DrawString(Text, Font, New SolidBrush(Color.White), TopBar, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
End If

e.Graphics.DrawImage(B.Clone(), 0, 0)
G.Dispose() : B.Dispose()
End Sub
End Class

Public Class VisceralControlBox : Inherits Control
#Region ” MouseStates ”
Dim State As MouseState = MouseState.None
Dim X As Integer
Dim MinBtn As New Rectangle(0, 0, 35, 20)
Dim CloseBtn As New Rectangle(35, 0, 35, 20)
Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
If X > MinBtn.X And X < MinBtn.X + 35 Then FindForm.WindowState = FormWindowState.Minimized Else FindForm.Close() End If State = MouseState.Down : Invalidate() End Sub Protected Overrides Sub OnMouseUp(e As System.Windows.Forms.MouseEventArgs) MyBase.OnMouseUp(e) State = MouseState.Over : Invalidate() End Sub Protected Overrides Sub OnMouseEnter(e As System.EventArgs) MyBase.OnMouseEnter(e) State = MouseState.Over : Invalidate() End Sub Protected Overrides Sub OnMouseLeave(e As System.EventArgs) MyBase.OnMouseLeave(e) State = MouseState.None : Invalidate() End Sub Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs) MyBase.OnMouseMove(e) X = e.Location.X Invalidate() End Sub #End Region Sub New() SetStyle(ControlStyles.UserPaint Or ControlStyles.SupportsTransparentBackColor, True) BackColor = Color.Transparent DoubleBuffered = True Anchor = AnchorStyles.Top Or AnchorStyles.Right End Sub Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs) Dim B As New Bitmap(Width, Height) Dim G As Graphics = Graphics.FromImage(B) MyBase.OnPaint(e) G.Clear(BackColor) Dim drawFont As New Font(“Merlett”, 8, FontStyle.Bold) Select Case State Case MouseState.None Dim lgb As New LinearGradientBrush(MinBtn, Color.FromArgb(50, 50, 50), Color.FromArgb(45, 45, 45), 90S) G.FillPath(lgb, Draw.RoundRect(MinBtn, 2.5)) G.DrawPath(Pens.Black, Draw.RoundRect(MinBtn, 2.5)) G.DrawString(“_”, drawFont, New SolidBrush(Color.Silver), MinBtn, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center}) Dim lgb2 As New LinearGradientBrush(CloseBtn, Color.FromArgb(50, 50, 50), Color.FromArgb(45, 45, 45), 90S) G.FillPath(lgb2, Draw.RoundRect(CloseBtn, 2.5)) G.DrawPath(Pens.Black, Draw.RoundRect(CloseBtn, 2.5)) G.DrawString(“x”, drawFont, New SolidBrush(Color.Silver), CloseBtn, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center}) Case MouseState.Over If X > MinBtn.X And X < MinBtn.X + 35 Then
Dim lgb As New LinearGradientBrush(MinBtn, Color.FromArgb(50, 85, 255, 85), Color.FromArgb(45, 45, 45), 90S)
G.FillPath(lgb, Draw.RoundRect(MinBtn, 2.5))
G.DrawPath(Pens.Black, Draw.RoundRect(MinBtn, 2.5))
G.DrawString(“_”, drawFont, New SolidBrush(Color.Silver), MinBtn, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Dim lgb2 As New LinearGradientBrush(CloseBtn, Color.FromArgb(50, 50, 50), Color.FromArgb(45, 45, 45), 90S)
G.FillPath(lgb2, Draw.RoundRect(CloseBtn, 2.5))
G.DrawPath(Pens.Black, Draw.RoundRect(CloseBtn, 2.5))
G.DrawString(“x”, drawFont, New SolidBrush(Color.Silver), CloseBtn, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Else
Dim lgb2 As New LinearGradientBrush(CloseBtn, Color.FromArgb(50, 30, 30), Color.FromArgb(45, 45, 45), 90S)
G.FillPath(lgb2, Draw.RoundRect(CloseBtn, 2.5))
G.DrawPath(Pens.Black, Draw.RoundRect(CloseBtn, 2.5))
G.DrawString(“x”, drawFont, New SolidBrush(Color.Silver), CloseBtn, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Dim lgb As New LinearGradientBrush(MinBtn, Color.FromArgb(50, 50, 50), Color.FromArgb(45, 45, 45), 90S)
G.FillPath(lgb, Draw.RoundRect(MinBtn, 2.5))
G.DrawPath(Pens.Black, Draw.RoundRect(MinBtn, 2.5))
G.DrawString(“_”, drawFont, New SolidBrush(Color.Silver), MinBtn, New StringFormat() With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
End If
End Select

e.Graphics.DrawImage(B.Clone(), 0, 0)
G.Dispose() : B.Dispose()
End Sub
End Class

Public Class VisceralCheckBox : Inherits Control ‘HELP FROM RECUPERARE

#Region ” Control Help – MouseState & Flicker Control”
Private State As MouseState = MouseState.None
Protected Overrides Sub OnMouseEnter(ByVal e As System.EventArgs)
MyBase.OnMouseEnter(e)
State = MouseState.Over
Invalidate()
End Sub
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
State = MouseState.Down
Invalidate()
End Sub
Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs)
MyBase.OnMouseLeave(e)
State = MouseState.None
Invalidate()
End Sub
Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseUp(e)
State = MouseState.Over
Invalidate()
End Sub
Protected Overrides Sub OnPaintBackground(ByVal pevent As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaintBackground(pevent)
End Sub
Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
MyBase.OnTextChanged(e)
Invalidate()
End Sub
Private _Checked As Boolean
Property Checked() As Boolean
Get
Return _Checked
End Get
Set(ByVal value As Boolean)
_Checked = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
MyBase.OnResize(e)
Height = 14
End Sub
Protected Overrides Sub OnClick(ByVal e As System.EventArgs)
_Checked = Not _Checked
RaiseEvent CheckedChanged(Me)
MyBase.OnClick(e)
End Sub
Event CheckedChanged(ByVal sender As Object)
#End Region

Sub New()
MyBase.New()
SetStyle(ControlStyles.UserPaint Or ControlStyles.SupportsTransparentBackColor, True)
BackColor = Color.Transparent
ForeColor = Color.White
Size = New Size(145, 16)
DoubleBuffered = True
End Sub

Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
Dim checkBoxRectangle As New Rectangle(0, 0, Height – 1, Height – 1)

G.Clear(BackColor)

Dim bodyGrad As New LinearGradientBrush(checkBoxRectangle, Color.FromArgb(25, 25, 25), Color.FromArgb(35, 35, 35), 120S)
G.FillRectangle(bodyGrad, bodyGrad.Rectangle)
G.DrawRectangle(New Pen(Color.FromArgb(42, 47, 49)), New Rectangle(1, 1, Height – 3, Height – 3))
G.DrawRectangle(New Pen(Color.FromArgb(87, 87, 89)), checkBoxRectangle)

If Checked Then
Dim chkPoly As Rectangle = New Rectangle(checkBoxRectangle.X + checkBoxRectangle.Width / 4, checkBoxRectangle.Y + checkBoxRectangle.Height / 4, checkBoxRectangle.Width \ 2, checkBoxRectangle.Height \ 2)
Dim Poly() As Point = {New Point(chkPoly.X, chkPoly.Y + chkPoly.Height \ 2), _
New Point(chkPoly.X + chkPoly.Width \ 2, chkPoly.Y + chkPoly.Height), _
New Point(chkPoly.X + chkPoly.Width, chkPoly.Y)}
G.SmoothingMode = SmoothingMode.HighQuality
Dim P1 As New Pen(Color.FromArgb(250, 255, 255, 255), 2)
Dim chkGrad As New LinearGradientBrush(chkPoly, Color.FromArgb(200, 200, 200), Color.FromArgb(255, 255, 255), 0S)
For i = 0 To Poly.Length – 2
G.DrawLine(P1, Poly(i), Poly(i + 1))
Next
End If
G.DrawString(Text, Font, New SolidBrush(ForeColor), New Point(18, -1), New StringFormat With {.Alignment = StringAlignment.Near, .LineAlignment = StringAlignment.Near})

e.Graphics.DrawImage(B.Clone(), 0, 0)
G.Dispose() : B.Dispose()

End Sub

End Class

Oct 09

VB.NET code to Create a Simple Drag & Drop Interface for your application

Private Sub Form1_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
Dim s As Array = e.Data.GetData(DataFormats.FileDrop)
For i = 0 To s.Length
ListBox1.Items.Add(s(i))
MsgBox(s(i))
Next
End Sub

Private Sub Form1_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragEnter
e.Effect = DragDropEffects.Copy 'Drag enter
End Sub

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
Me.DoDragDrop(Me, DragDropEffects.Copy) 'Mouse down event triggers when you drag it on the form and make sure you have enabled the allow drop to true
End Sub

Jan 17

How to change the format in which dates appear in DateTimePicker control [Tutorial]

Drag and drop the date time picker component to your VB.NET form. Then double click the form1 to open the form load event.

Write these codes in the form load event.

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
DateTimePicker1.Format = DateTimePickerFormat.Short
DateTimePicker1.Format = DateTimePickerFormat.Custom
DateTimePicker1.CustomFormat = "yyyy/MM/dd"
End Sub

DateTimePicker1.Format = DateTimePickerFormat.Short << this code makes the format short thereby removing the time stamp.

DateTimePicker1.Format = DateTimePickerFormat.Custom << this code makes the DateTimePicker to accept custom formats.

DateTimePicker1.CustomFormat = “yyyy/MM/dd” << Finally you here specify the format you need. You can also use “MM/dd/yy” or “dd/MM/yyyy” or “MM-dd-yy”, play with it.

Where “MM” refers “month”, “dd” refers “date” and “yy” refers “year”.

The styling could be any character like -,/,*, so that if you use this format (“MM*dd*yy”) the DateTimePicker1.text will show 1-17-2012 (for January, 17, 2012)

Its a simple tutorial but yeah some of you will surely find it useful..

Jan 16

How to code cool custom controls of your choice in visual studio VB.NET [Tutorial with source]

Must know GDI and VB.NET…

In this tutorial i am gonna make a transparent button. Painted using only light and shadow (black and white). You should also draw two different buttons depending on how dark the backgroundcolor.

Before we start with the painting we need to do 2 important things.
Firstly we have to allow the user to use a transparent background color, the whole concept would have been pretty needless otherwise. This is done by setting the “SupportsTransparentBackColor” style to true, but as we do so, we also tell it to use a dubblebuffer and redraw the control whenever it’s resized.

Sub New()
SetStyle(ControlStyles.OptimizedDoubleBuffer Or ControlStyles.SupportsTransparentBackColor Or 16, True)
BackColor = Color.Transparent
End Sub

Since we are drawing two different buttons depending on how dark the background color is we also want to redraw our button whenever the background color changes, therefor we should add a handler.

Protected Overrides Sub OnHandleCreated(e As System.EventArgs)
MyBase.OnHandleCreated(e)
AddHandler Parent.BackColorChanged, AddressOf Invalidate
End Sub

Some helper methods
Firstly you need a function to inverse colors, this is done by subtracting the R,G and B value from 255:

Private Function Inverse(ByVal c As Color, Optional b As Boolean = True) As Color
If Not b Then Return c Else Return Color.FromArgb(c.A, 255 - c.R, 255 - c.G, 255 - c.B)
End Function

make a function that makes a rectangle with round edges:

Public Shared Function CreateRoundRectangle(ByVal rectangle As Rectangle, ByVal radius As Integer, Optional ByVal TopLeft As Boolean = True, Optional ByVal TopRigth As Boolean = True, Optional ByVal BottomRigth As Boolean = True, Optional ByVal BottomLeft As Boolean = True) As GraphicsPath
Dim path As New Drawing2D.GraphicsPath()
Dim l As Integer = rectangle.Left
Dim t As Integer = rectangle.Top
Dim w As Integer = rectangle.Width
Dim h As Integer = rectangle.Height
Dim d As Integer = radius << 1

If TopLeft Then
path.AddArc(l, t, d, d, 180, 90)
If TopRigth Then path.AddLine(l + radius, t, l + w - radius, t) Else path.AddLine(l + radius, t, l + w, t)
Else
If TopRigth Then path.AddLine(l, t, l + w - radius, t) Else path.AddLine(l, t, l + w, t)
End If

If TopRigth Then
path.AddArc(l + w - d, t, d, d, 270, 90)
If BottomRigth Then path.AddLine(l + w, t + radius, l + w, t + h - radius) Else path.AddLine(l + w, t + radius, l + w, t + h)
Else
If BottomRigth Then path.AddLine(l + w, t, l + w, t + h - radius) Else path.AddLine(l + w, t, l + w, t + h)
End If

If BottomRigth Then
path.AddArc(l + w - d, t + h - d, d, d, 0, 90)
If BottomLeft Then path.AddLine(l + w - radius, t + h, l + radius, t + h) Else path.AddLine(l + w - radius, t + h, l, t + h)
Else
If BottomLeft Then path.AddLine(l + w, t + h, l + radius, t + h) Else path.AddLine(l + w, t + h, l, t + h)
End If

If BottomLeft Then
path.AddArc(l, t + h - d, d, d, 90, 90)
If TopLeft Then path.AddLine(l, t + h - radius, l, t + radius) Else path.AddLine(l, t + h - radius, l, t)
Else
If TopLeft Then path.AddLine(l, t + h, l, t + radius) Else path.AddLine(l, t + h, l, t)
End If

path.CloseFigure()
Return path
End Function
Public Shared Function CreateRoundRectangle(x As Integer, y As Integer, w As Integer, h As Integer, radius As Integer, Optional ByVal TopLeft As Boolean = True, Optional ByVal TopRigth As Boolean = True, Optional ByVal BottomRigth As Boolean = True, Optional ByVal BottomLeft As Boolean = True) As GraphicsPath
Return CreateRoundRectangle(New Rectangle(x, y, w, h), radius, TopLeft, TopRigth, BottomRigth, BottomLeft)
End Function

The drawing part

There are two important things you should remember when you draw your control, the first is to add a On Error Resume Next at the top of your code, or set the entire code inside a try block, because we are asking for our parents background color and we could be asked to paint before our parent has sat the background color value.
The second thing is to draw our control inside a separate bitmap as the drawing process could be visible to the user if we don't. I also use to create two variables with the width and height of the control subtracted with one, because then i don't have to do so directly in the drawing code.

Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
On Error Resume Next

Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B) : G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Dim w As Integer = Width - 1 : Dim h As Integer = Height - 1

With G

End With

G.Dispose()
e.Graphics.DrawImage(B, 0, 0)
End Sub

This is the code i used to find out whether or not to inverse the colors:

Dim pc As Color = Parent.BackColor
Dim inv As Boolean = CInt(pc.R) + pc.G + pc.B < 255 + (255 / 2)

Then to the drawing part, please note that i dont use a single non-transparent color:

With G
Dim MainPath As GraphicsPath = CreateRoundRectangle(0, 0, w, h, 5)
.FillPath(New SolidBrush(Inverse(Color.FromArgb(50, Color.Black), inv)), MainPath) 'Fill

'shadows
.FillPath(New LinearGradientBrush(New Point, New Point(11, 0), Inverse(Color.FromArgb(25, Color.Black), inv), Inverse(Color.FromArgb(0, Color.Black), inv)), CreateRoundRectangle(0, 0, 10, h, 5, , False, False))
.FillPath(New LinearGradientBrush(New Point(w - 10, 0), New Point(w, 0), Inverse(Color.FromArgb(0, Color.Black), inv), Inverse(Color.FromArgb(25, Color.Black), inv)), CreateRoundRectangle(w - 10, 0, 10, h, 5, False, , , False))

.FillPath(New LinearGradientBrush(New Point, New Point(0, h / 2), Inverse(Color.FromArgb(150, Color.White), inv), Inverse(Color.FromArgb(10, Color.White), inv)), _
CreateRoundRectangle(0, 0, w, h / 3, 5, , , False, False)) 'Ligth

.DrawPath(New Pen(Inverse(Color.FromArgb(100, Color.Black), inv)), MainPath) 'Outline
.DrawPath(New Pen(Inverse(Color.FromArgb(100, Color.White), inv)), CreateRoundRectangle(1, 1, w - 2, h - 2, 5)) 'Innerline
End With

As you can see, the button works just as good at a green background as a white one:


Transparent text
Some reason GDI's drawstring function fucks up if you don't draw it to a solid background, therefor i made my one. Firstly we draw the text with a black color to a white background, then we simply removes all the white color and replaces the black color with the forecolor.

Private Sub DrawString(G As Graphics, Size As Size, Text As String, ByVal c As Color)
Dim sF As SizeF = G.MeasureString(Text, Font)
Dim B As New Bitmap(CInt(sF.Width), CInt(sF.Height))

Using G2 As Graphics = Graphics.FromImage(B)
G2.SmoothingMode = SmoothingMode.HighQuality
G2.Clear(Color.White) : G2.DrawString(Text, Font, Brushes.Black, 0, 0)
End Using

For x = 0 To B.Width - 1
For y = 0 To B.Height - 1
Dim p As Color = B.GetPixel(x, y)

If ColorMatch(p, Color.White, 10) Then
B.SetPixel(x, y, Color.Transparent)
Else
Dim a As Integer = 255 - ((CInt(p.R) + p.G + p.B) / 3)
B.SetPixel(x, y, Color.FromArgb(a, c))
End If
Next
Next

G.DrawImage(B, (Size.Width - sF.Width) / 2, (Size.Height - sF.Height) / 2)
End Sub

Public Shared Function ColorMatch(ByVal Color1 As Color, ByVal Color2 As Color, ByVal Range As Integer, _
Optional ByVal AlphaCount As Boolean = False) As Boolean
If AlphaCount = True Then If Not WithinRange(Color1.A, Color2.A, Range) Then Return False
If Not WithinRange(Color1.R, Color2.R, Range) Then Return False
If Not WithinRange(Color1.B, Color2.B, Range) Then Return False
If Not WithinRange(Color1.G, Color2.G, Range) Then Return False
Return True
End Function
Private Shared Function WithinRange(ByVal int1 As Integer, ByVal int2 As Integer, ByVal Range As Integer)
If int1 = int2 Then Return True
If int1 > int2 Then
If int2 + Range >= int1 Then Return True
Else : If int1 + Range >= int2 Then Return True
End If
Return False
End Function

The above pic shows the final result of how the button looks like. You can also alter the settings to make it either opaque or transparent or in whatever colors you want it.

Jan 16

code to import external windows to your visual studio vb.net form [Tutorial + source]

Advantages

(Fully) manage the window
Resize the window
Window won’t be shown in Task-bar
Closing your form will terminate the window process as well.

_
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInt32, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
_
Private Shared Function SetParent(ByVal hWndChild As IntPtr, ByVal hWndNewParent As IntPtr) As IntPtr
End Function
_
Private Shared Function ShowWindow(ByVal hWnd As IntPtr, ByVal nCmdShow As Integer) As Boolean
End Function

constants required

Const WM_SYSCOMMAND As Integer = 274
Const SC_MAXIMIZE As Integer = 61488

Code to put window into a control

Dim proc As Process = Process.GetProcessesByName("processname")(0)
SetParent(proc.MainWindowHandle, Me.AnyControlHere.Handle)
SendMessage(proc.MainWindowHandle, WM_SYSCOMMAND, SC_MAXIMIZE, 0)

Feel free to comment if you need any more help in implementing this in your vb.net project.

Jan 16

How to add protection to your vb.net application using HWID [Tutorial] with source

This tutorial will teach you how to use a combination of HWID to protect your application from leaker

First, you create new class , and add these HWID function to it in order to call it later. Don’t forget to add a reference to System.Management

Code:
Imports System.Management

Public Class clsComputerInfo

Public Shared Function GetProcessorId() As String
Dim strProcessorId As String = String.Empty
Dim query As New SelectQuery(“Win32_processor”)
Dim search As New ManagementObjectSearcher(query)
Dim info As ManagementObject

For Each info In search.Get()
strProcessorId = info(“processorId”).ToString()
Next
Return strProcessorId

End Function

Public Shared Function GetMACAddress() As String
Dim mc As ManagementClass = New ManagementClass(“Win32_NetworkAdapterConfiguration”)
Dim moc As ManagementObjectCollection = mc.GetInstances()
Dim MACAddress As String = String.Empty
For Each mo As ManagementObject In moc

If (MACAddress.Equals(String.Empty)) Then
If CBool(mo(“IPEnabled”)) Then MACAddress = mo(“MacAddress”).ToString()

mo.Dispose()
End If
MACAddress = MACAddress.Replace(“:”, String.Empty)

Next
Return MACAddress
End Function

Public Shared Function GetVolumeSerial(Optional ByVal strDriveLetter As String = “C”) As String

Dim disk As ManagementObject = New ManagementObject(String.Format(“win32_logicaldisk.deviceid=”"{0}:”"”, strDriveLetter))
disk.Get()
Return disk(“VolumeSerialNumber”).ToString()
End Function

End Class

So my class will look like this.

Then we declare 3 variables to store 3 HWID by
Code:
Dim MyMacAddress As String = clsComputerInfo.GetMACAddress()
Dim MyProcessAddress As String = clsComputerInfo.GetProcessorId()
Dim MyVolumeAddress As String = clsComputerInfo.GetVolumeSerial()

So MacAddress,ProcessorID,HDVolume will be stored.

Then we declare another variable to store the formatted HWID.
Code:
Dim TFC_MID As String = “TFCZ-” & MyMacAddress.Substring(MyMacAddress.Length() – 4, 4) _
& “-” & MyProcessAddress.Substring(MyProcessAddress.Length() – 4, 4) & “-” & MyVolumeAddress.Substring(MyVolumeAddress.Length() – 4, 4)

The above code will declare TFC_MID to be a string with TFCZ as salt followed by last 4 string of MACAddress , ProcessID , Volume.

The format will look like this
Code:
TFCZ-XXXX-XXXX-XXXX

*Note that you can change how to order those three above or change salt TFCZ into another name.

After that, we add RC4 encryption algorithm below the sub form1_load
Code:
Public Shared Function rc4(ByVal message As String, ByVal password As String) As String
Dim i As Integer = 0
Dim j As Integer = 0
Dim cipher As New StringBuilder
Dim returnCipher As String = String.Empty
Dim sbox As Integer() = New Integer(256) {}
Dim key As Integer() = New Integer(256) {}
Dim intLength As Integer = password.Length
Dim a As Integer = 0
While a <= 255
Dim ctmp As Char = (password.Substring((a Mod intLength), 1).ToCharArray()(0))
key(a) = Microsoft.VisualBasic.Strings.Asc(ctmp)
sbox(a) = a
System.Math.Max(System.Threading.Interlocked.Increment(a), a - 1)
End While
Dim x As Integer = 0
Dim b As Integer = 0
While b <= 255
x = (x + sbox(b) + key(b)) Mod 256
Dim tempSwap As Integer = sbox(b)
sbox(b) = sbox(x)
sbox(x) = tempSwap
System.Math.Max(System.Threading.Interlocked.Increment(b), b - 1)
End While
a = 1
While a <= message.Length
Dim itmp As Integer = 0
i = (i + 1) Mod 256
j = (j + sbox(i)) Mod 256
itmp = sbox(i)
sbox(i) = sbox(j)
sbox(j) = itmp
Dim k As Integer = sbox((sbox(i) + sbox(j)) Mod 256)
Dim ctmp As Char = message.Substring(a - 1, 1).ToCharArray()(0)
itmp = Asc(ctmp)
Dim cipherby As Integer = itmp Xor k
cipher.Append(Chr(cipherby))
System.Math.Max(System.Threading.Interlocked.Increment(a), a - 1)
End While
returnCipher = cipher.ToString
cipher.Length = 0
Return returnCipher
End Function
And don't forget to add
Code:
Imports System.IO
Imports System.Text
on the top as imports

Then we add
Code:
If (File.Exists(Application.StartupPath & "\TFC.lic")) Then
To check that the file "TFC.lic" is existed or not, and add this to make a stream reader to read for our license key
Code:
Dim stream_reader As New StreamReader(Application.StartupPath & "\TFC.LIC")
then we decrypted the lic file to compare with our HWID with TFC as password
Code:
Dim myMIDReader = rc4(stream_reader.ReadToEnd, "TFC")
stream_reader.close()
After that we put
Code:
If (myMIDReader = TFC_MID) Then

Else
MsgBox("The license key is incorrect, please contact email@email.com for more information", MsgBoxStyle.Critical)
End
End If

Else
MsgBox("Your machine ID is : " & TFC_MID & vbCrLf & "Your machine ID is copied to clipboard, press ctrl+v to paste it!", MsgBoxStyle.Critical)
Clipboard.SetText(TFC_MID)
End
End If
to check that the decrypted lic file is same as TFC_MID or not. If yes, the program run normal.
And if it's not the same , it show the msgbox that the license key is incorrect and end the application.
The next else show the machine ID and copy it to clipboard in case the license key is not found.

This is the final code in form1_load()

[color=#FFD700]The keygen part


Create new project and add 1 textbox and 1 button as above.

then add
Code:
Imports System.IO
Imports System.Text
as import of the application

and add this RC4 encryption to the application

Code:
Public Shared Function rc4(ByVal message As String, ByVal password As String) As String
Dim i As Integer = 0
Dim j As Integer = 0
Dim cipher As New StringBuilder
Dim returnCipher As String = String.Empty
Dim sbox As Integer() = New Integer(256) {}
Dim key As Integer() = New Integer(256) {}
Dim intLength As Integer = password.Length
Dim a As Integer = 0
While a <= 255
Dim ctmp As Char = (password.Substring((a Mod intLength), 1).ToCharArray()(0))
key(a) = Microsoft.VisualBasic.Strings.Asc(ctmp)
sbox(a) = a
System.Math.Max(System.Threading.Interlocked.Increment(a), a – 1)
End While
Dim x As Integer = 0
Dim b As Integer = 0
While b <= 255
x = (x + sbox(b) + key(b)) Mod 256
Dim tempSwap As Integer = sbox(b)
sbox(b) = sbox(x)
sbox(x) = tempSwap
System.Math.Max(System.Threading.Interlocked.Increment(b), b – 1)
End While
a = 1
While a <= message.Length
Dim itmp As Integer = 0
i = (i + 1) Mod 256
j = (j + sbox(i)) Mod 256
itmp = sbox(i)
sbox(i) = sbox(j)
sbox(j) = itmp
Dim k As Integer = sbox((sbox(i) + sbox(j)) Mod 256)
Dim ctmp As Char = message.Substring(a – 1, 1).ToCharArray()(0)
itmp = Asc(ctmp)
Dim cipherby As Integer = itmp Xor k
cipher.Append(Chr(cipherby))
System.Math.Max(System.Threading.Interlocked.Increment(a), a – 1)
End While
returnCipher = cipher.ToString
cipher.Length = 0
Return returnCipher
End Function

then double click at the button and add this code
Code:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim write_file As New StreamWriter(Application.StartupPath & “\TFC.lic”, False)
write_file.Write(rc4(TextBox1.Text, “TFC”))
write_file.Close()
End Sub
*Note that the password “TFC” must the same as your application and keep it private or else anyone can gen your lic file :D . You can freely change the order or salt . Don’t forget to obfuscate your application to prevent viewing through reflector and keep your keygen private.

Jan 15

Tutorial on how to do multi threading in visual studio vb.net

I’ve noticed that some people struggle when it comes to Multi-threading; mainly when you’re trying to edit a control’s properties from a thread other than the one it was created on, giving you an error somewhat like this:

There’s a very simple way around this, it’s called using Delegates.

‘Delegate’ is a word used to describe procedures such as subs and functions, just like Integer is used for whole numbers and Boolean is used for true or false.
Think of a Delegate as a proxy linking your thread and your UI rather than linking a webbrowser to a webserver or what the fuck ever.

Let’s say we have a Sub which updates the application based on the parameters.
We’ll make the sub have 1 parameter which will be an array of objects so that we can use strings, integers etc.

So declare this sub:

You can add more features if you want, I’m just using this as an example.

Now of course, if we try and run this sub in a separate thread, we’d get an error. Now what most people would do is set CheckForIllegalCrossThreadCalls to false, but this is a very bad habit to get into and is not very professional.

What we need to do to is create a delegate and use invoking, so declare your delegate like so:

Now all we need to do is update our UpdateForm sub so that it invokes using our new delegate, so make sure your UpdateForm sub looks like this:


So now if we were to use this sub in a separate thread like this:

It would set our form’s title to “Perplexity”.
We can also use it like this:


Which would set our form’s size to 300 x 300.

Jan 14

How to change the date in dd/mm/yy format in VB.NET (DateTimePicker) ?

Drag and drop the datetimepicker component in to the form.

Now go to the form load event and write this code.

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
DateTimePicker1.Format = DateTimePickerFormat.Short
DateTimePicker2.Format = DateTimePickerFormat.Short
DateTimePicker4.Format = DateTimePickerFormat.Short

End Sub

This basically makes the datetimepicker to show only the short version of the date.

Or you can write this code to make it store or load in custom formats.

Dim formatdate As String = Format(DateTimePicker2.Value, “ddMMyyyy”)

OR

Dim formatdate2 As String= Format(DateTimePicker1.value,”dd/mm/yy”)

Jan 14

how to bind two .exe files together in VB.NET

BUILDER

Add the following forms:

2 buttons
2 textboxs

Okay, now double click the BUTTON 1 and type the following code:

Code:
Dim ofd As New OpenFileDialog
ofd.Title = ""
ofd.Filter = "*.exe | *.exe"
ofd.Title = "File 1"
If ofd.ShowDialog = Windows.Forms.DialogResult.OK Then TextBox1.Text = ofd.FileName
ofd.Title = "File 2"
If ofd.ShowDialog = Windows.Forms.DialogResult.OK Then TextBox2.Text = ofd.FileName

And then double click the BUTTON 2 and type this code:

Code:
Dim stub, File_One, File_Two, Filename1, filename2 As String
Const FileSplit = "12345"
FileOpen(1, TextBox1.Text, OpenMode.Binary, OpenAccess.Read, OpenShare.Default)
File_One = Space(LOF(1))
FileGet(1, File_One)
FileClose(1)

FileOpen(2, TextBox2.Text, OpenMode.Binary, OpenAccess.Read, OpenShare.Default)
File_Two = Space(LOF(2))
FileGet(2, File_Two)
FileClose(2)

FileOpen(3, Application.StartupPath & "\Stub.exe", OpenMode.Binary, OpenAccess.Read, OpenShare.Default)
stub = Space(LOF(3))
FileGet(3, stub)
FileClose(3)
Dim OutputFile As String
Dim sfd As New SaveFileDialog
sfd.Filter = "*.exe | *.exe"
If sfd.ShowDialog = Windows.Forms.DialogResult.OK Then
OutputFile = sfd.FileName
Else : Exit Sub
End If
Filename1 = TextBox1.Text.Substring(TextBox1.Text.LastIndexOf("\"))
filename2 = TextBox2.Text.Substring(TextBox2.Text.LastIndexOf("\"))
FileOpen(3, OutputFile, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Default)
FilePut(3, stub & FileSplit & File_One & FileSplit & File_Two & FileSplit & Filename1 & FileSplit & filename2)
FileClose(3)
MsgBox("Binded")

Now you’re done with builder, make a new form called “Stub”.

STUB

Here we don’t need any forms .. just click on the form and add the following code:

Code:
On Error Resume Next
Dim TPath As String = System.IO.Path.GetTempPath
Const FileSplit = "12345"
Dim file1, joesdaddy, filez() As String
FileOpen(1, Application.ExecutablePath, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
file1 = Space(LOF(1))
FileGet(1, file1)
FileClose(1)
filez = Split(file1, FileSplit)
FileOpen(3, TPath & filez(3), OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Default)
FilePut(3, filez(1))
FileClose(3)
FileOpen(5, TPath & filez(4), OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Default)
FilePut(5, filez(2))
FileClose(5)
System.Diagnostics.Process.Start(TPath & filez(3))
System.Diagnostics.Process.Start(TPath & filez(4))
Me.Close()
End

Note: You must use the same filesplit in builder and stub otherwise it won’t work. My filesplit is “12345″.

Page 1 of 212