"Search for directory default browser

Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long

Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_SUCCESS As Long = 32

Private Function GetBrowserName(dwFlagReturned As Long) As String

Dim l_hFile As Long
Dim sResult As String

"html file created while the later will be called
sResult = Space$(MAX_PATH)
dwFlagReturned = FindExecutable("dummy.html", App.Path, sResult)

"delete a file that is created
Kill App.Path & "\dummy.html"

"capture the location of executable files and dispose of character carridge return
GetBrowserName = TrimNull(sResult)

End Function

Private Sub Command1_Click()

Dim l_Temp As Long
Dim sBrowser As String

sBrowser = GetBrowserName(l_Temp)

Select Case l_Temp
Case Is >= ERROR_FILE_SUCCESS
MsgBox "Location of default browser: " & sBrowser, vbInformation
Case Else
MsgBox "Can't find default browser", vbInformation
End Select
End Sub

Sempel visual basic code soutrce Mouse Pointer in the middle of control
Sub CenterCursor(hWnd As Long)
Dim rPosition As RECT
#If Win32 Then
Dim X As Long
Dim Y As Long
#Else
Dim X As Integer
Dim Y As Integer
#End If

GetWindowRect hWnd, rPosition
X = (rPosition.right + rPosition.left) / 2
Y = (rPosition.bottom + rPosition.top) / 2
SetCursorPos X, Y
End Sub

CenterCursor hWnd:=Command1.hWnd

Sempel visual basic code soutrce Mouse Pointer in the middle of control

#If Win32 Then
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Declare Sub GetWindowRect Lib "User32" (ByVal hWnd As _
Long, lpRect As RECT)
Declare Sub SetCursorPos Lib "User32" (ByVal X As _
Long, ByVal Y As Long)
#Else
Type RECT
left As Integer
top As Integer
right As Integer
bottom As Integer
End Type

Declare Sub GetWindowRect Lib "User" (ByVal hWnd _
As Integer, lpRect As RECT)
Declare Sub SetCursorPos Lib "User" (ByVal X As _
Integer, ByVal Y As Integer)
#End If

Private Sub DataEnvironment_Initialize()
' The re-connection
Connection1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data " _
"Source=C:\nc\ims.mdb "
End Sub

Private Sub Command1_Click()


Dim Radius
Radius = InputBox("Type In The Radius", "Radius")
Dim Area
Area = 3.14 * (Radius * Radius)
MsgBox Area, vbDefaultButton1, "Answer"

Dim Answer


End Sub

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Declare Function sendmessagebystring Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Const WM_SETTEXT = &HC


Function FindChildByClass(parentw, childhand)

firs% = GetWindow(parentw, 5)
If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then Goto bone
firs% = GetWindow(parentw, GW_CHILD)
If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then Goto bone


While firs%
firss% = GetWindow(parentw, 5)
If UCase(Mid(GetClass(firss%), 1, Len(childhand))) Like UCase(childhand) Then Goto bone
firs% = GetWindow(firs%, 2)
If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then Goto bone
Wend

FindChildByClass = 0
bone:
room% = firs%
FindChildByClass = room%
End Function



Function FindChildByTitle(parentw, childhand)

firs% = GetWindow(parentw, 5)
If UCase(GetCaption(firs%)) Like UCase(childhand) Then Goto bone
firs% = GetWindow(parentw, GW_CHILD)


While firs%
firss% = GetWindow(parentw, 5)
If UCase(GetCaption(firss%)) Like UCase(childhand) & "*" Then Goto bone
firs% = GetWindow(firs%, 2)
If UCase(GetCaption(firs%)) Like UCase(childhand) & "*" Then Goto bone
Wend

FindChildByTitle = 0
bone:
room% = firs%
FindChildByTitle = room%
End Function



Sub RenameWelcomeWindow(NewCaption As String)

ao% = FindWindow("AOL Frame25", vbNullString)
bb% = FindChildByClass(ao%, "MDIClient")
arf = FindChildByTitle(bb%, "Welcome, ")
Call ChangeWindowCap(arf, NewCaption)
End Sub



Sub ChangeWindowCap(WindowClassName, NewName As String)

b = sendmessagebystring(WindowClassName, WM_SETTEXT, 0, NewName)
End Sub

Sub Command1_Click ()

RenameWelcomeWindow("New Welcome Menu Caption")
End Sub


info: planetsourcecode.com

Declare Function ShowCursor& Lib "user32" _
 (ByVal bShow As Long)
 'Add this code to Command1.


Private Sub Command1_Click()

 ShowCursor (bShow = True)
End Sub

'Add this to Command2.


Private Sub Command2_Click()

 ShowCursor (bShow = False)
End Sub

In this tutorial we'll be learning how to make a simple stopwatch.

2 Labels with:

#1 Label:
Name: Label1
Caption: SIMPLE STOPWATCH

