form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "定时消失的对话框"
   ClientHeight    =   2805
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3015
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2805
   ScaleWidth      =   3015
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox Combo1 
      Height          =   315
      ItemData        =   "Form1.frx":0000
      Left            =   300
      List            =   "Form1.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   420
      Width           =   2415
   End
   Begin VB.TextBox txtReturn 
      BackColor       =   &H8000000F&
      Height          =   315
      Left            =   300
      Locked          =   -1  'True
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   1680
      Width           =   2415
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      LargeChange     =   2
      Left            =   300
      Max             =   10
      Min             =   1
      TabIndex        =   3
      Top             =   1080
      Value           =   2
      Width           =   2355
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "设置2秒"
      Height          =   435
      Left            =   300
      TabIndex        =   6
      Top             =   2160
      Width           =   2415
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Left            =   2340
      Top             =   1920
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "对话框的类型："
      Height          =   180
      Left            =   300
      TabIndex        =   0
      Top             =   180
      Width           =   1260
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "返回值："
      Height          =   180
      Left            =   300
      TabIndex        =   4
      Top             =   1440
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "显示时间："
      Height          =   180
      Left            =   300
      TabIndex        =   2
      Top             =   840
      Width           =   900
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_CLOSE = &H10

Private Const MsgTitle As String = "照猫画虎"

Private Sub cmdTest_Click()
   Dim msg As String
   Dim nRet As Long
   With Timer1
      .Interval = HScroll1.Value * 1000
      .Enabled = True
   End With

   If Compiled Then
      msg = "将会消失在 " & HScroll1.Value & " 秒后。"
   Else
      msg = "将会消失在 " & HScroll1.Value & _
            " 秒后，" & vbCrLf & "必须编译后才能看见效果。"
   End If

   nRet = MsgBox(msg, Combo1.ItemData(Combo1.ListIndex), MsgTitle)
   Select Case nRet
      Case vbOK:       msg = "vbOK ["
      Case vbCancel:   msg = "vbCancel ["
      Case vbAbort:    msg = "vbAbort ["
      Case vbRetry:    msg = "vbRetry ["
      Case vbIgnore:   msg = "vbIgnore ["
      Case vbYes:      msg = "vbYes ["
      Case vbNo:       msg = "vbNo ["
      Case Else:       msg = "Unknown ["
   End Select
   txtReturn.Text = msg & nRet & "]"
   Timer1.Enabled = False
End Sub

Private Sub Form_Load()
   With Combo1
      .AddItem "vbAbortRetryIgnore"
      .ItemData(.NewIndex) = 2
      .AddItem "vbOKCancel"
      .ItemData(.NewIndex) = 1
      .AddItem "vbOKOnly"
      .ItemData(.NewIndex) = 0
      .AddItem "vbRetryCancel"
      .ItemData(.NewIndex) = 5
      .AddItem "vbYesNo"
      .ItemData(.NewIndex) = 4
      .AddItem "vbYesNoCancel"
      .ItemData(.NewIndex) = 3
      .ListIndex = .NewIndex
   End With
   txtReturn.Text = ""
   Set Me.Icon = Nothing
End Sub

Private Sub HScroll1_Change()
   cmdTest.Caption = "设置" & HScroll1.Value & "秒"
End Sub

Private Sub Timer1_Timer()
   Dim hWnd As Long
   hWnd = FindWindow(vbNullString, MsgTitle)
   Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub

Private Function Compiled() As Boolean
   On Error GoTo NotCompiled
   Debug.Print 1 / 0
   Compiled = True
NotCompiled:
End Function