This code will show you how to make "Tip of the day" form. You will need to make he tips in Text Form (.txt) in NotePad, nad name it TIPOFDAY.TXT.
Make a command button named cmdNextTip, picture box named Picture1, lable box named lblTipText, and a checkbox name chkLoadTipsAtStartup_Click.
Option Explicit
Const TIP_FILE = ""
Dim CurrentTip As Long
Private Sub DoNextTip()
' Select a tip at random.
CurrentTip = Int((Tips.Count * Rnd) + 1)
' Or, you could cycle through the Tips in order
' CurrentTip = CurrentTip + 1
' If Tips.Count < CurrentTip Then
' CurrentTip = 1
' End If
' Show it.
frmTip.DisplayCurrentTip
End Sub
Function LoadTips(sFile As String) As Boolean
Dim NextTip As String ' Each tip read in from file.
Dim InFile As Integer ' Descriptor for file.
' Obtain the next free file descriptor.
InFile = FreeFile
' Make sure a file is specified.
If sFile = "" Then
LoadTips = False
Exit Function
End If
' Make sure the file exists before trying to open it.
If Dir(sFile) = "" Then
LoadTips = False
Exit Function
End If
' Read the collection from a text file.
Open sFile For Input As InFile
While Not EOF(InFile)
Line Input #InFile, NextTip
Tips.Add NextTip
Wend
Close InFile
' Display a tip at random.
DoNextTip
LoadTips = True
End Function
Private Sub chkLoadTipsAtStartup_Click()
End Sub
Private Sub Check1_Click()
SaveSetting App.EXEName, "Options", "Show Tips at Startup", Check1.Value
End Sub
Private Sub cmdHelp_Click()
Dim nRet As Integer
'if there is no helpfile for this project display a message to the user
'you can set the HelpFile for your application in the
'Project Properties dialog
If Len(App.HelpFile) = 0 Then
MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
Else
On Error Resume Next
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub cmdNewWeb_Click()
Dialog.Show vbModal, Me
Me.Hide
End Sub
Private Sub cmdNextTip_Click()
DoNextTip
cmdPrevious.Enabled = True
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Command2_Click()
End Sub
Private Sub Form_Load()
Randomize
' Read in the tips file and display a tip at random.
If LoadTips(App.Path & "" & TIP_FILE) = False Then
lblTipText.Caption = "That the " & TIP_FILE & " file was not found? " & vbCrLf & vbCrLf & _
"Create a text file named " & TIP_FILE & " using NotePad with 1 tip per line. " & _
"Then place it in the same directory as the application. "
End If
End Sub
Public Sub DisplayCurrentTip()
If Tips.Count > 0 Then
lblTipText.Caption = Tips.Item(CurrentTip)
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu frmTip.mnuWhatsThis1
End If
Comments