#2 Label:
Name: Label2
Caption: 0.00

4 Command Buttons with:

#1 Command Button:
Name: Command1
Caption: START

#2 Command Button:
Name: Command2
Caption: STOP

#3 Command Button:
Name: Command3
Caption: RESET

#4 Command Button:
Name: Command4
Caption: QUIT

1 Timer with:
Name: Timer1
Caption: (None)
Interval: 1

Code
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Command3_Click()
Label2.Caption = "0.00"
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Timer1_Timer()
Label2.Caption = Format(Val(Label2.Caption) + 0.01, _
"fixed")
End Sub

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

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Command3_Click()
Label2.Caption = "0.00"
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Timer1_Timer()
Label2.Caption = Format(Val(Label2.Caption) + 0.01, _
"fixed")
End Sub

This means make Label2's caption change by adding +0.01 to it every millisecond.

Explanation:

1. InStr is a function that looks for the position of a substring in a phrase.

InStr(phrase,"ual") will find the substring "ual" from "Visual Basic" and then return its position, in this case, it is 4 from the left.

2. Left is a function that extracts characters from a phrase, starting from the left. Left(phrase,4) means 4 characters are extracted from the phrase, starting from the leftmost position.

3. Right is a function that extracts characters from a phrase, starting from the Right. Right(phrase,5) means 5 characters are extracted from the phrase, starting from the rightmost position.

4. Mid is a function that extracts a substring from a phrase, starting from the posiiton specified by the second parameter in the bracket.Mid(phrase,8,3) means a substring of three characters are extracted from the phrase, starting from the 8th position from the left

5. Len is a function that return the length of a phrase.

Private Sub cmdInstr_Click()
Dim phrase As String
phrase = Cells(1, 1).Value
Cells(4, 1) = InStr(phrase, "ual")
End Sub

Private Sub cmdLeft_Click()
Dim phrase As String
phrase = Cells(1, 1).Value
Cells(2, 1) = Left(phrase, 4)

End Sub

Private Sub cmdLen_Click()
Dim phrase As String
phrase = Cells(1, 1).Value
Cells(6, 1) = Len(phrase)
End Sub

Private Sub cmdMid_Click()
Dim phrase As String
phrase = Cells(1, 1).Value
Cells(5, 1) = Mid(phrase, 8, 3)
End Sub

Private Sub cmdRight_Click()
Dim phrase As String
phrase = Cells(1, 1).Value
Cells(3, 1) = Right(phrase, 5)

