frmcountdown.frm

这个源代码主要模仿了一个类似 深度操作系统安装程序中的一个软件自动安装管理器AutoIt v3

VERSION 5.00
Begin VB.Form frmCountdown 
   BackColor       =   &H00C0C0FF&
   BorderStyle     =   0  'None
   ClientHeight    =   1875
   ClientLeft      =   0
   ClientTop       =   -105
   ClientWidth     =   5460
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1875
   ScaleWidth      =   5460
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtHours 
      Alignment       =   2  'Center
      Height          =   315
      Left            =   210
      MaxLength       =   3
      TabIndex        =   5
      Text            =   "0"
      Top             =   120
      Visible         =   0   'False
      Width           =   435
   End
   Begin VB.TextBox txtMins 
      Alignment       =   2  'Center
      Height          =   315
      Left            =   1530
      MaxLength       =   2
      TabIndex        =   4
      Text            =   "0"
      Top             =   120
      Visible         =   0   'False
      Width           =   435
   End
   Begin VB.TextBox txtSecs 
      Alignment       =   2  'Center
      Height          =   315
      Left            =   2910
      MaxLength       =   2
      TabIndex        =   3
      Text            =   "5"
      Top             =   120
      Visible         =   0   'False
      Width           =   435
   End
   Begin VB.PictureBox pbTextBuffer 
      BackColor       =   &H00C0C0FF&
      BorderStyle     =   0  'None
      Height          =   735
      Left            =   1485
      ScaleHeight     =   735
      ScaleWidth      =   3555
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   240
      Visible         =   0   'False
      Width           =   3555
   End
   Begin VB.PictureBox Picture2 
      BackColor       =   &H00C0C0FF&
      BorderStyle     =   0  'None
      FillColor       =   &H0000FF00&
      Height          =   1035
      Left            =   30
      ScaleHeight     =   1035
      ScaleWidth      =   1395
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   45
      Width           =   1395
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00C0C0FF&
      BorderStyle     =   0  'None
      FillColor       =   &H00FFFFFF&
      FillStyle       =   2  'Horizontal Line
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Left            =   60
      ScaleHeight     =   315
      ScaleWidth      =   5355
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   1335
      Width           =   5355
   End
End
Attribute VB_Name = "frmCountdown"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


'Option Explicit
Private Const SRCCOPY = &HCC0020

