Visual Basic - How to source code

From: Subject: Visual Basic - How to source code Date: Sat, 4 Jun 2005 01:39:24 -0700 MIME-Version: 1.0 Content-Type: text/html; charset="Windows-1252" Content-Transfer-Encoding: quoted-printable Content-Location: http://www.jpatt.net/files/tutorials/vbhowto.htm X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1106 Visual Basic - How to source code

Visual Basic - How to with source code

How=20 to add text items with a different color in a = Listbox?=20
How=20 to enable the form close button?=20
How=20 to include a .wav file in a .exe file?=20
How=20 to get ride of the quotation marks when saving strings in a text=20 file?=20
How=20 to set the source of one combo to be the contents of another=20 combo?=20
How=20 to create multi-column combo box?=20
How=20 to create a label that is vertically oriented?=20
How=20 to compare two strings using wildcards?=20
How=20 to format dates so that they look correct in all date and langauge=20 formats?=20
How=20 to create message boxes with those cool red X's?=20
How to make = text=20 box that displays "*" when you tpye in (For password=20 purpose)?=20
How=20 to create a textbox that lets you insert tabs?=20
How=20 to implement hotkeys for text boxes?=20
How=20 to copy the content of text1 into text2?=20
How=20 to make a menu popup from a Commandbutton?=20
How=20 to detect the change in the Textbox?=20
How=20 to change the content of a Statusbar at run time?=20
How=20 to load text file into a Listbox?=20
How=20 to use Undo function for Textbox or Combobox?=20
How=20 to copy text from the clipboard?=20
How=20 to copy text to the clipboard?=20
How=20 to code Toolbar click events?=20
How=20 to tell the difference between CDbl and Val = function?=20
How=20 to calculate the age based on date of birth?=20
How=20 to check for 4-digit year date?=20
How=20 to perform generic error handling routine?=20
How=20 to shell to web address?=20
How=20 to round a number to nearest 10, 100, 1000, etc.?=20
How=20 to put 13 X 13 bitmaps into a menu?=20
How=20 to create menus at run time?=20
How=20 to encrypt text?=20
How=20 to make a form fade to black?=20
How=20 to scroll caption on the form's title bar?=20
How=20 to hide mouse cursor?=20
How=20 to check if the credit card is valid?=20
How=20 to check what the last day of a month is?=20
How=20 to open VB 6 file with VB 5?=20
How=20 to deal with Null strings in Access database = fields?=20
How=20 to retrieve the screen resolution?=20
How=20 to Add frequently used modules to the templates = directory?=20
How=20 to speed up database access?=20
How=20 to Create Rainbow Text?=20
How=20 to suppress spaces in a TextBox?=20
How=20 to load a text file in one operation?=20
How=20 to launch Windows Control Panel extensions using = VB?=20
How=20 to unload all the Forms to free memory?=20
How=20 to make form controls to be movable (DRAG AND = DROP)?=20
How=20 to show your own Popup menu in the text box?=20
How=20 to use the advanced feature of Message Box?=20
How=20 to add a new line to existing textbox text?=20
How=20 to create separator in the menus?=20
How=20 to make only lowercase letters in a textbox?=20
How=20 to disable the Text Box beep?=20
How=20 to select all items in a listbox?=20
How=20 to count how many rows there are in a listview?=20
How=20 to add a picture to a Picturebox at run time?=20
How=20 to remove a picture to a Picturebox at run time?=20
How=20 to fill a form with confetti?=20
How=20 to center a Picture Box on a form?=20
How=20 to copy an image from one Picture Box to another Picture Box using the = Clipboard?=20
How=20 to get the length of a string?=20
How=20 to hide the mouse pointer?=20
How=20 to detect keypress outside your program?=20
How=20 to cancel a print job?=20
How=20 to print a picture?=20
How=20 to get screen resolution?=20
How=20 to clear Windows 95 documents list?=20
How=20 to add a file to Windows 95 documents list?=20
How=20 to order records in a RecordSet by a field?=20
How=20 to connect Lists boxes to Access database?=20
How=20 to swap two interger variables?=20
How=20 to roll a Form up and down?=20
How=20 to use an isEven Function?=20
How=20 to get the file size?=20
How=20 to make the title bar flash?=20
How=20 to disable Ctrl-Alt-Delete and Ctrl-Esc?=20
How=20 to detect if the system has a sound card?=20
How=20 to find out which user is logged in?=20
How=20 to determine free disk space?=20
How=20 to dither a form?=20
How=20 to shade a control?=20
How=20 to change the color of Title Bar?=20
How=20 to count lines in Rich Text Box?=20
How=20 to create two lines on Command Button?=20
How=20 to get rid of leading zeros in strings?=20
How=20 to create percentage ProgressBar?=20
How=20 to reverse a string?=20
How=20 to make a form on top?=20
How=20 to do word search?=20
How=20 to delete a file?=20
How=20 to delete a directory?=20
How=20 to rename a file?=20
How=20 to test for weekend?=20
How=20 to set the ToolTipText on a ListBox?=20
How=20 to use the IIf function?=20
How=20 to set Tab Stops in a ListBox?=20
How=20 to include an '&' on a Label?=20
How=20 to repair Access database in VB?=20
How=20 to reboot the system from VB?=20
How=20 to use free file number when reading or writing a = file?=20
How=20 to get only the file name?=20
How = to capitalize the first letter of each word in a = string?=20
How=20 to determine if your program is already running?=20
How=20 to make an internet connection?=20
How=20 to place a Combo Box onto a Toolbar?=20
How=20 to round a number?=20
How=20 to select all text when a TextBox gets focus?=20
How=20 to read a file line by line?=20
How=20 to use Instr function?=20
How=20 to use Str function?=20
How=20 to use the advanced feature of Input Box?=20
How=20 to use Val function?=20
How=20 to add records in the database?=20
How=20 to use Len function?=20
How=20 to use LTrim, RTrim, and Trim Functions?=20
How=20 to use Right function?=20
How=20 to use Left function?=20
How=20 to use Mid function?=20
How=20 to get rid of leading zeros in strings?=20
How=20 to get the Number of Lines In a TextBox?=20
How=20 to search Listboxes as you type?=20
How=20 to read a file character by character?=20
How=20 to add something to an existing file (with data)?=20
How=20 to add something to an existing file by overwriting = it?=20
How=20 to use SetAttr function?=20
How=20 to change the mouse pointer?=20
How=20 to change the button's foreground color?=20
How=20 to show a modal form?=20
How=20 to show a modeless form?=20
How=20 to fix the problem of playing the .wav file only = once?=20
How=20 to make Crystal Reports run faster?=20
How=20 to call a Command button without clicking it?=20
How=20 to capture keys pressed to use as keyboard = shortcuts?=20
How=20 to use the advanced feature of MsgBox?=20
How=20 to toggle between Insert & Overwrite in a text = box?=20