Private Sub Label1_Click()

  Top = (Screen.Height - Width) / 1
  Left = (Screen.Width - Height) / 2
  Top = (Screen.Height - Width) / 3
  Left = (Screen.Width - Height) / 4
  Top = (Screen.Height - Width) / 5
  Left = (Screen.Width - Height) / 6
  Top = (Screen.Height - Width) / 7
  Left = (Screen.Width - Height) / 8
  Top = (Screen.Height - Width) / 9
  Top = (Screen.Height - Width) / 10
  Left = (Screen.Width - Height) / 12
  Top = (Screen.Height - Width) / 13
  Left = (Screen.Width - Height) / 14
  Top = (Screen.Height - Width) / 15
  Left = (Screen.Width - Height) / 16
  Top = (Screen.Height - Width) / 17
  Left = (Screen.Width - Height) / 18
  Top = (Screen.Height - Width) / 19
  Left = (Screen.Width - Height) / 20
  Top = (Screen.Height - Width) / 21
  Left = (Screen.Width - Height) / 22
  Top = (Screen.Height - Width) / 23
  Left = (Screen.Width - Height) / 24
  Top = (Screen.Height - Width) / 25
  Left = (Screen.Width - Height) / 26
  Top = (Screen.Height - Width) / 27
  Left = (Screen.Width - Height) / 28
  Top = (Screen.Height - Width) / 29
  Left = (Screen.Width - Height) / 30
  Top = (Screen.Height - Width) / 31
  Left = (Screen.Width - Height) / 32
  Top = (Screen.Height - Width) / 31
  Top = (Screen.Height - Width) / 30
  Left = (Screen.Width - Height) / 29
  Top = (Screen.Height - Width) / 28
  Left = (Screen.Width - Height) / 27
  Top = (Screen.Height - Width) / 26
  Left = (Screen.Width - Height) / 25
  Top = (Screen.Height - Width) / 24
  Left = (Screen.Width - Height) / 23
  Top = (Screen.Height - Width) / 22
  Top = (Screen.Height - Width) / 21
  Left = (Screen.Width - Height) / 20
  Top = (Screen.Height - Width) / 19
  Left = (Screen.Width - Height) / 18
  Top = (Screen.Height - Width) / 17
  Left = (Screen.Width - Height) / 16
  Top = (Screen.Height - Width) / 15
  Left = (Screen.Width - Height) / 14
  Top = (Screen.Height - Width) / 13
  Left = (Screen.Width - Height) / 12
  Top = (Screen.Height - Width) / 11
  Left = (Screen.Width - Height) / 10
  Top = (Screen.Height - Width) / 9
  Left = (Screen.Width - Height) / 8
  Top = (Screen.Height - Width) / 7
  Left = (Screen.Width - Height) / 6
  Top = (Screen.Height - Width) / 5
  Left = (Screen.Width - Height) / 4
  Top = (Screen.Height - Width) / 3
  Left = (Screen.Width - Height) / 2
  Top = (Screen.Width + Height) / 2
  Left = (Screen.Height + Width) / 3
  Top = (Screen.Width + Height) / 4
  Left = (Screen.Height + Width) / 5
  Top = (Screen.Width + Height) / 6
  Left = (Screen.Height + Width) / 7
  Top = (Screen.Width + Height) / 8
  Left = (Screen.Height + Width) / 9
  Top = (Screen.Width + Height) / 10
  Left = (Screen.Height + Width) / 11
  Top = (Screen.Width + Height) / 12
  Left = (Screen.Height + Width) / 13
  Top = (Screen.Width + Height) / 14
  Left = (Screen.Height + Width) / 15
  Top = (Screen.Width + Height) / 16
  Left = (Screen.Height + Width) / 17
  Top = (Screen.Width + Height) / 18
  Left = (Screen.Height + Width) / 19
  Top = (Screen.Width + Height) / 20
  Left = (Screen.Height + Width) / 21
  Top = (Screen.Width + Height) / 22
  Left = (Screen.Height + Width) / 23
  Top = (Screen.Width + Height) / 24
  Left = (Screen.Height + Width) / 25
  Top = (Screen.Width + Height) / 26
  Left = (Screen.Height + Width) / 27
  Top = (Screen.Width + Height) / 28
  Left = (Screen.Height + Width) / 29
  Top = (Screen.Width + Height) / 30
  Left = (Screen.Height + Width) / 31
  Top = (Screen.Width + Height) / 32
  Left = (Screen.Height + Left) / 31
  Top = (Screen.Width + Top) / 30
  Left = (Screen.Height + Left) / 29
  Top = (Screen.Width + Top) / 28
  Left = (Screen.Height + Left) / 27
  Top = (Screen.Width + Top) / 26
  Left = (Screen.Height + Left) / 25
  Top = (Screen.Width + Top) / 24
  Left = (Screen.Height + Left) / 23
  Top = (Screen.Width + Top) / 22
  Left = (Screen.Height + Left) / 21
  Top = (Screen.Width + Top) / 20
  Left = (Screen.Height + Left) / 19
  Top = (Screen.Width + Top) / 18
  Left = (Screen.Height + Left) / 17
  Top = (Screen.Width + Top) / 16
  Left = (Screen.Height + Left) / 15
  Top = (Screen.Width + Top) / 14
  Left = (Screen.Height + Left) / 13
  Top = (Screen.Width + Top) / 12
  Left = (Screen.Height + Left) / 11
  Top = (Screen.Width + Top) / 10
  Left = (Screen.Height + Left) / 9
  Top = (Screen.Width + Top) / 8
  Left = (Screen.Height + Left) / 7
  Top = (Screen.Width + Top) / 6
  Left = (Screen.Height + Left) / 5
  Top = (Screen.Width + Top) / 4
  Left = (Screen.Height + Left) / 3
  Top = (Screen.Width + Top) / 2
  Left = (Screen.Height + Left) / 1


  Form1.Show
    
  End Sub

Private b1() As Byte
Private b2() As Byte


Public Function Simil(String1 As String, String2 As String) As Double

Dim l1 As Long
Dim l2 As Long
Dim l As Long
Dim r As Double


If UCase(String1) = UCase(String2) Then
r = 1
Else
l1 = Len(String1)
l2 = Len(String2)


If l1 = 0 Or l2 = 0 Then
r = 0
Else
ReDim b1(1 To l1): ReDim b2(1 To l2)


For l = 1 To l1
b1(l) = Asc(UCase(Mid(String1, l, 1)))
Next



For l = 1 To l2
b2(l) = Asc(UCase(Mid(String2, l, 1)))
Next

r = SubSim(1, l1, 1, l2) / (l1 + l2) * 2
End If

End If

Simil = r
Erase b1
Erase b2
End Function



Private Function SubSim(st1 As Long, end1 As Long, st2 As Long, end2 As Long) As Long

Dim c1 As Long
Dim c2 As Long
Dim ns1 As Long
Dim ns2 As Long
Dim i As Long
Dim max As Long
If st1 > end1 Or st2 > end2 Or st1 <= 0 Or st2 <= 0 Then Exit Function


For c1 = st1 To end1