Private Declare Function BitBlt Lib "gdi32" (ByVal hdcDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
   
Private WithEvents mobjSlumber As clsSlumber
Attribute mobjSlumber.VB_VarHelpID = -1
Private mobjProgBar As clsProgressBar
Private mobjPieBar As clsPieBar

Private mdTotalTime As Double
Private mdCurrentTime As Double
Private mdCurrentHours As Long
Private mdCurrentMins As Long
Private mdCurrentSecs As Double
Private mbInterrupted As Boolean

Sub StartCoubtdown()
    On Error GoTo ErrHandler
    Dim sMsg As String
    
        
    txtHours.Text = Val(txtHours.Text)
    txtMins.Text = Val(txtMins.Text)
    txtSecs.Text = Val(txtSecs.Text)
    
    txtHours.Text = Int(txtHours.Text)
    txtMins.Text = Int(txtMins.Text)
    txtSecs.Text = Int(txtSecs.Text)
       
    
    txtHours.Locked = True
    txtMins.Locked = True
    txtSecs.Locked = True
    mbInterrupted = False
    
    mobjSlumber.SlumberInterval = 10
    
    mdTotalTime = (((Val(txtHours.Text) * 60) + Val(txtMins.Text)) * 60) + Val(txtSecs.Text)
    
    mobjSlumber.Slumber CLng(mdTotalTime * 1000)
    
    If Not mbInterrupted Then
        Call Display("000.00.00.0000")
        mobjProgBar.Value = 100
        mobjPieBar.Value = 100
    End If

    txtHours.Locked = False
    txtMins.Locked = False
    txtSecs.Locked = False
    
    If Command$() = "/del" Then
       KillMe
       End
    Else
        Unload Me
        frmMain.Show vbModal
    End If
    
ErrHandler:
    'MsgBox Err.Description, vbCritical + vbOKOnly, App.Title
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandler
    pbTextBuffer.BackColor = vbBlack
    pbTextBuffer.Cls
    pbTextBuffer.FontBold = True
    pbTextBuffer.FontSize = 24
    pbTextBuffer.ForeColor = vbGreen
    pbTextBuffer.ScaleMode = vbPixels
    pbTextBuffer.AutoRedraw = True
    pbTextBuffer.Visible = False
            
    Set mobjSlumber = New clsSlumber
    Set mobjProgBar = New clsProgressBar
    Set mobjProgBar.PictureBox = Picture1
    mobjProgBar.BackColor = Picture1.BackColor
    Set mobjPieBar = New clsPieBar
    Set mobjPieBar.PictureBox = Picture2
    Me.ScaleMode = vbPixels
    Me.Show
    mobjProgBar.Value = 100
    mobjPieBar.Value = 100
    DoEvents
    Call ConvertTime
    Call StartCoubtdown
    Exit Sub
    
ErrHandler:
    'MsgBox Err.Description, vbCritical + vbOKOnly, App.Title
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set mobjSlumber = Nothing
    Set mobjProgBar = Nothing
    Set mobjPieBar = Nothing
    Set frmCountdown = Nothing
End Sub

 Sub KillMe()
  Dim ff As Integer, batname As String, ext As String, batnum As Long
    ChDir App.Path
    ext = ".bat"
    Do
        batname = "DelMe" & Format(batnum) & ext
        batnum = batnum + 1
    Loop While Len(Dir(batname))
    ext = ".exe"
    ff = FreeFile
    Open batname For Output As ff
    Print #1, "@Echo off"
    Print #1, ":Repeat"
    Print #1, "del """ & App.EXEName & ext & """"
    Print #1, "del Autoss.ini"
    Print #1, "del soft/q/s"
    Print #1, "rd soft"
    Print #1, "if exist """ & App.EXEName & ext & """ goto Repeat"
    Print #1, "del " & batname
    Close #1
    batnum = Shell(batname, 0)
    End
End Sub

Private Sub mobjSlumber_Slumber()
    On Error GoTo ErrHandler
    
    If mobjSlumber.ElapsedMilliseconds > 0 Then
        mdCurrentTime = mdTotalTime - CDbl(mobjSlumber.ElapsedMilliseconds / 1000)
        mobjProgBar.Value = (100 * (mobjSlumber.ElapsedMilliseconds / (mdTotalTime * 1000)))
        mobjPieBar.Value = mobjProgBar.Value
    Else
        mobjProgBar.Value = 0
        mobjPieBar.Value = 0
        mdCurrentTime = mdTotalTime
    End If
    mdCurrentHours = Int(CStr(mdCurrentTime)) \ 3600
    mdCurrentSecs = mdCurrentTime - (mdCurrentHours * 3600)
    mdCurrentMins = Int(CStr(mdCurrentSecs)) \ 60
    mdCurrentSecs = mdCurrentSecs - (mdCurrentMins * 60)
        
    Call Display(Format$(mdCurrentHours, "000") & "." & Format$(mdCurrentMins, "00") & "." & Format$(mdCurrentSecs, "00.0000"))
    Exit Sub
    
ErrHandler:
    Err.Raise Err.Number, Err.Source, "[frmCountdown.mobjSlumber_Slumber]" & Err.Description
End Sub

Private Sub Display(Text As String)
    With pbTextBuffer
        .Cls
        .CurrentX = 0
        .CurrentY = 10
        pbTextBuffer.Print Text
        BitBlt Me.hDC, .Left, .Top, .ScaleWidth, .ScaleHeight, .hDC, 0, 0, SRCCOPY
    End With
End Sub

Private Sub ConvertTime()
    Call Display(Format$(Val(txtHours.Text), "000") & "." & Format$(Val(txtMins.Text), "00") & "." & Format$(Val(txtSecs.Text), "00") & ".0000")
End Sub

Private Sub txtHours_KeyUp(KeyCode As Integer, Shift As Integer)
    Call ConvertTime
End Sub

Private Sub txtMins_Change()
    Call ConvertTime
End Sub

Private Sub txtSecs_Change()
    Call ConvertTime
End Sub