在VB中使用INI文件实现每日一贴对话框

首先新建一个工程文件，添加一个模块，两个窗体。窗体分别命名为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