How to = implement hotkeys=20 for text boxes?

Create a label with your hotkey. Set the =
tabindex of the label=20
to one less then the TabIndex of the textbox

How = to create a=20 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=20 password purpose)?

Just set the PasswordChar property of =
the text box or rich text box to=20
"*" or your favorite character.=20

How = to create=20 message boxes with those cool red X's?

MsgBox "My =
Message", vbCritical, "My Title"

How=20 to format dates so that they look correct in all date and langauge = formats?=20

Command1.Caption =3D Format$(Date, "Short Date")

How to = compare two=20 strings using wildcards?

Dim Mystr As String
Mystr =3D "Street"
If Mystr Like "S*" Then
    MsgBox "Found"
Else
    MsgBox "Not found"
End If

How = to create a=20 label that is vertically oriented?

Private Sub =
Form_Activate()
   Dim s As String
   Label1.Caption =3D "Binoj's VB Land"
   For i =3D 1 To Len(Label1)
     s =3D s & Mid$(Label1, i, 1) & vbCrLf=20
   Next

   Label1 =3D s
End Sub

Note: You need to drag the Label1 vertically

How to create = multi-column=20 combo box?

Add Microsoft Forms 2.0 control, there's a =
combo that=20
supports multicolumns.

Combo1.Clear
Combo1.ColumnCount =3D 2
Combo1.ListWidth =3D "6 cm" 'Total width
Combo1.ColumnWidths =3D "2 cm;4 cm" 'Column widths
Combo1.AddItem "Text in column 0"
Combo1.List(0, 1) =3D "Text in column 1"

How=20 to set the source of one combo to be the contents of another combo? =

sub comboA_click()
   comboB.text =3D comboA.text
end sub

If you want the value selected in comboA to be added to the=20
list of choices in comboB, the following code will do it:

sub comboA_click()
   comboB.AddItem comboA.text
end sub

How=20 to get ride of the quotation marks when saving strings in a text = file?

Use the Print # statement instead of the Write # =
statement.=20
The Print # statement doesn't put quotation marks around your strings.

How to = include a .wav=20 file in a .exe file?

Use a resource file. Include the .wav =
file as a custom resource.=20
Check the resource files in the help and look at the loadresdata=20
function.

How to enable the = form close=20 button?

dim bCanClose as Boolean

Then put this into the form's QueryUnload event:

If bCanClose =3D false then cancel =3D true

How to=20 add text items with a different color in a Listbox?

Use =
the MSFlexGrid control

How to load text = file into a=20 Listbox?

Statusbar1.Panels(1).Text =3D "Start"

How to=20 change the content of a Statusbar at run time?

Private Sub =
Command1_Click()   =20
   Dim StringHold As String   =20

   Open "C:\test.txt" For Input As #1   =20

   List1.Clear   =20
   While Not EOF(1)       =20
      Input #1, StringHold       =20
      List1.AddItem StringHold   =20
   Wend   =20
   Close #1
End Sub

How to detect = the change=20 in the Textbox?

Private bChanged As Boolean

Private Sub Text1_Change()   =20
   bChanged =3D True
End SubPrivate=20

Sub Form_Unload(Cancel As Boolean)=20
   If bChanged Then       =20
      If Msgbox("Save Changes?", vbYesNo, "Save") =3D vbYes Then         =
  =20
         'Save Changes Here.       =20
      End If   =20
   End If
End Sub

How to = make a menu=20 popup from a Commandbutton?

First, create a menu with the =
menu editor.=20
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)=20
End Sub

P.S. For added effect, replace the line:

Call PopupMenu(mnuBtn)=20

With this one:

Call PopupMenu(Menu:=3DmnuBtn, X:=3DCommand1.Left, Y:=3DCommand1.Top + _
Command1.Height) ' Even more viola!

Or this one:

Call PopupMenu(mnuBtn, vbPopupMenuCenterAlign, Command1.Left + _
(Command1.Width / 2), Command1.Top + Command1.Height)=20

How to copy = the=20 content of text1 into text2?

If you have VB6.0 you can use =
the Replace Function to=20
easily replace any Character(s) with something else, eg.


Text2 =3D Replace(Text1, vbCrLf, "
" & vbCrLf)


Otherwise, you'll need to step though the Text yourself=20
checking for instances of vbCrLf, e.g.



code:


Dim sString As String
Dim sNewString As Strings

String =3D Text1
While Instr(sString, vbCrLf)   =20
   sNewString =3D sNewString & Left(sString, _
   Instr(sString, vbCrLf) - 1) & "
" & vbCrLf   =20
   sString =3D Mid(sString, Instr(sString, vbCrLf) + 2)
Wend
Text2 =3D sNewString

How to encrypt text? =

encryption function :

Public Function Encrypt(ByVal Plain As String)
For I=3D1 To Len(Plain)=20
Letter=3DMid(Plain,I,1)
Mid(Plain,I,1)=3DChr(Asc(Letter)+1)

Next
Encrypt =3D Plain
End Sub

Public Function Decrypt(ByVal Encrypted As String)
For I=3D1 to Len(Encrypted)=20
Letter=3DMid(Encrypted,I,1)
Mid(Encrypted,I,1)=3DChr(Asc(Letter)-1)

Next
Decrypt =3D Encrypted
End Sub

Print Encrypt("This is just an example")
Print Decrypt("Uijt!jt!kvtu!bo!fybnqmf")

How to create menus at = run=20 time?

  Dim index As Integer   =20
  index =3D mnuHook.Count   =20
  Load mnuHook(index)
  mnuHook(index).Caption =3D "New Menu Entry"   =20
  mnuHook(index).Visible =3D True

'mnuHook is the menu that the new entry appears after

How to put 13 X = 13 bitmaps=20 into a menu?

'Add a picturebox control.=20
'Set 'Autosize' to 'True' with a bitmap (not an Icon)=20
'at a maximum of 13X13.=20

'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 =3D &H400&

'Place this code into the form load event:

Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long
mHandle =3D GetMenu(hwnd)
sHandle =3D GetSubMenu(mHandle, 0)
lRet =3D SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, imOpen.Picture, =
imOpen.Picture)
lRet =3D SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, imSave.Picture, =
imSave.Picture)
lRet =3D SetMenuItemBitmaps(sHandle, 3, MF_BYPOSITION, imPrint.Picture, =
imPrint.Picture)
lRet =3D SetMenuItemBitmaps(sHandle, 4, MF_BYPOSITION, =
imPrintSetup.Picture, imPrintSetup.Picture)
sHandle =3D GetSubMenu(mHandle, 1)
sHandle2 =3D GetSubMenu(sHandle, 0)
lRet =3D SetMenuItemBitmaps(sHandle2, 0, MF_BYPOSITION, imCopy.Picture, =
imCopy.Picture)

