VB How-tos
Games Online
Ray's Useful VB how-tos
***** Search Made Easy ! *****
- How to add text items with a different color in a Listbox?
- How to enable the form close button?
- How to include a .wav file in a .exe file?
- How to get ride of the quotation marks when saving strings in a text file?
- How to set the source of one combo to be the contents of another combo?
- How to create multi-column combo box?
- How to create a label that is vertically oriented?
- How to compare two strings using wildcards?
- How to format dates so that they look correct in all date and langauge formats?
- How to create message boxes with those cool red X's?
- How to make text box that displays "*" when you tpye in (For password purpose)?
- How to create a textbox that lets you insert tabs?
- How to implement hotkeys for text boxes?
- How to copy the content of text1 into text2?
- How to make a menu popup from a Commandbutton?
- How to detect the change in the Textbox?
- How to change the content of a Statusbar at run time?
- How to load text file into a Listbox?
- How to use Undo function for Textbox or Combobox?
- How to copy text from the clipboard?
- How to copy text to the clipboard?
- How to code Toolbar click events?
- How to tell the difference between CDbl and Val function?
- How to calculate the age based on date of birth?
- How to check for 4-digit year date?
- How to perform generic error handling routine?
- How to shell to web address?
- How to round a number to nearest 10, 100, 1000, etc.?
- How to put 13 X 13 bitmaps into a menu?
- How to create menus at run time?
- How to encrypt text?
- How to make a form fade to black?
- How to scroll caption on the form's title bar?
- How to hide mouse cursor?
- How to check if the credit card is valid?
- How to check what the last day of a month is?
- How to open VB 6 file with VB 5?
- How to deal with Null strings in Access database fields?
- How to retrieve the screen resolution?
- How to Add frequently used modules to the templates directory?
- How to speed up database access?
- How to Create Rainbow Text?
- How to suppress spaces in a TextBox?
- How to load a text file in one operation?
- How to launch Windows Control Panel extensions using VB?
- How to unload all the Forms to free memory?
- How to make form controls to be movable (DRAG AND DROP)?
- How to show your own Popup menu in the text box?
- How to use the advanced feature of Message Box?
- How to add a new line to existing textbox text?
- How to create separator in the menus?
- How to make only lowercase letters in a textbox?
- How to disable the Text Box beep?
- How to select all items in a listbox?
- How to count how many rows there are in a listview?
- How to add a picture to a Picturebox at run time?
- How to remove a picture to a Picturebox at run time?
- How to fill a form with confetti?
- How to center a Picture Box on a form?
- How to copy an image from one Picture Box
to another Picture Box using the Clipboard? - How to get the length of a string?
- How to hide the mouse pointer?
- How to detect keypress outside your program?
- How to cancel a print job?
- How to print a picture?
- How to get screen resolution?
- How to clear Windows 95 documents list?
- How to add a file to Windows 95 documents list?
- How to order records in a RecordSet by a field?
- How to connect Lists boxes to Access database?
- How to swap two interger variables?
- How to roll a Form up and down?
- How to use an isEven Function?
- How to get the file size?
- How to make the title bar flash?
- How to disable Ctrl-Alt-Delete and Ctrl-Esc?
- How to detect if the system has a sound card?
- How to find out which user is logged in?
- How to determine free disk space?
- How to dither a form?
- How to shade a control?
- How to change the color of Title Bar?
- How to count lines in Rich Text Box?
- How to create two lines on Command Button?
- How to get rid of leading zeros in strings?
- How to create percentage ProgressBar?
- How to reverse a string?
- How to make a form on top?
- How to do word search?
- How to delete a file?
- How to delete a directory?
- How to rename a file?
- How to test for weekend?
- How to set the ToolTipText on a ListBox?
- How to use the IIf function?
- How to set Tab Stops in a ListBox?
- How to include an '&' on a Label?
- How to repair Access database in VB?
- How to reboot the system from VB?
- How to use free file number when reading or writing a file?
- How to get only the file name?
- How to capitalize the first letter of each word in a string?
- How to determine if your program is already running?
- How to make an internet connection?
- How to place a Combo Box onto a Toolbar?
- How to round a number?
- How to select all text when a TextBox gets focus?
- How to read a file line by line?
- How to use Instr function?
- How to use Str function?
- How to use the advanced feature of Input Box?
- How to use Val function?
- How to add records in the database?
- How to use Len function?
- How to use LTrim, RTrim, and Trim Functions?
- How to use Right function?
- How to use Left function?
- How to use Mid function?
- How to get rid of leading zeros in strings?
- How to get the Number of Lines In a TextBox?
- How to search Listboxes as you type?
- How to read a file character by character?
- How to add something to an existing file (with data)?
- How to add something to an existing file by overwriting it?
- How to use SetAttr function?
- How to change the mouse pointer?
- How to change the button's foreground color?
- How to show a modal form?
- How to show a modeless form?
- How to fix the problem of playing the .wav file only once?
- How to make Crystal Reports run faster?
- How to call a Command button without clicking it?
- How to capture keys pressed to use as keyboard shortcuts?
- How to use the advanced feature of MsgBox?
- How to toggle between Insert & Overwrite in a text box?
How to implement hotkeys for text boxes?
Create a label with your hotkey. Set the tabindex of the label to one less then the TabIndex of the textbox
How to create a textbox that lets you insert tabs?
Simply set tabstop on all the controls in a particular form to false.
How to make text box that displays "*" when you tpye in (For password purpose)?
Just set the PasswordChar property of the text box or rich text box to "*" or your favorite character.
How to create message boxes with those cool red X's?
MsgBox "My Message", vbCritical, "My Title"
How to format dates so that they look correct in all date and langauge formats?
Command1.Caption = Format$(Date, "Short Date")
How to compare two strings using wildcards?
Dim Mystr As String Mystr = "Street" If Mystr Like "S*" Then MsgBox "Found" Else MsgBox "Not found" End If
How to create a label that is vertically oriented?
Private Sub Form_Activate() Dim s As String Label1.Caption = "RAY'S VB LAND" For i = 1 To Len(Label1) s = s & Mid$(Label1, i, 1) & vbCrLf Next Label1 = s End Sub Note: You need to drag the Label1 vertically
How to create multi-column combo box?
Add Microsoft Forms 2.0 control, there's a combo that supports multicolumns. Combo1.Clear Combo1.ColumnCount = 2 Combo1.ListWidth = "6 cm" 'Total width Combo1.ColumnWidths = "2 cm;4 cm" 'Column widths Combo1.AddItem "Text in column 0" Combo1.List(0, 1) = "Text in column 1"
How to set the source of one combo to be the contents of another combo?
sub comboA_click() comboB.text = comboA.text end sub If you want the value selected in comboA to be added to the list of choices in comboB, the following code will do it: sub comboA_click() comboB.AddItem comboA.text end sub
How to get ride of the quotation marks when saving strings in a text file?
Use the Print # statement instead of the Write # statement. The Print # statement doesn't put quotation marks around your strings.
How to include a .wav file in a .exe file?
Use a resource file. Include the .wav file as a custom resource. Check the resource files in the help and look at the loadresdata function.
How to enable the form close button?
dim bCanClose as Boolean Then put this into the form's QueryUnload event: If bCanClose = false then cancel = true
How to add text items with a different color in a Listbox?
Use the MSFlexGrid control
How to load text file into a Listbox?
Statusbar1.Panels(1).Text = "Start"
How to change the content of a Statusbar at run time?
Private Sub Command1_Click() Dim StringHold As String Open "C:\test.txt" For Input As #1 List1.Clear While Not EOF(1) Input #1, StringHold List1.AddItem StringHold Wend Close #1 End Sub
How to detect the change in the Textbox?
Private bChanged As Boolean Private Sub Text1_Change() bChanged = True End SubPrivate Sub Form_Unload(Cancel As Boolean) If bChanged Then If Msgbox("Save Changes?", vbYesNo, "Save") = vbYes Then 'Save Changes Here. End If End If End Sub
How to make a menu popup from a Commandbutton?
First, create a menu with the menu editor. It should look like this: Button Menu (Menu name: mnuBtn, Visible: False - Unchecked) ....SubMenu Item 1 (Menu name: mnuSub, Index: 0) ....SubMenu Item 2 (Menu name: mnuSub, Index: 1) ....SubMenu Item 3 (Menu name: mnuSub, Index: 2) ....SubMenu Item 4 (Menu name: mnuSub, Index: 3) I hope you understand the above. Also create a CommandButton. Then add this code: Private Sub mnuSub_Click(Index As Integer) Call MsgBox("Menu sub-item " & Index + 1 & " clicked!", _ vbExclamation) End Sub Private Sub Command1_Click() Call PopupMenu(mnuBtn) End Sub P.S. For added effect, replace the line: Call PopupMenu(mnuBtn) With this one: Call PopupMenu(Menu:=mnuBtn, X:=Command1.Left, Y:=Command1.Top + _ Command1.Height) ' Even more viola! Or this one: Call PopupMenu(mnuBtn, vbPopupMenuCenterAlign, Command1.Left + _ (Command1.Width / 2), Command1.Top + Command1.Height)
How to copy the content of text1 into text2?
If you have VB6.0 you can use the Replace Function to easily replace any Character(s) with something else, eg.
Text2 = Replace(Text1, vbCrLf, "
" & vbCrLf)
Otherwise, you'll need to step though the Text yourself checking for instances of vbCrLf, e.g.
code:
Dim sString As String Dim sNewString As Strings String = Text1 While Instr(sString, vbCrLf) sNewString = sNewString & Left(sString, _ Instr(sString, vbCrLf) - 1) & "
" & vbCrLf sString = Mid(sString, Instr(sString, vbCrLf) + 2) Wend Text2 = sNewString
How to encrypt text?
encryption function : Public Function Encrypt(ByVal Plain As String) For I=1 To Len(Plain) Letter=Mid(Plain,I,1) Mid(Plain,I,1)=Chr(Asc(Letter)+1) Next Encrypt = Plain End Sub Public Function Decrypt(ByVal Encrypted As String) For I=1 to Len(Encrypted) Letter=Mid(Encrypted,I,1) Mid(Encrypted,I,1)=Chr(Asc(Letter)-1) Next Decrypt = Encrypted End Sub Print Encrypt("This is just an example") Print Decrypt("Uijt!jt!kvtu!bo!fybnqmf")
How to create menus at run time?
Dim index As Integer index = mnuHook.Count Load mnuHook(index) mnuHook(index).Caption = "New Menu Entry" mnuHook(index).Visible = True 'mnuHook is the menu that the new entry appears after
How to put 13 X 13 bitmaps into a menu?
'Add a picturebox control. 'Set 'Autosize' to 'True' with a bitmap (not an Icon) 'at a maximum of 13X13. 'Place these Declarations in BAS module Private Declare Function VarPtr Lib "VB40032.DLL" (variable As Any) As Long Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal
nPos As Long) As Long Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long,
ByVal nPosition As Long,
ByVal wFlags As Long, ByVal
hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long Const MF_BYPOSITION = &H400& 'Place this code into the form load event: Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long mHandle = GetMenu(hwnd) sHandle = GetSubMenu(mHandle, 0) lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, imOpen.Picture,
imOpen.Picture) lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, imSave.Picture,
imSave.Picture) lRet = SetMenuItemBitmaps(sHandle, 3, MF_BYPOSITION, imPrint.Picture,
imPrint.Picture) lRet = SetMenuItemBitmaps(sHandle, 4, MF_BYPOSITION, imPrintSetup.Picture,
imPrintSetup.Picture) sHandle = GetSubMenu(mHandle, 1) sHandle2 = GetSubMenu(sHandle, 0) lRet = SetMenuItemBitmaps(sHandle2, 0, MF_BYPOSITION, imCopy.Picture,
imCopy.Picture)
How to round a number to nearest 10, 100, 1000, etc.?
'Example - round to nearest 100 Round(RatioBolus * Val(txtDW), 100) 'Put this in BAS module Public Function Round(Dose, Factor) 'Purpose: Round a dose 'Input: Dose, Factor (10, 100, 1000, etc) 'Output: Rounded dose Dim Temp As Single Temp = Int(Dose / Factor) Round = Temp * Factor End Function
How to shell to web address?
'Put this in the click event of a control Dim iRet As Long Dim Response As Integer Response = MsgBox("You have chosen 'www.rxkinetics.com', " & vbCrLf & "which will launch your web browser and" & vbCrLf & "point you to the Kinetics web _ site." & vbCrLf & vbCrLf & "Do you wish to continue?", vbInformation + _ vbYesNo, "www.rxkinetics.com") Select Case Response Case vbYes iRet = Shell("start.exe http://www.rxkinetics.com", vbNormal) Case vbNo Exit Sub End Select
How to perform generic error handling routine?
'Begin error handle code On Error GoTo ErrHandler 'Insert code to be checked 'Stop error trapping & exit function On Error GoTo 0 Exit Function ErrHandler: Dim strErr As String strErr = "Error " & Err.Number & " " & Err.Description MsgBox strErr, vbCritical + vbOK, "Error message"
How to check for 4-digit year date?
Public Function ValidDate(MDate) 'Purpose: Check for 4 digit yyyy DATE 'Input: String from text box 'Output: True or False 'Default is false ValidDate = False 'Exit if length less than "m/d/yyyy" If Len(MDate) < 8 Then Exit Function 'Exit if not a valid date wrong If IsDate(MDate) = False Then Exit Function 'Exit if not ending or starting with "yyyy" Dim StartDate As String Dim EndDate As String EndDate = Right(MDate, 4) StartDate = Left(MDate, 4) If ValidChar(EndDate, "0123456789") = False And _ ValidChar(StartDate, "0123456789") = False Then Exit Function 'Set to true if it passes all these tests! ValidDate = True End Function
How to calculate the age based on date of birth?
'Convert text to Date Dim Birth as Date Birth = DateValue(txtDOB) 'Calculate age Dim Age as Integer Age = Int(DateDiff("D", Birth, Now) / 365.25)
How to tell the difference between CDbl and Val function?
print Val("12345") 12345 print Val("12,345") 12 print CDbl("12,345") 12345 print CDbl("12345") 12345
How to code Toolbar click events?
Private Sub Toolbar1_ButtonClick(ByVal Button As Button) 'Handle button clicks Select Case Button.Key Case Is = "Exit" 'If user clicks the No button, stop Exit If MsgBox("Do you want to exit?", vbQuestion + vbYesNo + _ vbDefaultButton2, "Exiting Code Bank") = vbNo Then Exit Sub Call ExitProgram Case Is = "Repair" Call Repairdb Case Is = "Delete" Call DeleteRoutine Case Is = "Edit" Call EditRoutine Case Is = "New" Call NewRoutine Case Is = "Copy" Call CopyToClipboard Case Is = "Help" Call ShowHelpContents End Select End Sub
How to copy text to the clipboard?
'First clear the clipboard Clipboard.Clear 'Select Text in txtBox & copy to clipboard Clipboard.SetText txtBox.Text, vbCFText
How to copy text from the clipboard?
'Select Text in txtBox & copy from clipboard txtBox.SelText = Clipboard.GetText 'Or replace entire text txtBox.Text = Clipboard.GetText
How to use Undo function for Textbox or Combobox?
'Windows API provides an undo function 'Do the following declares: Declare Function SendMessage Lib "User" (ByVal hWnd As _ Integer, ByVal wMsg As Integer, ByVal wParam As _ Integer, lParam As Any) As Long Global Const WM_USER = &h400 Global Const EM_UNDO = WM_USER + 23 'And in your Undo Sub do the following: UndoResult = SendMessage(myControl.hWnd, EM_UNDO, 0, 0) 'UndoResult = -1 indicates an error.
How to toggle between Insert & Overwrite in a text box?
1. Put a label on the form called 'lblOVR' 2. Put this code in KeyUp event of Form Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyInsert Then If lblOVR = "Over" Then lblOVR = "Insert" Else lblOVR = "Over" End If End If End Sub 3. Put this code in KeyPress event of Text Box Private Sub txtText_KeyPress(KeyAscii As Integer) 'Exit if already selected If txtText.SelLength > 0 Then Exit Sub If lblOVR = "Over" Then If KeyAscii <> 8 And txtText.SelLength = 0 Then txtText.SelLength = 1 '8=backspace End If Else txtText.SelLength = 0 End If End Sub
How to use the advanced feature of MsgBox?
'This method works well, unless you need to save the 'answer from your Select Case for later use. If you do, 'you'll need to use the more standard form of 'prompting for the answer in a variable. Select Case MsgBox("Would you like to save the file somefile.txt?", _ vbApplicationModal + vbQuestion + YesNoCancel, App.Title) Case vbYes 'Save then file Case vbNo 'Do something for No Case vbCancel 'Do something else for Cancel End Select 'If only need yes/no answer then this code may 'work better If MsgBox("Do you really want to exit Code Bank?", _ vbQuestion + vbYesNo + vbDefaultButton2, "Exiting Code Bank") = vbNo Then Exit Sub
How to capture keys pressed to use as keyboard shortcuts?
'Set the KeyPreview Property of the form to True 'Put this code in the KeyDown even of the form 'Look up Key code constants in VB help for other key codes Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'Capture Alt key Dim AltDown AltDown = (Shift And vbAltMask) > 0 'Alt + A = Shortcut for AddNew If AltDown And KeyCode = vbKeyA Then ' A = Add Data1.Recordset.AddNew End If End Sub
How to call a Command button without clicking it?
cmdCommand = True
How to make Crystal Reports run faster?
If Crystal Reports' speed is lacking although your report contains no large
graphics or large numbers of groups, change these two lines in your CRW.INI
file to solve disk swapping problems:
MaxRecordMemory=0 MetapageSpillLimit=100
How to fix the problem of playing the .wav file only once?
Always include the "Close" statement before "Open"
MMControl1.Command = "Close" MMControl1.Filename = "C:\1.mid" MMControl1.Command = "Open" MMControl1.Command = "Play"
How to show a modeless form?
frmPass.Show vbModeless
How to show a modal form?
frmPass.Show vbModal
How to change the button's foreground color?
To use the Microsoft Control: Microsoft Forms 2.0 Object Library
How to change the mouse pointer?
Screen.MousePointer = 0 'Default Screen.MousePointer = 11 'Hourglass
How to use SetAttr function?
SetAttr "C:\data.txt", vbNormal SetAttr "C:\data.txt", vbReadOnly
How to add something to an existing file by overwriting it?
Open "C:\data.txt" For output As #1 Do While Not EOF(1) Print #1, "Overwrite the file!" Close #1
How to add something to an existing file (with data)?
Open "C:\data.txt" For append As #1 Do While Not EOF(1) Print #1, "Append Something!" Close #1
How to read a file character by character?
Do While Not EOF(1) myChar = Input(1, #1) 'one char a line WholeWord = WholeWord & myChar Loop
How to search Listboxes as you type?
By changing the SendMessage Function's "ByVal wParam as Long" to
"ByVal wParam as String", we change the search ability from first
letter only, to "change-as-we-type" searching.
Here's some example code. Start a new Standard EXE project and add
a ListBox (List1) and a TextBox (Text1), then paste in the
following code :
option Explicit
'Start a new Standard-EXE project. 'Add a textbox and a listbox control to form 1 'Add the following code to form1: private Declare Function SendMessage Lib "User32" Alias "SendMessageA"
(byval hWnd as Long, byval wMsg as Integer, byval wParam as string,
lParam as Any) as Long Const LB_FINDSTRING = &H18F private Sub Form_Load() With List1 .Clear .AddItem "RAM" .AddItem "rams" .AddItem "RAMBO" .AddItem "ROM" .AddItem "Roma" .AddItem "Rome" .AddItem "Rommel" .AddItem "Cache" .AddItem "Cash" End With End Sub private Sub Text1_Change() List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, Text1,
byval Text1.Text) End Sub
How to get the Number of Lines In a TextBox?
This method is straightforward: it uses SendMessage to retrieve the
number of lines in a textbox. A line to this method is defined as a
new line after a word-wrap; it is independent of the number of hard
returns in the text.
Declarations
Public Declare Function SendMessageLong Lib "user32" Alias
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,ByVal
wParam As Long, ByVal lParam As Long) As Long
Public Const EM_GETLINECOUNT = &HBA
The Code
Sub Text1_Change() Dim lineCount as Long On Local Error Resume Next 'get/show the number of lines in the edit control lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&) Label1 = Format$(lineCount, "##,###") End Sub
Special Note
The textbox passed to the SendMessage API must have its multiline
property set to true at design time. The EM_GETLINECOUNT message
does not pass additional parameters to the API in the wParam or lParam
variables. These must be 0.
How to get rid of leading zeros in strings?
Function KillZeros(incoming as string) as string KillZeros = CStr(CInt(incoming)) End Function
How to use Mid function?
Dim MyString, FirstWord, LastWord, MidWords MyString = "Mid Function Demo" ' Create text string. FirstWord = Mid(MyString, 1, 3) ' Returns "Mid". LastWord = Mid(MyString, 14, 4) ' Returns "Demo". MidWords = Mid(MyString, 5) ' Returns "Function Demo".
How to use Left function?
Dim AnyString, MyStr AnyString = "Hello World" ' Define string. MyStr = Left(AnyString, 1) ' Returns "H". MyStr = Left(AnyString, 5) ' Returns " Hello".
How to use Right function?
Dim AnyString, MyStr AnyString = "Hello World" ' Define string. MyStr = Right(AnyString, 1) ' Returns "d". MyStr = Right(AnyString, 6) ' Returns " World". MyStr = Right(AnyString, 20) ' Returns "Hello World".
How to use LTrim, RTrim, and Trim Functions?
Dim MyString, TrimString MyString = " <-Trim-> " ' Initialize string. TrimString = LTrim(MyString) ' TrimString = "<-Trim-> ". TrimString = RTrim(MyString) ' TrimString = " <-Trim->". TrimString = LTrim(RTrim(MyString)) ' TrimString = "<-Trim->". ' Using the Trim function alone achieves the same result. TrimString = Trim(MyString) ' TrimString = "<-Trim->".
How to use Len function?
Dim MyString MyString = "Hello World" ' Initialize variable. MyLen = Len(MyString) ' Returns 11.
How to add records in the database?
Private dbCurrent As Database Private recCategories As Recordset
Set dbCurrent = OpenDatabase(cFilePathMajor & "\Record.mdb", False) Set recCategories = dbCurrent.OpenRecordset("select * from Record") With recCategories .AddNew !Date = Date !Time = Time .Update End With
recCategories.Close dbCurrent.Close Set dbCurrent = Nothing
How to use Val function?
This example uses the Val function to return the numbers contained
in a string.
Dim MyValue MyValue = Val("2457") ' Returns 2457. MyValue = Val(" 2 45 7") ' Returns 2457. MyValue = Val("24 and 57") ' Returns 24.
How to use the advanced feature of Input Box?
Dim Message, Title, Default, MyValue Message = "Enter a value between 1 and 3" ' Set prompt. Title = "InputBox Demo" ' Set title. Default = "1" ' Set default. ' Display message, title, and default value. MyValue = InputBox(Message, Title, Default) ' Use Helpfile and context. The Help button is added automatically. MyValue = InputBox(Message, Title, , , , "DEMO.HLP", 10) ' Display dialog box at position 100, 100. MyValue = InputBox(Message, Title, Default, 100, 100)
How to use Str function?
This example uses the Str function to return a string representation
of a number. When a number is converted to a string, a leading
space is always reserved for its sign.
Dim MyString MyString = Str(459) ' Returns " 459". MyString = Str(-459.65) ' Returns "-459.65". MyString = Str(459.001) ' Returns " 459.001".
How to use Instr function?
This example uses the InStr function to return the position
of the first occurrence of one string within another.
Dim SearchString, SearchChar, MyPos SearchString ="XXpXXpXXPXXP" ' String to search in. SearchChar = "P" ' Search for "P". ' A textual comparison starting at position 4. Returns 6. MyPos = Instr(4, SearchString, SearchChar, 1) ' A binary comparison starting at position 1. Returns 9. MyPos = Instr(1, SearchString, SearchChar, 0) ' Comparison is binary by default (last argument is omitted). MyPos = Instr(SearchString, SearchChar) ' Returns 9. MyPos = Instr(1, SearchString, "W") ' Returns 0.
How to read a file line by line?
Do While Not EOF(1) Line Input #1, LineHolder LineHolder = LineHolder + 1 Loop
How to select all text when a TextBox gets focus?
Public Sub TextSelected() Dim tBox As TextBox Set tBox = Screen.ActiveControl If TypeOf tBox Is TextBox Then tBox.SelStart = 0 tBox.SelLength = Len(tBox) End If End Sub
How to round a number?
Function RoundNumber(lNumber, Optional iDecimalPlaces As Integer = 1) RoundNumber = Int(lNumber * (10 ^ iDecimalPlaces) + 0.5) / _ (10 ^ iDecimalPlaces) End Function
How to place a Combo Box onto a Toolbar?
To put a combo box on a toolbar, create a place holder and position the
combobox above the place holder in the z-order. You can't place the combo
box inside the place holder. Instead, follow these steps:
1) Create a button with the PlaceHolder style. 2) Show the form. 3) In the Form_Load event set the Top and Left properties of the combo box to the same value as the PlaceHolder button. 4) Set the z-order of the combo box to zero to bring it to the front. 5) In the Form_Resize event, make sure the Top and Left properties of the combo box are the same as the PlaceHolder button.
Private Sub Form_Load() Dim btnX As Button Me.Show Set btnX = Toolbar1.Buttons.Add() btnX.Style = tbrSeparator Set btnX = Toolbar1.Buttons.Add() btnX.Style = tbrPlaceholder btnX.Key = "combo" btnX.Width = 2000 With Combo1 .ZOrder 0.Width = Toolbar1.Buttons("combo").Width .Top = Toolbar1.Buttons("combo").Top .Left = Toolbar1.Buttons("combo").Left End With End Sub
--A. Nicklas Malik
How to make an internet connection?
Dim res res = Shell("rundll32.exe rnaui.dll,RnaDial " _
& "connection_name", 1)
How to determine if your program is already running?
Put this code in the load event of the first form that the program loads. If App.PrevInstance = True Then Call MsgBox("This program is already running!",_ vbExclamation) End End If
Tip by James Limm
How to capitalize the first letter of each word in a string?
StrConv("my all lowercase string", vbProperCase)
Will print: 'My All Lowercase String'
How to get only the file name?
MsgBox OnlyFileName("c:\windows\win.com","\") 'gives you 'win.com' Function OnlyFileName(vPath$, vSlash$) As String Dim p% OnlyFileName = vPath For p% = Len(vPath$) To 0 Step -1 If Mid$(vPath$, p%, 1) = vSlash$ Then OnlyFileName = Mid$(vPath$, p% + 1, Len(vPath$) - p% + 1) Exit Function End If Next p% End Function
How to use free file number when reading or writing a file?
Private Sub GetFile(FileName$) Dim nFilenumber% Dim tmpLine$ Text1.Text = "" nFilenumber = FreeFile Open FileName$ For Input As #nFilenumber Do While Not EOF(nFileNumber) Input #nFileNumber, tmpLine Text1.Text = Text1.Text & tmpline Loop Close #nFileNumber End Sub
How to reboot the system from VB?
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Boolean Public Const EWX_FORCE = 4 Public Const EWX_LOGOFF = 0 Public Const EWX_REBOOT = 2 Public Const EWX_SHUTDOWN = 1 ... Dim res As Boolean res = ExitWindowsEx (EWX_REBOOT, 0) If Not res Then MsgBox "Function failed" Else MsgBox "Shutting down Windows NOW!" End EndIf
How to repair Access database in VB?
Private Sub Command1_Click() On Error GoTo Repair_Error Dim MDB_Name As String CommonDialog1.Filter = "Access (*.mdb)|*.mdb" CommonDialog1.Flags = &H1000 CommonDialog1.FilterIndex = 1 CommonDialog1.Action = 1 If CommonDialog1.FileName <> "" Then Screen.MousePointer = 11 MDB_Name = CommonDialog1.FileName RepairDatabase (MDB_Name) Screen.MousePointer = 0 MsgBox "Database repaired successfully", 64, "Repair" End If Screen.MousePointer = 0 Exit Sub Repair_Error: MsgBox "Error when repairing database", 16, "Error" Screen.MousePointer = 0 Exit Sub End Sub
How to include an '&' on a Label?
Since an ampersand (&) on a label will indicate an access key (with
an underscore below to use with the Alt Key selection combination),
you may want to have an ampersand actually appear as part of the
text of the label. To accomplish this, simply put two ampersands together like ... &&
How to set Tab Stops in a ListBox?
Want to create a simple list box that shows several fields of data?
The columns property of the list box does not do this, but you can
use this function to do it. Public Const LB_SETTABSTOPS As Long = &H192
Public Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Sub DoTabs(lstListBox As ListBox, TabArray() As Long) 'clear any existing tabs Call SendMessage(List1.hWnd, LB_SETTABSTOPS, 0&, ByVal 0&) 'set list tabstops Call SendMessage(List1.hWnd, LB_SETTABSTOPS, _ CLng(UBound(TabArray)) + 1, TabArray(0)) End SubFirst, set up the columns: Dim Tabs(2) as Long Tabs(0) = 0 Tabs(1) = 100 Tabs(2) = 200 DoTabs List1, Tabs Then, add your items: List1.AddItem "John" & vbTab & "Percival" & vbTab & "Content Editor" List1.AddItem "James" & vbTab & "Limm" & vbTab & "Senior Editor"
Tip by John Percival
How to use the IIf function?
This example uses the IIf function to evaluate the TestMe parameter
of the CheckIt procedure and returns the word "Large" if the
amount is greater than 1000; otherwise, it returns the word "Small". Function CheckIt (TestMe As Integer) CheckIt = IIf(TestMe > 1000, "Large", "Small") End Function
How to set the ToolTipText on a ListBox?
Private Sub List1_MouseMove(Button As _ Integer, Shift As Integer, X As Single, Y As Single) Dim YPos As Integer, iOldFontSize As Integer iOldFontSize = Me.Font.Size Me.Font.Size = List1.Font.Size YPos = Y \ Me.TextHeight("Xyz") + List1.TopIndex Me.Font.Size = iOldFontSize If YPos < List1.ListCount Then List1.ToolTipText = List1.List(YPos) Else List1.ToolTipText = "" End If End Sub
How to test for weekend?
If (WeekDay (Date) MOD 6 = 1) then Msgbox "It's the weekend!" End if
How to rename a file?
Dim OldName, NewName OldName = "OLDFILE": NewName = "NEWFILE" ' Define file names. Name OldName As NewName ' Rename file. OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE" Name OldName As NewName ' Move and rename file.
How to delete a directory?
' Assume that MYDIR is an empty directory or folder. RmDir "MYDIR" ' Remove MYDIR.
How to delete a file?
Kill pathname
How to do word search?
Private Sub Command1_Click() Dim X As Integer X = FindMatch(Text1.Text, Text2.Text) If X = 0 Then MsgBox "Word not found" Else MsgBox "Word found" End If End Sub 1. Create a new function called FindMatch. Add the following code to this function: Function FindMatch(Str1 As String, Str2 As String) As Integer Dim Match As Integer Dim Char1 As String Dim Char2 As String Match = InStr(Str1, Str2) If Match <> 0 Then Char1 = Mid$(Str1, Match - 1, 1) If Codes(Char1) Then Char2 = Mid$(Str1, Match + Len(Str2), 1) If Codes(Char2) Then FindMatch = True: Exit Function End If End If End If FindMatch = False End Function 2. Create a new function called Codes. Add the following code to this function: Function Codes(PuncStr As String) As Integer If PuncStr = "," Or PuncStr = "." Or PuncStr = " " Or _
PuncStr = Chr(10) Or PuncStr = Chr(13) Or PuncStr = Chr(9) Then Codes = True Else Codes = False End If End Function
How to make a form on top?
Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal
hWndinsertafter As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal
cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2 Sub MakeTopMost (frmForm As Form, LX%, LY%, RX%, RY%) Dim succes As Long succes = SetWindowPos(frmForm.hWnd, HWND_TOPMOST, LX%, LY%, RX%, RY%, 0) End Sub Sub UnMakeTopMost (frmForm As Form) Dim succes As Long succes = SetWindowPos(frmForm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, 0) End Sub
How to reverse a string?
Public Function reversestring(revstr As String) As String ' revstr: String to reverse ' Returns: The reverse string Dim doreverse As Long reversestring = "" For doreverse = Len(revstr) To 1 Step -1 reversestring = reversestring & Mid$(revstr, doreverse, 1) Next End Function
Use
Dim strResult As String strResult = reversestring("String") MsgBox strResult
Tip by John Percival
How to create percentage ProgressBar?
Sub Command1_Click () picture1.ForeColor = RGB(0, 0, 255) 'use blue bar For i = 0 To 100 Step 2 updateprogress picture1, i Next picture1.Cls 'clear bar at they end End Sub Sub updateprogress (pb As Control, ByVal percent) Dim num$ 'use percent If Not pb.AutoRedraw Then 'picture in memory ? pb.AutoRedraw = -1 'no, make one End If pb.Cls 'clear picture in memory pb.ScaleWidth = 100 'new sclaemodus pb.DrawMode = 10 'not XOR Pen Modus num$ = Format$(percent, "###") + "%" pb.CurrentX = 50 - pb.TextWidth(num$) / 2 pb.CurrentY = (pb.ScaleHeight - pb.TextHeight(num$)) / 2 pb.Print num$ 'print percent pb.Line (0, 0)-(percent, pb.ScaleHeight), , BF pb.Refresh 'show differents End Sub
How to get rid of leading zeros in strings?
Function KillZeros(incoming as string) as string KillZeros = CStr(CInt(incoming)) End Function
How to create two lines on Command Button?
command1.caption = "first line above" & vbCRLF & "second
line beyond.."
How to count lines in Rich Text Box?
By using the SendMessage API function and the EM_GETLINECOUNT
message you could easily write a wrapper function that returns
the number of lines in a multi line textbox. Public Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long Public Const EM_GETLINECOUNT = &HBA Public Function LineCount(txtBox As TextBox) As Long LineCount = SendMessage( _ TxtBox.hWnd, EM_GETLINECOUNT, 0&, 0&) End Function
How to change the color of Title Bar?
You can globally change any Windows 95 desktop colour using the
SetSysColors function. It takes three parameters : The number
of colour elements to change, The Color object constant that
you want to change and the RGB value. The Declaration for this API function is: Declare Function SetSysColors Lib "user32" Alias _ "SetSysColors" (ByVal nChanges As Long, lpSysColor As _ Long, lpColorValues As Long) As Long The Constants are: Public Const COLOR_SCROLLBAR = 0 'The Scrollbar colour Public Const COLOR_BACKGROUND = 1 'Colour of the background with no wallpaper Public Const COLOR_ACTIVECAPTION = 2 'Caption of Active Window Public Const COLOR_INACTIVECAPTION = 3 'Caption of Inactive window Public Const COLOR_MENU = 4 'Menu Public Const COLOR_WINDOW = 5 'Windows background Public Const COLOR_WINDOWFRAME = 6 'Window frame Public Const COLOR_MENUTEXT = 7 'Window Text Public Const COLOR_WINDOWTEXT = 8 '3D dark shadow (Win95) Public Const COLOR_CAPTIONTEXT = 9 'Text in window caption Public Const COLOR_ACTIVEBORDER = 10 'Border of active window Public Const COLOR_INACTIVEBORDER = 11 'Border of inactive window Public Const COLOR_APPWORKSPACE = 12 'Background of MDI desktop Public Const COLOR_HIGHLIGHT = 13 'Selected item background Public Const COLOR_HIGHLIGHTTEXT = 14 'Selected menu item Public Const COLOR_BTNFACE = 15 'Button Public Const COLOR_BTNSHADOW = 16 '3D shading of button Public Const COLOR_GRAYTEXT = 17 'Grey text, of zero if dithering is used. Public Const COLOR_BTNTEXT = 18 'Button text Public Const COLOR_INACTIVECAPTIONTEXT = 19 'Text of inactive window Public Const COLOR_BTNHIGHLIGHT = 20 '3D highlight of button To change the colour of the title bar, or caption, of an active
window, you would call the function in this way: t& = SetSysColors(1, COLOR_ACTIVECAPTION, RGB(255,0,0)) This example would turn the active caption red
How to shade a control?
Make a new project. Add a module. To the form add a text box. Code: Add this code to the module: Global Const GFM_BACKSHADOW = 1 Global Const GFM_DROPSHADOW = 2 Public Sub ControlShadow(f As Form, C As Control, shadow_effect _
As Integer, shadow_width As Integer, shadow_color As Long) Dim shColor As Long Dim shWidth As Integer Dim oldWidth As Integer Dim oldScale As Integer shWidth = shadow_width shColor = shadow_color oldWidth = f.DrawWidth oldScale = f.ScaleMode f.ScaleMode = 3 f.DrawWidth = 1 Select Case shadow_effect Case GFM_DROPSHADOW f.Line (C.Left + shWidth, C.Top + shWidth)-Step(C.Width - 1, _
C.Height - 1), shColor, BF Case GFM_BACKSHADOW f.Line (C.Left - shWidth, C.Top - shWidth)-Step(C.Width - 1, _
C.Height - 1), shColor, BF End Select f.DrawWidth = oldWidth f.ScaleMode = oldScale End Sub Add this code to the form's Load procedure: Private Sub Form_Load() Dim r r=ControlShadow(me,text1,1,2,black) End Sub
How to dither a form?
Ever wonder how the SETUP.EXE screen gets its cool shaded background
coloring? This color shading is called dithering, and you can
easily incorporate it into your forms. Add the following routine
to a form: To call it, put the following statement in the
Form_Activate event : - Dither Me Sub Dither(vForm As Form) Dim intLoop As Integer vForm.DrawStyle = vbInsideSolid vForm.DrawMode = vbCopyPen vForm.ScaleMode = vbPixels vForm.DrawWidth = 2 vForm.ScaleHeight = 256 For intLoop = 0 To 255 vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), _ RGB(0, 0,255 -intLoop), B Next intLoop End Sub
How to determine free disk space?
Use the function GetDiskFreeSpace. The declaration for this API
function is: Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
"GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters _
As Long) As Long
Here is an example of how to find out how much free space a drive has:
Dim SectorsPerCluster& Dim BytesPerSector& Dim NumberOfFreeClusters& Dim TotalNumberOfClusters& Dim FreeBytes& dummy& = GetDiskFreeSpace("c:\", SectorsPerCluster, _ BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters) FreeBytes = NumberOfFreeClusters * SectorsPerCluster * _ BytesPerSector The Long FreeBytes contains the number of free bytes on the drive.
Tip by James Limm
How to find out which user is logged in?
Dim s As String Dim cnt As Long Dim dl As Long Dim CurUser as String cnt = 199 s = String$(200, 0) dl = GetUserName(s, cnt) If dl <> 0 Then curuser = Left$(s, cnt) Else curuser = ""
You must declare the following function in the declarations section
of a form or module in the project.
Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
Tip by James Limm
How to detect if the system has a sound card?
Add the following code to the declarations section of the project.
Declare Function waveOutGetNumDevs Lib "winmm.dll" _
Alias "waveOutGetNumDevs" () As LongDim i As Integer i = waveOutGetNumDevs() If i > 0 Then MsgBox "Your system can play sound files.", _ vbInformation, "Sound Card Test" Else MsgBox "Your system can not play sound Files.", _ vbInformation, "Sound Card Test" End If
Tip by James Limm
How to disable Ctrl-Alt-Delete and Ctrl-Esc?
Copy this code into the declarations section of your project. Private Declare Function SystemParametersInfo Lib _
"user32" Alias "SystemParametersInfoA" (ByVal uAction _
As Long, ByVal uParam As Long, ByVal lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Code
Sub DisableCtrlAltDelete(bDisabled As Boolean) Dim X As Long X = SystemParametersInfo(97, bDisabled, CStr(1), 0) End Sub
Use
To disable Ctrl-Alt-Delete: Call DisableCtrlAltDelete(True) To enable Ctrl-Alt-Delete: Call DisableCtrlAltDelete(False)
Tip by James Limm
How to make the title bar flash?
Create a new .exe project, add a module to it with the following code: Public Declare Function FlashWindow _
Lib "user32" (ByVal hwnd As Long, _
ByVal bInvert As Long) As Long
Put a timer and 2 commandbuttons on form1 with these properties:
command1.caption="Start" command2.caption="Stop" timer1.interval=500 'flashes every 1/2 second timer1.enabled=false
Code
Private Sub Timer1_Timer() a& = FlashWindow(Me.hwnd, 1) End Sub
Private Sub Command1_Click() Timer1.Enabled = True End Sub
Private Sub Command2_Click() Timer1.Enabled = False End Sub Execute the app. (F5) and click the buttons.
Tip by Gijs de Jong
How to get the file size?
This is an easy way to get the file size of any file a user might
select. Lets assume you have a form with a directory list box
called mydir and a file list box named myfile. The user can scroll
to any directory on their hard drive, select a file from the file
list box and the program will tell them the size of that file.
Heres the code: Private Sub cmdShowFileSize_Click() Dim strOldFile As String Dim strOldSize As String Dim strMyDir As String Dim strMyFile As String 'Update the following with your directory and file 'info or use App.Path. This sample does not include 'error checking. strMyDir = "c:\windows\desktop" strMyFile = "readme.txt" strOldFile = strMyDir & "\" & strMyFile strOldSize = FileLen(strOldFile) lblFileSize.Caption = "The file " & strOldFile & " is " & _ Format(strOldSize, "#,##0") & " bytes in size." End Sub
How to use an isEven Function?
This function returns True if the number is even or False if it's odd: Function isEven(n As Integer) As Boolean isEven = True If n And 1 Then isEven = False End Function
How to roll a Form up and down?
Sub RollFormUp(frm As Form, up As Integer) 'Rolls a form up. Pay attention to the form's scalemode 'property. If it's set to pixels and you use a twip value, 'for example, your form will roll during an eternity! 'up - the amount you want the form to be rolled up 'It can be used as a splash window Dim UntilCond UntilCond = frm.Height - up If UntilCond <= 0 Then Exit Sub If up < 0 Then Exit Sub Do frm.Height = frm.Height - 1 DoEvents Loop Until frm.Height <= UntilCond End Sub Sub RollFormDown(frm As Form, down As Integer) 'Rolls a form down. Again, pay attention to the scalemode! 'down is the amount you may want your form to be rolled down Dim UntilCond UntilCond = frm.Height + down If down < 0 Then Exit Sub Do frm.Height = frm.Height + 1 DoEvents Loop Until frm.Height >= UntilCond End Sub Private Sub Command1_Click() Call RollFormDown(Form1, 100) End Sub
How to swap two interger variables?
Use the following algorithm to swap two interger variables: a = a Xor b b = a Xor b a = a Xor b
How to connect Lists boxes to Access database?
On Error GoTo process_err ' Now lets put the names into the Listbox. YourRS.MoveLast X = YourRS.RecordCount YourRS.MoveFirst Do List1.AddItem YourRS!yourfield Y = Y + 1: YourRS.MoveNext Loop Until Y = X ' X = last record remember. process_err: Select Case (Err) Case 3021 ' No current record record_count = 0 Exit Sub List1.Refresh End Select
How to order records in a RecordSet by a field?
' This orders all records in YourRS by YourField from Z-A. ' If you want it in A-Z order, just replace DESC with ASC. Set YourRS = YourDB.OpenRecordset("SELECT YourField.* FROM _
YourField " & "ORDER BY AnotherField DESC;")
How to add a file to Windows 95 documents list?
Place this code in a module: Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long,
ByVal pv As String) Code: Dim NewFile as String NewFile="c:\mydir\myfile.txt" SHAddToRecentDocs(2,NewFile)
How to clear Windows 95 documents list?
Place this code in a module: Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long,
ByVal pv As String) Code: SHAddToRecentDocs(2,vbNullString)
How to get screen resolution?
' Get the resolution. sHeight = Screen.Height \ Screen.TwipsPerPixelY sWidth = Screen.Width \ Screen.TwipsPerPixelX ' A message box. s = MsgBox("Your screen resolution is: " & sWidth & " x " & sHeight, ,
"Screen Resolution")
How to print a picture?
Printer.PaintPicture Picture1.Picture Printer.EndDoc
How to cancel a print job?
'This following also shows how to print out the multiple documents Printer.Print "Page 1" Printer.Newpage Printer.Print "Page 2" Printer.KillDoc
How to detect keypress outside your program?
Place this code in a module Declare Function GetAsyncKeyState Lib "user32"
(ByVal vKey As Long) As Integer ' This is the constant for the TAB key.
' Use the API Text Viewer to find the key you want to use. Public Const VK_TAB = &H9 Place this code in Timer1_Timer() If GetAsyncKeyState(VK_TAB) Then ' Beep if TAB-key is pressed Beep End If
How to hide the mouse pointer?
Place this code in a module. Declare Function ShowCursor Lib "user32" (ByVal bShow
As Long) As Long This code will hide the mouse pointer mypointer = ShowCursor(False) This code will show the mouse pointer mypointer = ShowCursor(True)
How to get the length of a string?
Dim i As Long i = Len(sYOURSTRING)
How to copy an image from one Picture Box to another Picture Box using the Clipboard?
Place this Command1_Click() ' Clear the Clipboard if it's another type of data in the Clipboard. Clipboard.Clear Clipboard.SetData Picture1.Picture Place this Command2_Click() ' Copy Clipboard text to Text2. Picture2.Picture = Clipboard.GetData
How to center a Picture Box on a form?
Picture1.Left = (Form1.Width - Picture1.Width) / 2
How to fill a form with confetti?
DrawWidth = 5 ' Width of the dots Dim x As Long Dim y As Long Dim r As Integer Dim g As Integer Dim b As Integer Randomize Do x = Val(Screen.Width) * Rnd y = Val(Screen.Height) * Rnd 'A random color to next dot. r = 255 * Rnd g = 255 * Rnd b = 255 * Rnd Form1.PSet (x, y), RGB(r, g, b) Loop
How to remove a picture to a Picturebox at run time?
Picture1.Picture = LoadPicture("")
How to add a picture to a Picturebox at run time?
Picture1.Picture = LoadPicture("c:\yourpicture.bmp")
How to count how many rows there are in a listview?
lItemCount = lstCount.ListItems.Count msgbox lItemCount
How to select all items in a listbox?
Place this code in cmdAddNew_Click() List1.AddItem Text1.Text ' Add new item Place this code in cmdSelectAll_Click() For x = 0 To List1.ListCount - 1 ' Loop all items List1.Selected(x) = True ' Select item(x) Next x
How to disable the Text Box beep?
Private Sub Text1_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub
How to make only lowercase letters in a textbox?
oldpos = Text1.SelStart Text1.Text = LCase(Text1.Text) 'use 'UCase' if you want uppercase Text1.SelStart = oldpos
How to create separator in the menus?
mnu.Caption="-"
How to add a new line to existing textbox text?
Dim strNewText As String With Text1 strNewText = "Updated: " & Date .SelStart = Len(.Text) .SelText = vbNewLine & strNewText End With
How to use the advanced feature of Message Box?
Dim Msg, Style, Title, Help, Ctxt, Response, MyString Msg = "Do you want to continue ?" ' Define message. Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons. Title = "MsgBox Demonstration" ' Define title. Help = "DEMO.HLP" ' Define Help file. Ctxt = 1000 ' Define topic ' context. ' Display message. Response = MsgBox(Msg, Style, Title, Help, Ctxt) If Response = vbYes Then ' User chose Yes. MsgBox "You click 'Yes'" ' Perform some action. Else ' User chose No. MsgBox "You click 'No'" ' Perform some action. End If
How to show your own Popup menu in the text box?
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single) If Button = 2 Then With Text1 .Enabled = False PopupMenu {YourMenu} .Enabled = True .SetFocus End With End If End Sub
How to make form controls to be movable (DRAG AND DROP)?
This is a tip on how to make controls movable on a form. This
example demonstrates a movable picture box. Option Explicit Public globalX As Integer Public globalY As Integer Private Sub Form_DragDrop(Source As Control, X As _ Single, Y As Single) Picture1.Move X - globalX, Y - globalY End Sub Private Sub Picture1_MouseDown(Button As Integer, _ Shift As Integer, X As Single, Y As Single) Picture1.Drag vbBeginDrag globalX = X globalY = Y End Sub
Tip by Levi Page
How to unload all the Forms to free memory?
Public Sub UnloadAllForms() Dim Form As Form For Each Form In Forms Unload Form Set Form = Nothing Next Form End Sub It is best to call this procedure from the unload event of
your main form.
Tip by John Percival
How to launch Windows Control Panel extensions using VB?
Option Explicit Private strPanelName As String Private Sub Command1_Click() strPanelName = File1.filename If strPanelName = "" Then MsgBox "A .CPL file was not selected." & vbCrLf & _ "The Windows Control Panel will be opened.",vbInformation End If Shell "rundll32.exe shell32.dll,Control_RunDLL " & _ strPanelName, vbNormalFocus End Sub Private Sub Form_Load() With File1 'Display Control Panel Extension files only: .Pattern = "*.CPL" 'Point the FileListBox to the System or System32 dir: .filename = "C:\Windows\System" End With End Sub
How to load a text file in one operation?
Function FileText (filename$) As String Dim handle As Integer handle = FreeFile Open filename$ For Input As #handle FileText = Input$(LOF(handle), handle) Close #handle End Function Text1.Text = FileText("c:\autoexec.bat")
How to suppress spaces in a TextBox?
To prevent users from typing spaces in a text box, include this
code in the KeyPress event of the text box: Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 32 Then KeyAscii = 0 End If End Sub -Meena Swaminathan, received by e-mail
How to speed up database access?
Here is a trick to loop through a recordset faster. Often when looping through
a recordset people will use the following code:
Do While Not Records.EOF Combo1.AddItem Records![Full Name] Eecords.Movenext Loop The problem is that everytime the database moves to the next record it must
make a check to see if it has reached the end of the file. This slows the
looping down a great deal. When moving or searching throuch a large record
set this can make a major difference. Here is a better way to do it. Records.MoveLast intRecCount=Records.RecordCount Records.MoveFirst For intCounter=1 To intRecCount Combo1.AddItem Records![Full Name] Records.MoveNext Next intCounter You should see about a 33% speed increase. Tip by Levi Page
How to Create Rainbow Text?
1. Start a new Standard Exe project; form1 is created by default 2. Type in the following code. Sub Form_Paint() Dim I As Integer, X As Integer, Y As Integer Dim C As String Cls For I = 0 To 91 X = CurrentX Y = CurrentY C = Chr(I) 'Line -(X + TextWidth(C), Y = TextHeight(C)), _ QBColor(Rnd * 16), BF CurrentX = X CurrentY = Y ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256) Print "Hello World Hello World Hello World Hello" Next End Sub 3. Run the program by pressing F5 or choosing start from the run program and watch the form fill with lots of multi-coloured text Tip by Steve Anderson
How to Add frequently used modules to the templates directory?
If you have modules or class modules that you use all the time in many of your
projects, you can add them to the Templates directory. It is usually
located in the VB directory (often C:\Program Files\DevStudio\VB) and is
called Template. Under the Template directory you will find several
directories that correspond to the types of files you can add, such as
Classes. Just copy your source code files to the appropriate directory and
go try to add the file to the project. Your files will appear under the New Tab.
Tip by James Limm
How to retrieve the screen resolution?
It is often very useful to be able to resize your Visual Basic program
depending on what the screen resolution is. In this tip, we will explain
how to find the resolution.
ResWidth = Screen.Width \ Screen.TwipsPerPixelX ResHeight = Screen.Height \ Screen.TwipsPerPixelY ScreenRes = ResWidth & "x" & ResHeight ResWidth will be set to the resolution of the width on the screen, and
ResHeight will be set to the resolution of the height of the screen.
ScreenRes will be set to something similar to: 800x600 Tip by James Limm
How to scroll caption on the form's title bar?
Sub TitleScroll(frm As Form) Dim X As Integer Dim current As Variant Dim Y As String Y = frm.Caption frm.Caption = "" frm.Show For X = 0 To Len(Y) If X = 0 Then frm.Caption = "" current = Timer Do While Timer - current < 0.1 DoEvents Loop GoTo done Else: End If frm.Caption = left(Y, X) current = Timer Do While Timer - current < 0.05 DoEvents Loop done: Next X End Sub
How to hide mouse cursor?
You can use the API function Showcursor to control the visibility of the
mouse cursor. To use this tip, paste this declaration into a module.
The Parameter lShow show be set to True (non-zero) to display the
cursor, False to hide it.
Public Declare Function ShowCursor& Lib "user32" (ByVal lShow As Long)
How to check if the credit card is valid?
Add this function to a .BAS or a form and to check whether a creditcard number
is valid, call it using something like: Valid = IsValidCreditCardNumber("4552012301230123") . Valid will then contain true or false depending on what number was passed to the function.
Public Function IsValidCreditCardNumber(ByVal pCardNumber As String) As Boolean Dim CharPos As Integer Dim CheckSum As Integer Dim tChar As String For CharPos = Len(pCardNumber) To 2 Step -2 CheckSum = CheckSum + CInt(Mid(pCardNumber, CharPos, 1)) tChar = CStr((Mid(pCardNumber, CharPos - 1, 1)) * 2) CheckSum = CheckSum + CInt(Left(tChar, 1)) If Len(tChar) > 1 Then CheckSum = CheckSum + CInt(Right(tChar, 1)) Next If Len(pCardNumber) Mod 2 = 1 Then CheckSum = CheckSum + CInt(Left(pCardNumber, 1)) If CheckSum Mod 10 = 0 Then IsValidCreditCardNumber = True Else IsValidCreditCardNumber = False End If End Function
How to check what the last day of a month is?
Public Function LastDayOfMonth(ByVal ValidDate As Date) As Byte Dim LastDay As Byte LastDay = DatePart("d", DateAdd("d", -1, DateAdd("m", 1, _ DateAdd("d", -DatePart("d", ValidDate) + 1, Date)))) LastDayOfMonth = LastDay End Function Private Sub Command1_Click() MsgBox "The last day of the month with date " & Date & _ " is " & LastDayOfMonth(Date) End Sub
How to open VB 6 file with VB 5?
You need first use notepad to open the VB 6 .vbp file. In VB 6 .vbp
file, find 'Retained = 0' statement, delete it, and save the file.
Now you can open VB 6 file without error message.
How to deal with Null strings in Access database fields?
By default Access string fields contain NULL values unless a string value
(including a blank string like "") has been assigned. When you read these
fields using recordsets into VB string variables, you get a runtime type-
mismatch error. The best way to deal with this problem is to use the built-
in & operator to concatenate a blank string to each field as you read it.
For example:
Dim DB As Database Dim RS As Recordset Dim sName As String Set DB = OpenDatabase("Test.mdb") Set RS = DB.OpenRecordset("Name") sName = "" & RS![Last Name]
How to make a form fade to black?
Sub FormFade(frm As Form) ' Makes Form Fade To Black ' Example: FormFade(Form1) For icolVal% = 255 To 0 Step -1 DoEvents frm.BackColor = RGB(icolVal%, icolVal%, icolVal%) Next icolVal% End Sub