For c2 = st2 To end2
i = 0


Do Until b1(c1 + i) <> b2(c2 + i)
i = i + 1


If i > max Then
ns1 = c1
ns2 = c2
max = i
End If

If c1 + i > end1 Or c2 + i > end2 Then Exit Do
Loop

Next

Next

max = max + SubSim(ns1 + max, end1, ns2 + max, end2)
max = max + SubSim(st1, ns1 - 1, st2, ns2 - 1)


SubSim = max

End Function

Public Function screenWipe(Form As Form, CutSpeed As Integer) As Boolean

Dim OldWidth As Integer
Dim OldHeight As Integer


Form.WindowState = 0


If CutSpeed <= 0 Then
MsgBox "You cannot use 0 as a speed value"
Exit Function
End If



Do
OldWidth = Form.Width


Form.Width = Form.Width - CutSpeed


DoEvents


If Form.Width <> OldWidth Then


Form.Left = Form.Left + CutSpeed / 2


DoEvents
End If

OldHeight = Form.Height


Form.Height = Form.Height - CutSpeed


DoEvents


If Form.Height <> OldHeight Then


Form.Top = Form.Top + CutSpeed / 2


DoEvents
End If

Loop While Form.Width <> OldWidth Or Form.Height <> OldHeight

Unload Form
End Function

Private Sub Form_Load()

'main is the form that shows up after th
' e intro art, could be form1, main or wha
' tever you call it.
'main.visible=false , that hides the ori
' ginal form
Main.Visible = False
'makes the following coding randomized
Randomize
'lets it know there will be three option
' s


Select Case Int((Rnd * 3) + 1)
'if case 1 is selected then the intro1 f
' orm loads
Case 1
intro1.Visible = True
'if case 2 is selected then the intro2 f
' orm loads
Case 2
intro2.Visible = True
'if case 3 is selected then the intro3 f
' orm loads
Case 3
intro3.Visible = True
'ends it
End Select

'*******END CODING*********
'inside intro1,2,3, you should have eith
' er a timer and after an alloted time it
' makes main.visible=true, and/or on Mouse
' Click of the picture itself. so heres an
' d example
'Intro1
'if someone clicks on the intro picture
' on intro1
'Private Sub Picture_click()
'hides the intro
'intro1.visible=false
'shows main iface
'main.visible=true
'End Sub

VERSION 5.00
Begin VB.Form Form1
BackColor=&H80000007&
Caption ="(c)1999 Mr Slade, please visit me at http://hem.passagen.se/tonek/vb"
ClientHeight=2205
ClientLeft =60
ClientTop=345
ClientWidth =6120
ControlBox =0'False
LinkTopic="Form1"
ScaleHeight =2205
ScaleWidth =6120
StartUpPosition =3 'Windows Default
Begin VB.Timer Timer1
Interval=500
Left=0
Top =0
End
Begin VB.Label Label1
Alignment=1 'Right Justify
BackStyle=0 'Transparent
BeginProperty Font
Name="Garamond"
Size=11.25
Charset =0
Weight =400
Underline=0'False
Italic =0'False
Strikethrough=0'False
EndProperty


ForeColor=&H0080C0FF&
Height =255
Left=840
TabIndex=0
Top =840
Width=4335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'// Let you make scrollable text in a la
' bel without moving the label.. its fixed
' ...
'// ----------------
'// Got it from: http://hem.passagen.se/
' tonek/vb
'// Author : Martin Tonek
'// Date of upload : July/15/1999
'// ----------------
'// Remember that this code only functio
' n with the assigned fonts,fontssize and
'// labelwidth. It will look more nicer
' when using ths font that have a fixed
'// width then a font like arial. Also t
' he labelwidth was set for 41 letters so
'// when changing the font you have to c
' hange labelwidth or/and settings for
'// letters.
'//
'// CAUTION!! Change the source code and
' the code can fail!!
'//
'// AddMezz (c)1998 EzySoft, All rights
' reserved
Dim s As Integer
Dim dta As String


Private Sub Form_Load()

'// Centering the form
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
'// Change Label and Timer prefs
Label1.Caption = ""
Timer1.Enabled = True
Timer1.Interval = 100
Label1.Width = 4335
Label1.Font = "Courier New"
Label1.Font.Size = 9
Label1.Font.Bold = True
End Sub



Private Sub Timer1_Timer()

'// put your text here in dta string
dta = "Mr Slade made IT - please visit http://hem.passagen.se/tonek/vb For updates and other avalible sources! (c)1999 Mr Slade" & Space$(41)
s = s + 1
Label1.Caption = Mid(dta, 1, s)
If Len(Label1.Caption) >= 42 Then Label1.Caption = Right(Label1.Caption, 41)


If s = Len(dta) Then
Label1.Caption = ""
s = 0
End If

End Sub