How to round=20 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 =3D Int(Dose / Factor)
  Round =3D Temp * Factor
 =20
End Function

How to shell to web = address?=20

'Put this in the click event of a control

   Dim iRet As Long   =20
   Dim Response As Integer

   Response =3D 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 =3D Shell("start.exe http://www.rxkinetics.com", vbNormal)
     Case vbNo
       Exit Sub
   End Select

How to = perform=20 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 =3D "Error " & Err.Number & " " & Err.Description=20
  MsgBox strErr, vbCritical + vbOK, "Error message"

How to check for = 4-digit year=20 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 =3D False

'Exit if length less than "m/d/yyyy"
  If Len(MDate) < 8 Then Exit Function
 =20
'Exit if not a valid date wrong
  If IsDate(MDate) =3D False Then Exit Function
 =20
'Exit if not ending or starting with "yyyy"
  Dim StartDate As String
  Dim EndDate As String
 =20
  EndDate =3D Right(MDate, 4)
  StartDate =3D Left(MDate, 4)
 =20
  If ValidChar(EndDate, "0123456789") =3D False And _
     ValidChar(StartDate, "0123456789") =3D False Then Exit Function
   =20
'Set to true if it passes all these tests!
  ValidDate =3D True

End Function

How to = calculate=20 the age based on date of birth?

'Convert text to Date
  Dim Birth as Date
  Birth =3D DateValue(txtDOB)

'Calculate age
  Dim Age as Integer
  Age =3D Int(DateDiff("D", Birth, Now) / 365.25)

How to=20 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=20 events?

Private Sub Toolbar1_ButtonClick(ByVal Button As =
Button)
'Handle button clicks
  Select Case Button.Key
    Case Is =3D "Exit"
     'If user clicks the No button, stop Exit
   If MsgBox("Do you want to exit?", vbQuestion + vbYesNo  + _
   vbDefaultButton2, "Exiting Code Bank") =3D vbNo Then Exit Sub
       Call ExitProgram
    Case Is =3D "Repair"
       Call Repairdb
    Case Is =3D "Delete"
       Call DeleteRoutine
    Case Is =3D "Edit"
       Call EditRoutine
    Case Is =3D "New"
       Call NewRoutine
    Case Is =3D "Copy"
       Call CopyToClipboard
    Case Is =3D "Help"
       Call ShowHelpContents
  End Select
=20
End Sub

How to copy text to = the=20 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=20 clipboard?

'Select Text in txtBox & copy from =
clipboard
   txtBox.SelText =3D Clipboard.GetText=20

'Or replace entire text
   txtBox.Text =3D Clipboard.GetText

How to = use Undo=20 function for Textbox or Combobox?

'Windows API provides an =
undo function
    =20
'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 =3D &h400
  Global Const EM_UNDO =3D WM_USER + 23
    =20
'And in your Undo Sub do the following:
  UndoResult =3D SendMessage(myControl.hWnd, EM_UNDO, 0, 0)
 'UndoResult =3D -1 indicates an error.

How to=20 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 =3D vbKeyInsert Then
       If lblOVR =3D "Over" Then
         lblOVR =3D "Insert"
       Else
         lblOVR =3D "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
 =20
    If lblOVR =3D "Over" Then
       If KeyAscii <> 8 And txtText.SelLength =3D 0 Then
          txtText.SelLength =3D 1   '8=3Dbackspace
       End If
    Else
       txtText.SelLength =3D 0
    End If

  End Sub

How to use = the advanced=20 feature of MsgBox?

'This method works well, unless you =
need to save the=20
'answer from your Select Case for later use. If you do,=20
'you'll need to use the more standard form of=20
'prompting for the answer in a variable.=20

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") =3D =
vbNo Then Exit Sub

How to=20 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 =3D (Shift And vbAltMask) > 0

  'Alt + A =3D Shortcut for AddNew   =20
   If AltDown And KeyCode =3D vbKeyA Then   ' A =3D Add
      Data1.Recordset.AddNew
   End If

End Sub

How to = call a=20 Command button without clicking it?

cmdCommand =3D True

How to make = Crystal=20 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:=20


MaxRecordMemory=3D0
MetapageSpillLimit=3D100

How to=20 fix the problem of playing the .wav file only once?

Always =
include the "Close" statement before "Open"


MMControl1.Command =3D "Close"
MMControl1.Filename =3D "C:\1.mid"
MMControl1.Command =3D "Open"
MMControl1.Command =3D "Play"

How to show a modeless = form?=20

frmPass.Show vbModeless

How to show a modal form? =

frmPass.Show vbModal

How to = change the=20 button's foreground color?

To use the Microsoft Control: =
Microsoft Forms 2.0 Object Library

How to change the mouse = pointer?

Screen.MousePointer =3D 0 'Default
Screen.MousePointer =3D 11 'Hourglass

How to use SetAttr = function?=20

SetAttr "C:\data.txt", vbNormal
SetAttr "C:\data.txt", vbReadOnly

How to=20 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=20 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=20 character by character?

Do While Not EOF(1)
   myChar =3D Input(1, #1) 'one char a line
   WholeWord =3D WholeWord & myChar
Loop

How to search = Listboxes as=20 you type?

By changing the SendMessage Function's "ByVal =
wParam as Long" to=20

"ByVal wParam as String", we change the search ability from first =

letter only, to "change-as-we-type" searching.=20


Here's some example code. Start a new Standard EXE project and add=20

a ListBox (List1) and a TextBox (Text1), then paste in the =

following code :=20



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 =3D &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 =3D SendMessage(List1.hWnd, LB_FINDSTRING, Text1,    =
 
byval Text1.Text)
End Sub

How to get = the Number=20 of Lines In a TextBox?

This method is straightforward: it =
uses SendMessage to retrieve the=20

number of lines in a textbox. A line to this method is defined as a=20

new line after a word-wrap; it is independent of the number of hard=20

returns in the text.


Declarations                    =20


Public Declare Function SendMessageLong Lib "user32" Alias=20

"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,ByVal=20

wParam As Long, ByVal lParam As Long) As Long


