about.frm

vb源码大全

VERSION 5.00
Begin VB.Form frmAbout 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "对话框标题"
   ClientHeight    =   1995
   ClientLeft      =   2340
   ClientTop       =   1935
   ClientWidth     =   4800
   ClipControls    =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1376.984
   ScaleMode       =   0  'User
   ScaleWidth      =   4507.448
   ShowInTaskbar   =   0   'False
   Begin VB.Timer timInterval 
      Interval        =   1000
      Left            =   4200
      Top             =   120
   End
   Begin VB.PictureBox picIcon 
      AutoSize        =   -1  'True
      ClipControls    =   0   'False
      Height          =   540
      Left            =   240
      Picture         =   "About.frx":0000
      ScaleHeight     =   337.12
      ScaleMode       =   0  'User
      ScaleWidth      =   337.12
      TabIndex        =   1
      Top             =   240
      Width           =   540
   End
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   345
      Left            =   3480
      TabIndex        =   0
      Top             =   1440
      Width           =   1140
   End
   Begin VB.Label lblTime 
      AutoSize        =   -1  'True
      Caption         =   "对话框将会在0秒钟之后自动关闭！"
      ForeColor       =   &H00000000&
      Height          =   180
      Left            =   240
      TabIndex        =   4
      Top             =   1560
      Width           =   2790
   End
   Begin VB.Label lblVersion 
      Alignment       =   1  'Right Justify
      Caption         =   "版本"
      Height          =   225
      Left            =   1050
      TabIndex        =   3
      Top             =   780
      Width           =   3045
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      BorderStyle     =   6  'Inside Solid
      Index           =   1
      X1              =   84.515
      X2              =   4282.076
      Y1              =   859.321
      Y2              =   859.321
   End
   Begin VB.Label lblDescription 
      Caption         =   "程序说明"
      ForeColor       =   &H00000000&
      Height          =   480
      Left            =   1050
      TabIndex        =   2
      Top             =   240
      Width           =   2925
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      Index           =   0
      X1              =   98.6
      X2              =   4282.076
      Y1              =   869.674
      Y2              =   869.674
   End
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

''以下四个表示窗体的四个属性
''mstrTitle用来表示对话框的标题
Private mstrTitle As String
''mstrDescription用来表示应用程序的说明，对应lblDescription的Caption属性
Private mstrDescription As String
''mstrVersion用来表示应用程序的版本信息，对应lblVersion的Caption属性
Private mstrVersion As String
''mnTimeRemain表示对话框存在的时间，以秒计时，一旦时间到，则关闭对话框
Private mnCloseTime As Integer

''还剩余多少时间才关闭对话框
Private mnTimeRemain As Integer

''取得对话框的标题
Public Property Get Title() As Variant
   Title = mstrTitle
End Property

''给对话框标题赋值
Public Property Let Title(ByVal vNewValue As Variant)
   ''若传递过来的值不为空，则将其赋给mstrTitle
   ''若为空，则将以默认的形式给mstrTitle赋值
   If CStr(vNewValue) <> "" Then
      mstrTitle = vNewValue
   Else
      mstrTitle = "关于 " & App.Title
   End If
   
   ''将mstrTitle属性赋给对话框的标题
   Me.Caption = mstrTitle
End Property

''获取对话框的说明性描述
Public Property Get Description() As Variant
   Description = mstrDescription
End Property

''该对话框的说明性描述赋值
Public Property Let Description(ByVal vNewValue As Variant)
   ''若传递过来的值不为空，则将其赋给mstrDescription
   ''若为空，则将以默认的形式给mstrDescription赋值
   If CStr(vNewValue) <> "" Then
      mstrDescription = vNewValue
   Else
      mstrDescription = App.Title
   End If
   
   ''将mstrDescription属性赋给lblDescription的Caption属性
   lblDescription.Caption = mstrDescription
End Property

''取得对话框的版本信息
Public Property Get Version() As Variant
   Version = mstrVersion
End Property

''给对话框的版本信息赋值
Public Property Let Version(ByVal vNewValue As Variant)
   ''若传递过来的值不为空，mstrVersion
   ''若为空，则将以默认的形式给mstrVersion赋值
   If CStr(vNewValue) <> "" Then
      mstrVersion = vNewValue
   Else
      mstrVersion = "版本 " & App.Major & "." & App.Minor & "." & App.Revision
   End If
   
   ''将mstrVersion属性赋给lblVersion的Caption属性
   lblVersion.Caption = mstrVersion
End Property

''获取对话框的存在时间
Public Property Get CloseTime() As Variant
   CloseTime = mnCloseTime
End Property

''给对话框的存在时间赋值
Public Property Let CloseTime(ByVal vNewValue As Variant)
   ''若传递过来的值小于等于0，则令关闭时间为1秒
   Dim i As Integer
   i = Int(Val(vNewValue))
   If i <= 0 Then
      i = 1
   End If
   
   ''将关闭时间赋值
   mnCloseTime = i
   
   ''在mnTimeRemain中记录关闭对话框所剩余的时间，初始为mnCloseTime
   mnTimeRemain = mnCloseTime
   
   ''根据关闭时间，来改变lblTime的Caption属性
   lblTime.Caption = "对话框将会在 " & mnTimeRemain & " 秒钟之后自动关闭！"
End Property

''对话框自定义的打开方法
Public Sub ShowDialog(ByVal nStyle As Integer, ByVal strTitle As String, ByVal strDescription As String, ByVal strVersion As String, ByVal nCloseTime As Integer)
   ''传递过来的值分别赋给对话框对应的属性
   Me.Title = strTitle
   Me.Description = strDescription
   Me.Version = strVersion
   Me.CloseTime = nCloseTime
   
   ''参数nStyle指出将会以何种方式显示对话框
   ''若为0，将会以无模式的方式显示；若为1，将会以模式的方式显示对话框
   ''若nStyle的值不为0或者1，这将会是模式的方式显示对话框
   Dim n As Integer
   If nStyle = 0 Or nStyle = 1 Then
      n = nStyle
   Else
      n = 1
   End If
   Me.Show n
End Sub

Private Sub cmdOK_Click()
   Unload Me
End Sub


Private Sub timInterval_Timer()
   mnTimeRemain = mnTimeRemain - 1
   
   ''若对话框存在时间>=0，则改变lblTime的Caption属性
   ''否则，关闭对话框
   If mnTimeRemain >= 0 Then
      lblTime.Caption = "对话框将会在 " & mnTimeRemain & " 秒钟之后自动关闭！"
   Else
      Unload Me
   End If
End Sub