123_tip.frm

一个很漂亮的日历

VERSION 5.00
Begin VB.Form frmTip 
   BorderStyle     =   0  'None
   Caption         =   "日积月累"
   ClientHeight    =   8160
   ClientLeft      =   2310
   ClientTop       =   2055
   ClientWidth     =   9345
   Icon            =   "123_Tip.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8160
   ScaleWidth      =   9345
   ShowInTaskbar   =   0   'False
   WhatsThisButton =   -1  'True
   WhatsThisHelp   =   -1  'True
   Begin VB.CommandButton cmdNextTip 
      Caption         =   "下一条提示(&N)"
      Height          =   375
      Left            =   2745
      TabIndex        =   2
      Top             =   840
      Width           =   1455
   End
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   2775
      TabIndex        =   0
      Top             =   360
      Width           =   1455
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFFF&
      Height          =   4065
      Left            =   240
      Picture         =   "123_Tip.frx":1A7A
      ScaleHeight     =   4005
      ScaleWidth      =   4005
      TabIndex        =   1
      Top             =   240
      Width           =   4065
      Begin VB.CheckBox Op1 
         BackColor       =   &H80000009&
         Caption         =   "随机"
         Height          =   270
         Left            =   30
         TabIndex        =   6
         Top             =   3720
         Width           =   690
      End
      Begin VB.TextBox lblTipText 
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         Height          =   2805
         Left            =   990
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   5
         Text            =   "123_Tip.frx":2F6D
         Top             =   1125
         Width           =   2955
      End
      Begin VB.Label Label1 
         BackColor       =   &H00FFFFFF&
         BackStyle       =   0  'Transparent
         Caption         =   "您知道吗..."
         Height          =   240
         Left            =   1185
         TabIndex        =   3
         Top             =   150
         Width           =   1170
      End
   End
   Begin VB.PictureBox Picture3 
      AutoSize        =   -1  'True
      Height          =   4560
      Left            =   -15
      Picture         =   "123_Tip.frx":2F75
      ScaleHeight     =   4500
      ScaleWidth      =   4500
      TabIndex        =   4
      Top             =   0
      Width           =   4560
   End
End
Attribute VB_Name = "frmTip"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

' 内存中的提示数据库。
Dim Tips As New Collection

' 提示文件名称
Const TIP_FILE = "TIPOFDAY.TXT"

' 当前正在显示的提示集合的索引。
Dim CurrentTip As Long


Private Sub DoNextTip()
  If Op1.Value = 1 Then
    ' 随机选择一条提示。
    CurrentTip = Int((Tips.Count * Rnd) + 1)
  Else
    ' 或者，您可以按顺序遍历提示

    CurrentTip = CurrentTip + 1
    If Tips.Count < CurrentTip Then
        CurrentTip = 1
    End If
  End If
    ' 显示它。
    frmTip.DisplayCurrentTip
    
End Sub

Function LoadTips(sFile As String) As Boolean
    Dim NextTip As String   ' 从文件中读出的每条提示。
    Dim InFile As Integer   ' 文件的描述符。
    
    ' 包含下一个自由文件描述符。
    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 chkLoadTipsAtStartup_Click()
    ' 保存在下次启动时是否显示此窗体
    SaveSetting App.EXEName, "Options", "在启动时显示提示", 1
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, rtn
   frmTip.Height = 4530
   frmTip.Width = 4515
     rtn = SetWindowPos(frmTip.hwnd, -1, 0, 0, 0, 0, 3)
    ' 察看在启动时是否将被显示
    ShowAtStartup = GetSetting(App.EXEName, "Options", "在启动时显示提示", 1)
    If ShowAtStartup = 0 Then
        Unload Me
        Exit Sub
    End If
        
    ' 设置复选框，强行将值写回到注册表
    'Me.chkLoadTipsAtStartup.Value = vbChecked
    
    ' 随机寻找
    Randomize
    
    ' 读取提示文件并且随机显示一条提示。
    If LoadTips(App.Path & "\" & TIP_FILE) = False Then
        lblTipText.Text = "文件 " & TIP_FILE & " 没有被找到吗? " & vbCrLf & vbCrLf & _
           "创建文本文件名为 " & TIP_FILE & " 使用记事本每行写一条提示。 " & _
           "然后将它存放在应用程序所在的目录 "
    End If

  
End Sub

Private Sub Option1_Click()

End Sub

Private Sub Picture3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
           Dim ReturnVal As Long
           x = ReleaseCapture()
           ReturnVal = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub

Public Sub DisplayCurrentTip()
    If Tips.Count > 0 Then
        lblTipText.Text = Tips.Item(CurrentTip)
    End If
End Sub