Public Const EM_GETLINECOUNT =3D &HBA=20


The Code                            =20


Sub Text1_Change()
    Dim lineCount as Long
    On Local Error Resume Next
 =20
  'get/show the number of lines in the edit control
    lineCount =3D SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, =
0&)
    Label1 =3D Format$(lineCount, "##,###")
End Sub=20


Special Note                   =20


The textbox passed to the SendMessage API must have its multiline=20

property set to true at design time. The EM_GETLINECOUNT message=20

does not pass additional parameters to the API in the wParam or =
lParam 
variables. These must be 0.=20

How to get = rid of=20 leading zeros in strings?

Function KillZeros(incoming as =
string) as string=20
   KillZeros =3D CStr(CInt(incoming))=20
End Function=20

How to use Mid function? =

Dim MyString, FirstWord, LastWord, MidWords
MyString =3D "Mid Function Demo"	' Create text string.
FirstWord =3D Mid(MyString, 1, 3)	' Returns "Mid".
LastWord =3D Mid(MyString, 14, 4)	' Returns "Demo".
MidWords =3D Mid(MyString, 5)	' Returns "Function Demo".

How to use Left function? =

Dim AnyString, MyStr
AnyString =3D "Hello World"	' Define string.
MyStr =3D Left(AnyString, 1)	' Returns "H".
MyStr =3D Left(AnyString, 5)	' Returns " Hello".

How to use Right = function?

Dim AnyString, MyStr
AnyString =3D "Hello World"	' Define string.
MyStr =3D Right(AnyString, 1)	' Returns "d".
MyStr =3D Right(AnyString, 6)	' Returns " World".
MyStr =3D Right(AnyString, 20)	' Returns "Hello World".

How to use = LTrim,=20 RTrim, and Trim Functions?

Dim MyString, TrimString
MyString =3D "  <-Trim->  "	' Initialize string.
TrimString =3D LTrim(MyString)	' TrimString =3D "<-Trim->  ".
TrimString =3D RTrim(MyString)	' TrimString =3D "  <-Trim->".
TrimString =3D LTrim(RTrim(MyString))	' TrimString =3D "<-Trim->".
' Using the Trim function alone achieves the same result.
TrimString =3D Trim(MyString)	' TrimString =3D "<-Trim->".

How to use Len function? =

Dim MyString
MyString =3D "Hello World"	' Initialize variable.
MyLen =3D Len(MyString)	' Returns 11.

How to add records = in the=20 database?

Private dbCurrent As Database
Private recCategories As Recordset


Set dbCurrent =3D OpenDatabase(cFilePathMajor & "\Record.mdb", =
False)
Set recCategories =3D dbCurrent.OpenRecordset("select * from Record")
       =20
With recCategories
    .AddNew
    !Date =3D Date
    !Time =3D Time
    .Update
End With


recCategories.Close
dbCurrent.Close
Set dbCurrent =3D Nothing

How to use Val function? =

This example uses the Val function to return the numbers =
contained=20

in a string.


Dim MyValue
MyValue =3D Val("2457")	' Returns 2457.
MyValue =3D Val(" 2 45 7")	' Returns 2457.
MyValue =3D Val("24 and 57")	' Returns 24.

How to use = the=20 advanced feature of Input Box?

Dim Message, Title, =
Default, MyValue
Message =3D "Enter a value between 1 and 3"	' Set prompt.
Title =3D "InputBox Demo"	' Set title.
Default =3D "1"	' Set default.
' Display message, title, and default value.
MyValue =3D InputBox(Message, Title, Default)

' Use Helpfile and context. The Help button is added automatically.
MyValue =3D InputBox(Message, Title, , , , "DEMO.HLP", 10)

' Display dialog box at position 100, 100.
MyValue =3D InputBox(Message, Title, Default, 100, 100)

How to use Str function? =

This example uses the Str function to return a string =
representation=20

of a number. When a number is converted to a string, a leading =

space is always reserved for its sign.


Dim MyString
MyString =3D Str(459)	' Returns " 459".
MyString =3D Str(-459.65)	' Returns "-459.65".
MyString =3D Str(459.001)	' Returns " 459.001".

How to use Instr = function?

This example uses the InStr function to return =
the position=20

of the first occurrence of one string within another.


Dim SearchString, SearchChar, MyPos
SearchString =3D"XXpXXpXXPXXP"	' String to search in.
SearchChar =3D "P"	' Search for "P".

' A textual comparison starting at position 4. Returns 6.
MyPos =3D Instr(4, SearchString, SearchChar, 1)=09

' A binary comparison starting at position 1. Returns 9.
MyPos =3D Instr(1, SearchString, SearchChar, 0)

' Comparison is binary by default (last argument is omitted).
MyPos =3D Instr(SearchString, SearchChar)	' Returns 9.

MyPos =3D Instr(1, SearchString, "W")	' Returns 0.

How to read a file line = by=20 line?

Do While Not EOF(1)
   Line Input #1, LineHolder
   LineHolder =3D LineHolder + 1
Loop

How to = select=20 all text when a TextBox gets focus?

Public Sub =
TextSelected()
   Dim tBox As TextBox
   Set tBox =3D Screen.ActiveControl
   If TypeOf tBox Is TextBox Then
      tBox.SelStart =3D 0
      tBox.SelLength =3D Len(tBox)
   End If
End Sub

How to round a number? =

Function RoundNumber(lNumber, Optional iDecimalPlaces As =
Integer =3D 1)
    RoundNumber =3D Int(lNumber * (10 ^ iDecimalPlaces) + 0.5) / _
    (10 ^ iDecimalPlaces)
End Function

How to place a = Combo Box=20 onto a Toolbar?

To put a combo box on a toolbar, create a =
place holder and position the=20

combobox above the place holder in the z-order. You can't place the =
combo=20

box inside the place holder. Instead, follow these steps:=20


1) Create a button with the PlaceHolder style.=20
2) Show the form.=20
3) In the Form_Load event set the Top and Left properties of the combo=20
   box to the same value as the PlaceHolder button.=20
4) Set the z-order of the combo box to zero to bring it to the front.=20
5) In the Form_Resize event, make sure the Top and Left properties of =
the
   combo box are the same as the PlaceHolder button.=20


