平面按钮.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   3120
      Top             =   2400
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   3900
      Top             =   2400
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "平面按钮.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "平面按钮.frx":0452
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "平面按钮.frx":08A4
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      Height          =   435
      Left            =   960
      ScaleHeight     =   435
      ScaleWidth      =   1455
      TabIndex        =   0
      Top             =   840
      Width           =   1455
      Begin MSComctlLib.StatusBar StatusBar1 
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   120
         Width           =   855
         _ExtentX        =   1508
         _ExtentY        =   661
         _Version        =   393216
         BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
            NumPanels       =   1
            BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
               Alignment       =   1
               Bevel           =   0
               Object.Width           =   2
               MinWidth        =   2
            EndProperty
         EndProperty
      End
   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 ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As PointAPI) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Private Type PointAPI
    x As Long
    y As Long
End Type
Dim Pnt As PointAPI

Private Sub Form_Load()
    With StatusBar1
        .Panels(1).Bevel = sbrNoBevel
        .Panels(1).Text = "转换"
        .Panels(1).Alignment = sbrCenter
        .Panels(1).Picture = ImageList1.ListImages(1).Picture
        .Width = Picture1.Width
        .Height = Picture1.Height + 30
        .Top = -30
        .Left = 0
        .Panels(1).Width = .Width
    End With
End Sub

Private Sub StatusBar1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    StatusBar1.Panels(1).Picture = ImageList1.ListImages(3).Picture
    StatusBar1.Panels(1).Bevel = sbrInset
    Timer1.Enabled = False
End Sub

Private Sub StatusBar1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If StatusBar1.Panels(1).Bevel = sbrNoBevel Then
        Timer1.Enabled = True
    End If
End Sub

Private Sub StatusBar1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    StatusBar1.Panels(1).Picture = ImageList1.ListImages(2).Picture
    StatusBar1.Panels(1).Bevel = sbrRaised
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    GetCursorPos Pnt
    ScreenToClient Picture1.hwnd, Pnt
    With StatusBar1
        If Pnt.x < Picture1.ScaleLeft Or Pnt.y < Picture1.ScaleTop Or Pnt.x > Picture1.ScaleLeft + Picture1.Width / 15 Or Pnt.y > Picture1.ScaleTop + Picture1.Height / 15 Then
            .Panels(1).Picture = ImageList1.ListImages(1).Picture
            .Panels(1).Bevel = sbrNoBevel
            Timer1.Enabled = False
        Else
            .Panels(1).Picture = ImageList1.ListImages(2).Picture
            .Panels(1).Bevel = sbrRaised
        End If
    End With
End Sub