Visual Basic 5.0/6.0 Source Code Snippets - All of the snippets were made using Visual Basic 6.0. They should be compatible with both Visual Basic 5.0 and Visual Basic 6.0. But I can't be 100% positive on that. If you still use VB 5.0, then you will just have to try and see. :)
In an effort to make getting the snippets easier and more user friendly I created a new expansion page related to the main site at www.VBForFREE.com. There are these snippets and more at this link here There is also alot of other info there to look over if you want. Another list of links, a few more articles, question and answers for Visual Basic.NET 2002/2003 and Visual Basic 2005/2008. Click Here to head over to that page.
|
Visual Basic Snippets
Allow certain characters in a textbox
'1 textbox
'put in keypress procedure of textbox
Const Numbers$ = "0123456789."
If KeyAscii <> 8 Then
If InStr(Numbers, Chr(KeyAscii)) = 0 Then
MsgBox "error"
KeyAscii = 0
Exit Sub
End If
End If
top
APP Already Running?
'vb
If App.PrevInstance Then
msgbox "Program is already running.
Exit Sub
End If
top
Center Form
'vb
Top = Screen.Height / 2 - Height / 2
Left = Screen.Width / 2 - Width / 2
top
Clear all Textboxes on Form
'vb
Public Sub ClearAllText(frm As Form, ctl As Control)
For Each ctl In frm
If TypeOf ctl Is TextBox Then
ctl.Text=""
End If
Next ctl
top
Clipboard Cut Text
'Need VB, 1 textbox
ClipBoard.SetText Text1.SelText
Text1.SelText = ""
top
ClipBoard Copy Text
'Need VB, 1 textbox
ClipBoard.SetText Text1.SelText
top
Clipboard Paste Text
'Need VB, 1 textbox
Text1.SelText = ClipBoard.GetText
top
Delete File
'vb
On Error GoTo error
Kill FilePath$
Exit Sub
error: MsgBox Err.Description, vbExclamation, "Error"
top
Directory Exist?
'vb5+
f$ = "C:\WINDOWS"
dirFolder = Dir(f$, vbDirectory)
If dirFolder <> "" Then
strmsg = MsgBox("This folder already exists.", vbCritical)
'directory exists action here
End If
top
File Exist?
'vb4+
Public Function FileExists(strPath As String) As Integer
FileExists = Not (Dir(strPath) = "")
End Function
top
File Size
'vb
Dim FileSize As Long
FileSize& = FileLen("C:\SOMEFILE.TXT")
msgbox filesize& & " bytes"
top
Get screen size in pixels
'vb
Width% = Screen.Width \ App.TwipsPerPixelX
Height% = Screen.Height \ App.TwipsPerPixelY
top
Highlight Textbox Text on Focus
'textbox
Sub Text1_GotFocus()
Text1.SelStart = 0
Text1=SelLength = Len(Text1)
End Sub
top
Limit text input
'vb
Function LimitTextInput(source) As String
'put the next line in the Textbox_KeyPress event
'KeyAscii = LimitTextInput(KeyAscii)
'change Numbers with any other character
Const Numbers$ = "0123456789."
'backspace =8
If source <> 8 Then
If InStr(Numbers, Chr(source)) = 0 Then
LimitTextInput = 0
Exit Function
End If
End If
LimitTextInput = source
End Function
top
No textbox popup menu
'textbox
If button=2 Then
text1.enabled=false
popupmenu
text1.enabled=true
text1.setfocus
top
Numer of characters in a textbox including spaces
'textbox
Dim TheNum as string
TheNum$ = Len(Text1)
Msgbox TheNum$
top
PW Protect
'Need 1 button and 1 textbox
If Text1 = "password" Then
MsgBox "Thats the pw"
Else
MsgBox "Wrong pw try again"
End If
top
Reverse a string
'vb5+
Text1.Text = StrReverse("String")
top
Search a Listbox
'Need 1 button, 1 textbox, 1 listbox
'Name textbox = txtSearch, Name listbox = lstSearch
Dim theList As Long
Dim textToSearch as String
Dim theListText As String
textToSearch = LCase(txtSearch.Text)
For theList = 0 To lstSearch.ListCount - 1
theListText = LCase(lstSearch.List(theList))
If theListText = textToSearch Then lstSearch.Text = textToSearch
Next
top
Sendkey Controls
'vb
^ = Control
{enter} = Enter
% = Alt
{Del} = Delete
{ESCAPE} = Escape
{TAB} = Tab
+ = Shift
{BACKSPACE} = Backspace
{BREAK} = Break
{CAPLOCKS} = Caps Lock
{CLEAR} = Clear
{DELETE} = Delete
{DOWN} = Down Arrow
{LEFT} = Left Arrow
{RIGHT} = Right Arrow
{UP} = Up Arrow
{NUMLOCK} = Num Lock
{PGDN} = Page Down
{PGUP} = Page Up
{SCROLLLOCK} = Scroll Lock
{F1} = F1 .......Use {F2} {F3} and so on for others...
{HOME} = home
{INSERT} = Insert
top
Textbox Scroll to Bottom
'1 Textbox
Text1.SelStart = Len(Text1.Text)
top
Time and Date
'vb
Msgbox "The time is " & Time
Msgbox "The date is " & Date
top
Uppercase and Lowercase a string
'vb
text1.text = lcase("String")
text1.text = ucase("String")
top