Private Sub Form_Load()
   Dim btnX As Button
   Me.Show
   Set btnX =3D Toolbar1.Buttons.Add()
   btnX.Style =3D tbrSeparator
   Set btnX =3D Toolbar1.Buttons.Add()
   btnX.Style =3D tbrPlaceholder
   btnX.Key =3D "combo"
   btnX.Width =3D 2000
   With Combo1
      .ZOrder 0.Width =3D Toolbar1.Buttons("combo").Width
      .Top =3D Toolbar1.Buttons("combo").Top
      .Left =3D Toolbar1.Buttons("combo").Left
   End With
End Sub


--A. Nicklas Malik

How to make an = internet=20 connection?

Dim res
res =3D Shell("rundll32.exe rnaui.dll,RnaDial " _

& "connection_name", 1)

How = to=20 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 =3D True Then
  Call MsgBox("This program is already running!",_
  vbExclamation)
  End
End If


Tip by James Limm

How=20 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?=20

MsgBox OnlyFileName("c:\windows\win.com","\")	'gives you =
'win.com'

Function OnlyFileName(vPath$, vSlash$) As String
    Dim p%
   =20
    OnlyFileName =3D vPath
    For p% =3D Len(vPath$) To 0 Step -1
        If Mid$(vPath$, p%, 1) =3D vSlash$ Then
            OnlyFileName =3D Mid$(vPath$, p% + 1, Len(vPath$) - p% + 1)
            Exit Function
        End If
    Next p%
End Function

How to=20 use free file number when reading or writing a file? =

Private Sub GetFile(FileName$)
   Dim nFilenumber%
   Dim tmpLine$

   Text1.Text =3D ""
   nFilenumber =3D FreeFile
   Open FileName$ For Input As #nFilenumber
   Do While Not EOF(nFileNumber)
       Input #nFileNumber, tmpLine
       Text1.Text =3D Text1.Text & tmpline
   Loop
   Close #nFileNumber
End Sub

How to reboot the = system from=20 VB?

Declare Function ExitWindowsEx Lib "user32" (ByVal =
uFlags As Long,
ByVal dwReserved As Long) As Boolean

Public Const EWX_FORCE =3D 4
Public Const EWX_LOGOFF =3D 0
Public Const EWX_REBOOT =3D 2
Public Const EWX_SHUTDOWN =3D 1

...
Dim res As Boolean
res =3D ExitWindowsEx (EWX_REBOOT, 0)
If Not res Then=20
   MsgBox "Function failed"
Else
   MsgBox "Shutting down Windows NOW!"
   End
EndIf

How to repair = Access database=20 in VB?

Private Sub Command1_Click()
    On Error GoTo Repair_Error
    Dim MDB_Name As String

    CommonDialog1.Filter =3D "Access (*.mdb)|*.mdb"
    CommonDialog1.Flags =3D &H1000
    CommonDialog1.FilterIndex =3D 1
    CommonDialog1.Action =3D 1

    If CommonDialog1.FileName <> "" Then
        Screen.MousePointer =3D 11
        MDB_Name =3D CommonDialog1.FileName
        RepairDatabase (MDB_Name)
        Screen.MousePointer =3D 0
        MsgBox "Database repaired successfully", 64, "Repair"
    End If
    Screen.MousePointer =3D 0
    Exit Sub
Repair_Error:
    MsgBox "Error when repairing database", 16, "Error"
    Screen.MousePointer =3D 0
    Exit Sub
End Sub

How to include an = '&' on=20 a Label?

Since an ampersand (&) on a label will =
indicate an access key (with=20

an underscore below to use with the Alt Key selection combination),=20

you may want to have an ampersand actually appear as part of the=20

text of the label.

To accomplish this, simply put two ampersands together like ... =
&&

How to set Tab Stops = in a=20 ListBox?

Want to create a simple list box that shows =
several fields of data?=20

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 =3D &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) =3D 0
Tabs(1) =3D 100
Tabs(2) =3D 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?=20

This example uses the IIf function to evaluate the TestMe =
parameter=20

of the CheckIt procedure and returns the word "Large" if the=20

amount is greater than 1000; otherwise, it returns the word "Small".

Function CheckIt (TestMe As Integer)
   CheckIt =3D IIf(TestMe > 1000, "Large", "Small")
End Function

How to set the=20 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 =3D Me.Font.Size
   Me.Font.Size =3D List1.Font.Size
   YPos =3D Y \ Me.TextHeight("Xyz") + List1.TopIndex
   Me.Font.Size =3D iOldFontSize
   If YPos < List1.ListCount Then
      List1.ToolTipText =3D List1.List(YPos)
   Else
      List1.ToolTipText =3D ""
   End If
End Sub

How to test for weekend? =

If (WeekDay (Date) MOD 6 =3D 1) then=20
   Msgbox "It's the weekend!"=20
End if=20

How to rename a file? =

Dim OldName, NewName
OldName =3D "OLDFILE": NewName =3D "NEWFILE"   ' Define file names.
Name OldName As NewName   ' Rename file.=20

OldName =3D "C:\MYDIR\OLDFILE": NewName =3D "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 =3D FindMatch(Text1.Text, Text2.Text)
    If X =3D 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
=20
    Match =3D InStr(Str1, Str2)
=20
    If Match <> 0 Then
        Char1 =3D Mid$(Str1, Match - 1, 1)
            If Codes(Char1) Then
                Char2 =3D Mid$(Str1, Match + Len(Str2), 1)
                If Codes(Char2) Then
                    FindMatch =3D True: Exit Function
                End If
            End If
    End If
=20
    FindMatch =3D 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 =3D "," Or PuncStr =3D "." Or PuncStr =3D " " Or _
    
PuncStr =3D Chr(10) Or PuncStr =3D Chr(13) Or PuncStr =3D Chr(9) =
Then
        Codes =3D True
    Else
        Codes =3D 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 =3D -1

Global Const HWND_NOTOPMOST =3D -2


Sub MakeTopMost (frmForm As Form, LX%, LY%, RX%, RY%)
    Dim succes As Long

    succes =3D SetWindowPos(frmForm.hWnd, HWND_TOPMOST, LX%, LY%, RX%, =
RY%, 0)

End Sub

Sub UnMakeTopMost (frmForm As Form)
    Dim succes As Long

    succes =3D 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 =3D ""
   For doreverse =3D Len(revstr) To 1 Step -1
      reversestring =3D reversestring & Mid$(revstr, doreverse, 1)
   Next
End Function


Use


Dim strResult As String
strResult =3D reversestring("String")
MsgBox strResult


