首先建立一個工程檔案，添加一個模組，兩個表單。表單分別命名為frmMain和frmTips。在frmMain中添加一個按鈕，雙擊並輸入如下代碼：
Private Sub cmdOK_Click()
Unload Me
End Sub
在frmTips表單上添加如下控制項：三個按鈕，分別命名為：cmdOk、cmdPreTip和cmdNextTip，Caption值依次設為：“確定”，“上一個”和“下一個”（為了使程式更直觀，筆者在cmdOk按鈕上應用了一張圖片，見圖1）。、兩個複選框，名字（Caption）分別為：chkIfTips（在啟動時顯示(&S)）和chkIfRnd（隨機(&S)），再添加一個label，命名為：lblTipText，用來顯示提示作息，另外再添加一個picturebox作為背景，一個label作為標題，最終設計好的效果。
然後再添加一個模組，在其中輸入以下代碼：
Option Explicit
Public TipFileName As String '提示資訊檔
Public INIFileName As String '使用者設定檔名
'以下兩條API函數的聲明，筆者建議從VB內建的API瀏覽器中複製，要不然，如果有一個字母寫錯，程式就不能正確運行了！
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lPAPPlicationName As String, ByVal lPKeyName As Any, ByVal lPDefault As String, ByVal lPReturnedString As String, ByVal nSize As Long, ByVal lPFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib _
"kernel32" Alias "WritePrivateProfileStringA" (ByVal lPAPPlicationName As String, ByVal lPKeyName As Any, ByVal lPString As Any, ByVal lPFileName As String) As Long
Sub GetFile()
Dim AppName As String
AppName = App.Path
If Right(AppName, 1) <> "/" Then
AppName = AppName & "/"
End If
TipFileName = AppName & "TIPOFDAY.txt" '請讀者朋友事先建立一個文字檔，並和工程檔案放在同目錄下（這個檔案名稱僅供參考）
INIFileName = AppName & "TIPOFDAY.INI" '這個檔案大家不用管，系統會自動建立的
End Sub
Public Function sGetINI(INIFileName As String, sSection As String, sKey As String, sDefault As String) As String
Dim sTemP As String * 256
Dim nLength As Long
sTemP = Space$(256)
nLength = GetPrivateProfileString(sSection, sKey, sDefault, sTemP, 255, INIFileName)
sGetINI = Left$(sTemP, nLength)
End Function
Public Sub writeINI(INIFileName As String, sSection As String, sKey As String, sValue As String)
Dim n As Long
Dim sTemP As String
sTemP = sValue
'用空格替換斷行符號/換行
For n = 1 To Len(sValue)
If Mid$(sValue, n, 1) = vbCr Or Mid$(sValue, n, 1) = vbLf Then
Mid$(sValue, n) = ""
End If
Next n
n = WritePrivateProfileString(sSection, sKey, sTemP, INIFileName)
End Sub
Sub main()
Dim ifStartTips As String
Dim sNumUPPer As String, sNumOneZhu As String
Call GetFile
Load frmMain
ifStartTips = sGetINI(INIFileName, "Others", "ifStartTips ", "YES")
frmMain.Show
If ifStartTips = "YES" Then
frmTip.Show vbModal, frmMain
frmTip.chkIfTips.Value = vbChecked
End If
End Sub
再在frmTip中添加如下代碼：
Option Explicit
' 記憶體中的提示資料庫。
Dim Tips As New Collection
' 提示檔案名稱
Const Tip_FILE = "TipOFDAY.TXT"
' 當前正在顯示的提示集合的索引。
Dim CurrentTip As Long, ifNext As Boolean
Private Sub DoNextTip()
If chkIfRnd.Value = vbChecked Then
'隨機播放一條提示。
CurrentTip = Int((Tips.Count * Rnd) + 1)
Else
'或者，您可以按順序遍曆提示
CurrentTip = CurrentTip + 1
If Tips.Count < CurrentTip Then
CurrentTip = 1
End If
End If
'顯示它。
Call frmTip.DisPlayCurrentTip
End Sub
Private Sub DoPreTip()
If chkIfRnd.Value = vbChecked Then
'隨機播放一條提示。
CurrentTip = Int((Tips.Count * Rnd) + 1)
Else
'或者，您可以按順序遍曆提示
CurrentTip = CurrentTip - 1
If CurrentTip < 1 Then
CurrentTip = Tips.Count
End If
End If
'顯示它。
Call frmTip.DisPlayCurrentTip
End Sub
Function LoadTips(sFile As String) As Boolean
Dim NextTip As String ' 從檔案中讀出的每條提示。
Dim InFile As Long ' 檔案的描述符。
' 包含下一個自由檔案描述符。
InFile = FreeFile()
' 確定為指定檔案。
If sFile = "" Then
LoadTips = False
Exit Function
End If
' 在開啟前確保檔案存在。
If Dir(sFile) = "" Then
LoadTips = False
Exit Function
End If
' 從文字檔中讀取集合。
Open sFile For Input As InFile
While Not EOF(InFile)
Line Input #InFile, NextTip
Tips.Add NextTip
Wend
Close InFile
' 顯示一條提示。
DoNextTip
LoadTips = True
End Function
Private Sub chkIfRnd_Click()
Dim ifRndShow As String
' 儲存在下次啟動時是否隨機顯示提示資訊
ifRndShow = IIf(chkIfRnd.Value = vbChecked, "YES", "NO")
Call writeINI(INIFileName, "Others", "ifRndShow ", ifRndShow)
End Sub
Private Sub chkIfTips_Click()
Dim ifStartTips As String
' 儲存在下次啟動時是否顯示此表單
ifStartTips = IIf(chkIfTips.Value = 1, "YES", "NO")
Call writeINI(INIFileName, "Others", "ifStartTips ", ifStartTips)
End Sub
Private Sub cmdNextTip_Click()
ifNext = True
Call DoNextTip
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub cmdPreTip_Click()
ifNext = False
Call DoPreTip
End Sub
Private Sub Form_Load()
Dim ifStartTips As String, ifRndShow As String
' 察看在啟動時是否顯示提示資訊
ifStartTips = sGetINI(INIFileName, "Others", "ifStartTips ", "?")
If ifStartTips = "?" Then
ifStartTips = "YES"
Call writeINI(INIFileName, "Others", "ifStartTips ", ifStartTips)
End If
' 設定複選框
chkIfTips.Value = IIf(ifStartTips = "NO", vbUnchecked, vbChecked)
' 察看在顯示時是否隨機顯示
ifRndShow = sGetINI(INIFileName, "Others", "ifRndShow ", "?")
If ifRndShow = "?" Then
ifRndShow = "YES"
Call writeINI(INIFileName, "Others", "ifRndShow ", ifRndShow)
End If
' 設定複選框
chkIfRnd.Value = IIf(ifRndShow = "NO", vbUnchecked, vbChecked)
' 隨機尋找
ifNext = True
Randomize
' 讀取提示檔案並且隨機顯示一條提示。
If LoadTips(TipFileName) = False Then
lblTipText.Caption = "檔案 " & Tip_FILE & " 沒有被找到!"
End If
End Sub
Public Sub DisPlayCurrentTip()
If Tips.Count > 0 Then
If Tips.Item(CurrentTip) = "" Then
If ifNext = True Then
Call DoNextTip
Else
Call DoPreTip
End If
End If
lblTipText.Caption = Tips.Item(CurrentTip)
End If
End Sub
