| Option Explicit Dim Tips As New Collection ' The in-memory database of tips. Const TIP_FILE = "TIPOFDAY.TXT" ' Name of tips file Dim CurrentTip As Long ' Index in collection of tip currently being displayed. Private Sub DoNextTip() CurrentTip = Int((Tips.Count * Rnd) + 1) ' Select a tip at random. ' Or, you could cycle through the Tips in order: ' CurrentTip = CurrentTip + 1 ' If Tips.Count < CurrentTip Then ' CurrentTip = 1 ' End If frmTip.DisplayCurrentTip ' Show it. 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. InFile = FreeFile ' Obtain the next free file descriptor. ' 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() ' save whether or not this form should be displayed at startup SaveSetting App.EXEName, "Options", "Show Tips at Startup", chkLoadTipsAtStartup.Value End Sub Private Sub cmdNextTip_Click() DoNextTip End Sub Private Sub cmdOK_Click() Unload Me End Sub Private Sub Form_Load() Dim ShowAtStartup As Long ' See if we should be shown at startup ShowAtStartup = GetSetting(App.EXEName, "Options", "Show Tips at Startup", 1) If ShowAtStartup = 0 Then Unload Me Exit Sub End If ' Set the checkbox, this will force the value to be written back out to the registry Me.chkLoadTipsAtStartup.Value = vbChecked ' Seed Rnd 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 |
Tip Of The Day |
Express News India | Freelance ecommerce web development India