Tip by John Percival

How to create = percentage=20 ProgressBar?

Sub Command1_Click ()=20
   picture1.ForeColor =3D RGB(0, 0, 255) 'use blue bar=20
   For i =3D 0 To 100 Step 2=20
      updateprogress picture1, i
   Next=20
   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 =3D -1 'no, make one
   End If=20
   pb.Cls 'clear picture in memory
   pb.ScaleWidth =3D 100 'new sclaemodus=20
   pb.DrawMode =3D 10 'not XOR Pen Modus=20
   num$ =3D Format$(percent, "###") + "%"=20
   pb.CurrentX =3D 50 - pb.TextWidth(num$) / 2=20
   pb.CurrentY =3D (pb.ScaleHeight - pb.TextHeight(num$)) / 2=20
   pb.Print num$ 'print percent=20
   pb.Line (0, 0)-(percent, pb.ScaleHeight), , BF
   pb.Refresh 'show differents
End Sub

How to get = rid of=20 leading zeros in strings?

Function KillZeros(incoming as =
string) as string=20
   KillZeros =3D CStr(CInt(incoming))=20
End Function=20

How to create = two lines=20 on Command Button?

command1.caption =3D "first line above" =
& vbCRLF & "second=20

line beyond.."=20

How to count lines = in Rich=20 Text Box?

By using the SendMessage API function and the =
EM_GETLINECOUNT=20

message you could easily write a wrapper function that returns=20

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 =3D &HBA

Public Function LineCount(txtBox As TextBox) As Long
   LineCount =3D SendMessage( _
   TxtBox.hWnd, EM_GETLINECOUNT, 0&, 0&)
End Function

How to change the = color of=20 Title Bar?

You can globally change any Windows 95 desktop =
colour using the=20

SetSysColors function. It takes three parameters : The number=20

of colour elements to change, The Color object constant that=20

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=20

The Constants are:

Public Const COLOR_SCROLLBAR =3D 0 'The Scrollbar colour=20
Public Const COLOR_BACKGROUND =3D 1 'Colour of the background with no =
wallpaper=20
Public Const COLOR_ACTIVECAPTION =3D 2 'Caption of Active Window=20
Public Const COLOR_INACTIVECAPTION =3D 3 'Caption of Inactive window=20
Public Const COLOR_MENU =3D 4 'Menu=20
Public Const COLOR_WINDOW =3D 5 'Windows background=20
Public Const COLOR_WINDOWFRAME =3D 6 'Window frame=20
Public Const COLOR_MENUTEXT =3D 7 'Window Text=20
Public Const COLOR_WINDOWTEXT =3D 8 '3D dark shadow (Win95)=20
Public Const COLOR_CAPTIONTEXT =3D 9 'Text in window caption=20
Public Const COLOR_ACTIVEBORDER =3D 10 'Border of active window=20
Public Const COLOR_INACTIVEBORDER =3D 11 'Border of inactive window=20
Public Const COLOR_APPWORKSPACE =3D 12 'Background of MDI desktop=20
Public Const COLOR_HIGHLIGHT =3D 13 'Selected item background=20
Public Const COLOR_HIGHLIGHTTEXT =3D 14 'Selected menu item=20
Public Const COLOR_BTNFACE =3D 15 'Button=20
Public Const COLOR_BTNSHADOW =3D 16 '3D shading of button=20
Public Const COLOR_GRAYTEXT =3D 17 'Grey text, of zero if dithering is =
used.=20
Public Const COLOR_BTNTEXT =3D 18 'Button text=20
Public Const COLOR_INACTIVECAPTIONTEXT =3D 19 'Text of inactive window=20
Public Const COLOR_BTNHIGHLIGHT =3D 20 '3D highlight of button=20


To change the colour of the title bar, or caption, of an active=20

window, you would call the function in this way:

t& =3D SetSysColors(1, COLOR_ACTIVECAPTION, RGB(255,0,0))=20

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.=20

Code:
Add this code to the module:

Global Const GFM_BACKSHADOW =3D 1
Global Const GFM_DROPSHADOW =3D 2
Public Sub ControlShadow(f As Form, C As Control, shadow_effect _

As Integer, shadow_width As Integer, shadow_color As Long)=20
Dim shColor As Long=20
Dim shWidth As Integer=20
Dim oldWidth As Integer=20
Dim oldScale As Integer=20
shWidth =3D shadow_width=20
shColor =3D shadow_color=20
oldWidth =3D f.DrawWidth=20
oldScale =3D f.ScaleMode=20
f.ScaleMode =3D 3=20
f.DrawWidth =3D 1=20
Select Case shadow_effect=20
Case GFM_DROPSHADOW=20
f.Line (C.Left + shWidth, C.Top + shWidth)-Step(C.Width - 1, _

C.Height - 1), shColor, BF=20
Case GFM_BACKSHADOW=20
f.Line (C.Left - shWidth, C.Top - shWidth)-Step(C.Width - 1, _

C.Height - 1), shColor, BF
End Select
f.DrawWidth =3D oldWidth
f.ScaleMode =3D oldScale
End Sub

Add this code to the form's Load procedure:

Private Sub Form_Load()
   Dim r
   r=3DControlShadow(me,text1,1,2,black)
End Sub

How to dither a form? =

Ever wonder how the SETUP.EXE screen gets its cool shaded =
background=20

coloring? This color shading is called dithering, and you can=20

easily incorporate it into your forms. Add the following routine=20

to a form: To call it, put the following statement in the=20

Form_Activate event : - Dither Me=20


Sub Dither(vForm As Form)

   Dim intLoop As Integer

   vForm.DrawStyle =3D vbInsideSolid
   vForm.DrawMode =3D vbCopyPen
   vForm.ScaleMode =3D vbPixels
   vForm.DrawWidth =3D 2
   vForm.ScaleHeight =3D 256

   For intLoop =3D 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=20 space?

Use the function GetDiskFreeSpace. The declaration =
for this API=20

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& =3D GetDiskFreeSpace("c:\", SectorsPerCluster, _
BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters)
FreeBytes =3D NumberOfFreeClusters * SectorsPerCluster * _
BytesPerSector
The Long FreeBytes contains the number of free bytes on the drive.


Tip by James Limm

How to find out = which=20 user is logged in?

Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser as String
cnt =3D 199
s =3D String$(200, 0)
dl =3D GetUserName(s, cnt)
If dl <> 0 Then curuser =3D Left$(s, cnt) Else curuser =3D ""


You must declare the following function in the declarations section=20

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=20 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 Long

