安装和调节进度条.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2190
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6870
   LinkTopic       =   "Form1"
   ScaleHeight     =   146
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   458
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   495
      Top             =   900
   End
   Begin VB.CommandButton Command1 
      Height          =   465
      Left            =   3150
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   1395
      Width           =   150
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   90
      Top             =   900
   End
   Begin VB.CommandButton Command2 
      Caption         =   "演示"
      Height          =   285
      Left            =   4815
      TabIndex        =   2
      Top             =   855
      Width           =   870
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   360
      Index           =   0
      Left            =   428
      ScaleHeight     =   20
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   397
      TabIndex        =   0
      Top             =   270
      Width           =   6015
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   2745
         TabIndex        =   3
         Top             =   45
         Width           =   645
      End
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   240
      Index           =   1
      Left            =   405
      ScaleHeight     =   12
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   397
      TabIndex        =   1
      Top             =   1485
      Width           =   6015
   End
   Begin VB.Image Image1 
      Height          =   300
      Left            =   6030
      Picture         =   "安装和调节进度条.frx":0000
      Top             =   1845
      Visible         =   0   'False
      Width           =   5955
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointApi) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As PointApi) As Long
Private Const MaxValue = 100
Private Const MinValue = 0
Private Type PointApi
    X As Long
    Y As Long
End Type
Dim pos As PointApi
Dim Gene As Single
Dim ProValue(1) As Single
Private Sub InitData()
    Gene = Picture1(0).ScaleWidth / (MaxValue - MinValue)
     ProValue(1) = Int((Command1.Left + Command1.Width / 2 - Picture1(1).Left - 2) / Gene + MinValue + 1)
     SetProBar ProValue(1), 1
End Sub
Private Sub SetProBar(value As Single, Index As Integer)
    Dim X As Single
    Dim BkColor As Long
    ProValue(Index) = value
    If ProValue(Index) > MaxValue Then
        ProValue(Index) = MaxValue
    Else
        If ProValue(Index) < MinValue Then
            ProValue(Index) = MinValue
        End If
    End If
    Select Case Index
        Case 0
            Label1.Caption = Trim(Str(ProValue(Index))) & "%"
    End Select
    X = (ProValue(Index) - MinValue) * Gene
    Picture1(Index).Picture = Image1.Picture
    Select Case Index
        Case 0
            BkColor = vbWhite
        Case 1
            BkColor = vbMenuBar
    End Select
    Picture1(Index).Line (X, 0)-(Picture1(Index).ScaleWidth, Picture1(Index).ScaleHeight), BkColor, BF
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer2.Enabled = True
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Timer2.Enabled = False
End Sub

Private Sub Command2_Click()
    Timer1.Enabled = True
End Sub

Private Sub Form_Load()
    InitData
End Sub

Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim TempValue As Integer
    Dim i As Integer
    If Button = vbLeftButton And Index = 1 Then
        TempValue = ProValue(Index)
        ProValue(Index) = Int(X / Gene + MinValue + 1)
        i = ProValue(Index) - TempValue
        If Abs(i) > (MaxValue - MinValue) * 0.2 Then
            ProValue(Index) = TempValue + (Sgn(i) * (MaxValue - MinValue) * 0.2)
        End If
        Command1.Move ProValue(Index) * Gene + 2 + Picture1(1).Left
        If Command1.Left > Picture1(1).Left + Picture1(1).Width - Command1.Width Then
            Command1.Left = Picture1(1).Left + Picture1(1).Width - Command1.Width
        End If
        SetProBar ProValue(Index), Index
    End If
End Sub

Private Sub Timer1_Timer()
    Static curval As Single
    SetProBar curval, 0
    curval = curval + 1
    If curval = MaxValue + 1 Then
        Timer1.Enabled = False
    End If
End Sub

Private Sub Timer2_Timer()
    Static oldX As Long
    GetCursorPos pos
    ScreenToClient Form1.hwnd, pos
    If pos.X <> oldX And pos.X >= Picture1(1).Left And pos.X <= Picture1(1).Left + Picture1(1).Width - Command1.Width Then
        Command1.Move pos.X
        oldX = pos.X
        ProValue(1) = Int((pos.X + Command1.Width / 2 - Picture1(1).Left - 2) / Gene + MinValue + 1)
        SetProBar ProValue(1), 1
    End If
End Sub