用ini文件实现每日一帖2.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Begin VB.Form Form2 
   Caption         =   "Form2"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CheckBox chkIfRnd 
      Caption         =   "随机(&R)"
      Height          =   240
      Left            =   2115
      TabIndex        =   5
      Top             =   2835
      Width           =   1140
   End
   Begin VB.CheckBox chkIfTips 
      Caption         =   "在启动时显示(&S)"
      Height          =   240
      Left            =   180
      TabIndex        =   4
      Top             =   2835
      Width           =   1680
   End
   Begin VB.CommandButton cmdNextTip 
      Caption         =   "下一条(&N}"
      Height          =   330
      Left            =   3465
      TabIndex        =   3
      Top             =   1485
      Width           =   1005
   End
   Begin VB.CommandButton cmdPreTip 
      Caption         =   "上一条(&P)"
      Height          =   330
      Left            =   3465
      TabIndex        =   2
      Top             =   945
      Width           =   1005
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   330
      Left            =   3465
      TabIndex        =   1
      Top             =   405
      Width           =   1005
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFFF&
      Height          =   2625
      Left            =   90
      Picture         =   "用INI文件实现每日一帖2.frx":0000
      ScaleHeight     =   2565
      ScaleWidth      =   3105
      TabIndex        =   0
      Top             =   90
      Width           =   3165
      Begin VB.Label Label2 
         BackColor       =   &H00FFFFFF&
         Caption         =   "您吃道吗 …"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   720
         TabIndex        =   7
         Top             =   135
         Width           =   1275
      End
      Begin VB.Label Label1 
         BackColor       =   &H00FFFFFF&
         Caption         =   "Label1"
         Height          =   1590
         Left            =   315
         TabIndex        =   6
         Top             =   630
         Width           =   2490
      End
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Tips As New Collection
Private Const Tip_File = "TipOfDay.txt"
Dim CurrentTip As Long, ifNext As Boolean
Dim TempNum As Long

Private Sub DoNextTip()
    If chkIfRnd.Value = vbChecked Then
        Do
            TempNum = Int(Tips.Count * Rnd + 1)
        Loop While TempNum = CurrentTip
        CurrentTip = TempNum
    Else
        CurrentTip = CurrentTip + 1
        If Tips.Count < CurrentTip Then
            CurrentTip = 1
        End If
    End If
    Call DisPlayCurrentTip
End Sub
Private Sub DoPreTip()
    If chkIfRnd.Value = vbChecked Then
        Do
            TempNum = Int(Tips.Count * Rnd + 1)
        Loop While TempNum = CurrentTip
        CurrentTip = TempNum
    Else
        CurrentTip = CurrentTip - 1
        If CurrentTip < 1 Then
            CurrentTip = Tips.Count
        End If
    End If
    Call DisPlayCurrentTip
End Sub
Private Function LoadTips(sFile As String) As Boolean
    Dim NextTip As String
    Dim lnFile As Long
    lnFile = 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 lnFile
    While Not EOF(lnFile)
        Line Input #lnFile, NextTip
        Tips.Add NextTip
    Wend
    Close lnFile
    LoadTips = True
End Function
Private Sub DisPlayCurrentTip()
    If Tips.Count > 0 Then
        Label1.Caption = Tips.Item(CurrentTip)
    End If
End Sub

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 = vbChecked, "YES", "NO")
    Call writeINI(INIfileName, "Others", "ifStartTips", ifStartTips)
End Sub

Private Sub cmdNextTip_Click()
    ifNext = True
    Call DoNextTip
End Sub

Private Sub cmdPreTip_Click()
    ifNext = False
    Call DoPreTip
End Sub

Private Sub Command1_Click()
    Unload Form2
End Sub

Private Sub Form_Load()
    Dim ifStartTips As String
    Dim 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
        Label1.Caption = "文件 " & Tip_File & " 没有发现！！！"
        cmdNextTip.Enabled = False
        cmdPreTip.Enabled = False
    Else
        DoNextTip
    End If
End Sub