Dim i As Integer
i =3D waveOutGetNumDevs()
If i > 0 Then=20
    MsgBox "Your system can play sound files.", _
    vbInformation, "Sound Card Test"=20
Else=20
    MsgBox "Your system can not play sound Files.", _
    vbInformation, "Sound Card Test"=20
End If


Tip by James Limm

How to = disable=20 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 =3D 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=20 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=3D"Start"
command2.caption=3D"Stop"
timer1.interval=3D500 'flashes every 1/2 second
timer1.enabled=3Dfalse


Code


Private Sub Timer1_Timer()
   a& =3D FlashWindow(Me.hwnd, 1)
End Sub


Private Sub Command1_Click()
   Timer1.Enabled =3D True
End Sub


Private Sub Command2_Click()
   Timer1.Enabled =3D 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=20

select. Lets assume you have a form with a directory list box=20

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=20

list box and the program will tell them the size of that file.=20

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 =3D "c:\windows\desktop"
strMyFile =3D "readme.txt"

strOldFile =3D strMyDir & "\" & strMyFile
strOldSize =3D FileLen(strOldFile)
 =20
lblFileSize.Caption =3D "The file " & strOldFile & " is " & =
_
Format(strOldSize, "#,##0") & " bytes in size."

End Sub

How to use an isEven = Function?=20

This function returns True if the number is even or False if =
it's odd: =20
 =20
Function isEven(n As Integer) As Boolean   =20
   isEven =3D True   =20
   If n And 1 Then isEven =3D False   =20
End Function   =20

How to roll a Form up = and=20 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 =3D frm.Height - up
If UntilCond <=3D 0 Then Exit Sub
If up < 0 Then Exit Sub

Do
frm.Height =3D frm.Height - 1
DoEvents
Loop Until frm.Height <=3D 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 =3D frm.Height + down

If down < 0 Then Exit Sub

Do
frm.Height =3D frm.Height + 1
DoEvents
Loop Until frm.Height >=3D UntilCond

End Sub

Private Sub Command1_Click()
  Call RollFormDown(Form1, 100)
End Sub

How to swap two = interger=20 variables?

Use the following algorithm to swap two =
interger variables:

a =3D a Xor b
b =3D a Xor b
a =3D a Xor b

How to = connect=20 Lists boxes to Access database?

On Error GoTo process_err

' Now lets put the names into the Listbox.
YourRS.MoveLast
X =3D YourRS.RecordCount
YourRS.MoveFirst

Do
    List1.AddItem YourRS!yourfield
    Y =3D Y + 1: YourRS.MoveNext
Loop Until Y =3D X ' X =3D last record remember.
process_err:
Select Case (Err)
Case 3021 ' No current record
    record_count =3D 0
    Exit Sub
    List1.Refresh
End Select

How to = order=20 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 =3D YourDB.OpenRecordset("SELECT YourField.* FROM _

YourField " & "ORDER BY AnotherField DESC;")

How to = add a file=20 to Windows 95 documents list?

Place this code in a module: =
=20

  Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, =


ByVal pv As String)
=20
Code: =20

  Dim NewFile as String
  NewFile=3D"c:\mydir\myfile.txt"
  SHAddToRecentDocs(2,NewFile)
=20

How to clear = Windows 95=20 documents list?

Place this code in a module: =20
  Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, =


ByVal pv As String)

Code: =20

  SHAddToRecentDocs(2,vbNullString)
=20

How to get screen = resolution?=20

' Get the resolution.
sHeight =3D Screen.Height \ Screen.TwipsPerPixelY
sWidth =3D Screen.Width \ Screen.TwipsPerPixelX

' A message box.
s =3D MsgBox("Your screen resolution is: " & sWidth & " x " =
& sHeight, ,=20

"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=20 keypress outside your program?

Place this code in a module =
=20

Declare Function GetAsyncKeyState Lib "user32"=20
  
(ByVal vKey As Long) As Integer
 =20
  ' This is the constant for the TAB key.  =20

' Use the API Text Viewer to find the key you want to use.
Public Const VK_TAB =3D &H9
=20
Place this code in Timer1_Timer() =20

If GetAsyncKeyState(VK_TAB) Then
   ' Beep if TAB-key is pressed
   Beep
End If
=20

How to hide the mouse = pointer?=20

Place this code in a module. =20

Declare Function ShowCursor Lib "user32" (ByVal bShow=20

As Long) As Long
=20
This code will hide the mouse pointer =20

  mypointer =3D ShowCursor(False)

This code will show the mouse pointer =20

  mypointer =3D ShowCursor(True)
=20

How to get the length = of a=20 string?

Dim i As Long
i =3D Len(sYOURSTRING)

How=20 to copy an image from one Picture Box to another Picture Box using the=20 Clipboard?

Place this Command1_Click() =20

  ' Clear the Clipboard if it's another type of data in the Clipboard.
  Clipboard.Clear
  Clipboard.SetData Picture1.Picture
=20
Place this Command2_Click() =20

  ' Copy Clipboard text to Text2.
  Picture2.Picture =3D Clipboard.GetData
=20

How to center a = Picture Box=20 on a form?

Picture1.Left =3D (Form1.Width - =
Picture1.Width) / 2=20

How to fill a form = with=20 confetti?

  DrawWidth =3D 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 =3D Val(Screen.Width) * Rnd
   y =3D Val(Screen.Height) * Rnd

   'A random color to next dot.
   r =3D 255 * Rnd
   g =3D 255 * Rnd
   b =3D 255 * Rnd

   Form1.PSet (x, y), RGB(r, g, b)
  Loop

How = to remove=20 a picture to a Picturebox at run time?

Picture1.Picture =
=3D LoadPicture("")

How to = add a=20 picture to a Picturebox at run time?

Picture1.Picture =3D =
LoadPicture("c:\yourpicture.bmp")

How = to count=20 how many rows there are in a listview?

lItemCount =3D =
lstCount.ListItems.Count=20
msgbox lItemCount

How to select all = items in a=20 listbox?

Place this code in cmdAddNew_Click() =20

  List1.AddItem Text1.Text ' Add new item
Place this code in cmdSelectAll_Click() =20

  For x =3D 0 To List1.ListCount - 1 ' Loop all items
   List1.Selected(x) =3D True ' Select item(x)
  Next x
=20

How to disable the = Text Box=20 beep?

Private Sub Text1_KeyPress(KeyAscii As Integer) =20
   KeyAscii =3D 0
End Sub

How to = make only=20 lowercase letters in a textbox?

oldpos =3D Text1.SelStart
Text1.Text =3D LCase(Text1.Text) 'use 'UCase' if you want uppercase
Text1.SelStart =3D oldpos

How to create = separator in=20 the menus?

mnu.Caption=3D"-"

How to = add a new=20 line to existing textbox text?

Dim strNewText As String
With Text1
   strNewText =3D "Updated: " & Date
   .SelStart =3D Len(.Text)
   .SelText =3D vbNewLine & strNewText
End With

How to = use the=20 advanced feature of Message Box?

Dim Msg, Style, Title, =
Help, Ctxt, Response, MyString
Msg =3D "Do you want to continue ?"   ' Define message.
Style =3D vbYesNo + vbCritical + vbDefaultButton2   ' Define buttons.
Title =3D "MsgBox Demonstration"   ' Define title.
Help =3D "DEMO.HLP"   ' Define Help file.
Ctxt =3D 1000   ' Define topic
      ' context.
      ' Display message.
Response =3D MsgBox(Msg, Style, Title, Help, Ctxt)
If Response =3D 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=20 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 =3D 2 Then
        With Text1
            .Enabled =3D False
            PopupMenu {YourMenu}
            .Enabled =3D True
            .SetFocus
        End With
    End If
End Sub

How to=20 make form controls to be movable (DRAG AND DROP)?

This is =
a tip on how to make controls movable on a form. This=20

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 =3D X
globalY =3D Y
End Sub



Tip by Levi Page

How to = unload all the=20 Forms to free memory?

Public Sub UnloadAllForms()
Dim Form As Form
   For Each Form In Forms
      Unload Form
      Set Form =3D Nothing
   Next Form
End Sub
It is best to call this procedure from the unload event of=20

your main form.



Tip by John Percival

How to=20 launch Windows Control Panel extensions using VB?

Option =
Explicit

Private strPanelName As String

Private Sub Command1_Click()
    strPanelName =3D File1.filename
    If strPanelName =3D "" 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 " & _=20
             strPanelName, vbNormalFocus
End Sub

Private Sub Form_Load()
    With File1
        'Display Control Panel Extension files only:
        .Pattern =3D "*.CPL"
        'Point the FileListBox to the System or System32 dir:
        .filename =3D "C:\Windows\System"
    End With
End Sub

How to load a = text file=20 in one operation?

Function FileText (filename$) As String
    Dim handle As Integer
    handle =3D FreeFile
    Open filename$ For Input As #handle
    FileText =3D Input$(LOF(handle), handle)
    Close #handle
End Function

Text1.Text =3D FileText("c:\autoexec.bat")

How to suppress = spaces in a=20 TextBox?

To prevent users from typing spaces in a text =
box, include this=20

code in the KeyPress event of the text box:

Private Sub Text1_KeyPress(KeyAscii As Integer)
        If KeyAscii =3D 32 Then
                KeyAscii =3D 0
        End If
End Sub

-Meena Swaminathan, received by e-mail

How to speed up = database=20 access?

Here is a trick to loop through a recordset =
faster. Often when looping through 
a recordset people will use the =
following code:
=20

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=3DRecords.RecordCount
Records.MoveFirst

For intCounter=3D1 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 =3D 0 To 91
X =3D CurrentX
Y =3D CurrentY
C =3D Chr(I)
'Line -(X + TextWidth(C), Y =3D TextHeight(C)), _
QBColor(Rnd * 16), BF
CurrentX =3D X
CurrentY =3D Y
ForeColor =3D 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=20 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=20 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=20

how to find the resolution.
=20
ResWidth =3D Screen.Width \ Screen.TwipsPerPixelX
ResHeight =3D Screen.Height \ Screen.TwipsPerPixelY
ScreenRes =3D 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=20 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 =3D frm.Caption
   frm.Caption =3D ""
   frm.Show
   For X =3D 0 To Len(Y)
   If X =3D 0 Then
   frm.Caption =3D ""
   current =3D Timer
   Do While Timer - current < 0.1
   DoEvents
   Loop
   GoTo done
   Else: End If
   frm.Caption =3D left(Y, X)
   current =3D 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=20

mouse cursor.  To use this tip, paste this declaration into a =
module. =20

The Parameter lShow show be set to True (non-zero) to display the=20

cursor, False to hide it.

Public Declare Function ShowCursor& Lib "user32" (ByVal lShow As =
Long)    =20

How to check = if the=20 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 =3D IsValidCreditCardNumber("4552012301230123")
.  Valid will then contain true or false depending on=20
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 =3D Len(pCardNumber) To 2 Step -2
    CheckSum =3D CheckSum + CInt(Mid(pCardNumber, CharPos, 1))
    tChar =3D CStr((Mid(pCardNumber, CharPos - 1, 1)) * 2)
    CheckSum =3D CheckSum + CInt(Left(tChar, 1))

    If Len(tChar) > 1 Then CheckSum =3D CheckSum + CInt(Right(tChar, =
1))
  Next

  If Len(pCardNumber) Mod 2 =3D 1 Then CheckSum =3D CheckSum + =
CInt(Left(pCardNumber, 1))

  If CheckSum Mod 10 =3D 0 Then
    IsValidCreditCardNumber =3D True
  Else
    IsValidCreditCardNumber =3D False
  End If

End Function

How to = check what=20 the last day of a month is?

Public Function =
LastDayOfMonth(ByVal ValidDate As Date) As Byte
  Dim LastDay As Byte

  LastDay =3D DatePart("d", DateAdd("d", -1, DateAdd("m", 1, _
              DateAdd("d", -DatePart("d", ValidDate) + 1, Date))))

  LastDayOfMonth =3D 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=20 5?

You need first use notepad to open the VB 6 .vbp =
file. In VB 6 .vbp

file, find 'Retained =3D 0' statement, delete it, and save the file. =


Now you can open VB 6 file without error message.=20

How to=20 deal with Null strings in Access database fields?

By =
default Access string fields contain NULL values unless a string value=20

(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=20
Set DB =3D OpenDatabase("Test.mdb")
Set RS =3D DB.OpenRecordset("Name")
sName =3D "" & RS![Last Name]

How to make a form = fade to=20 black?

Sub FormFade(frm As Form)
   ' Makes Form Fade To Black
   ' Example: FormFade(Form1)
   For icolVal% =3D 255 To 0 Step -1
   DoEvents
   frm.BackColor =3D RGB(icolVal%, icolVal%, icolVal%)
   Next icolVal%
End Sub

Binoj V Antony