form1.frm

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

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1 
   Caption         =   "Slider控件"
   ClientHeight    =   3540
   ClientLeft      =   1695
   ClientTop       =   2415
   ClientWidth     =   5985
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3540
   ScaleWidth      =   5985
   Begin ComctlLib.Slider sldTestSlider 
      Height          =   675
      Left            =   1200
      TabIndex        =   0
      Top             =   360
      Width           =   675
      _ExtentX        =   1191
      _ExtentY        =   1191
      _Version        =   327682
      MousePointer    =   99
      Orientation     =   1
   End
   Begin VB.Label lblValue 
      AutoSize        =   -1  'True
      Caption         =   "lblValue"
      Height          =   195
      Left            =   2640
      TabIndex        =   1
      Top             =   1440
      Width           =   555
   End
   Begin VB.Menu mnuSlider 
      Caption         =   "&Slider"
      Begin VB.Menu mnuProperties 
         Caption         =   "&Properties"
         Shortcut        =   {F4}
      End
      Begin VB.Menu mnuSeperator 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'按twips设置。
Const SLIDER_MAX_HEIGHT = 675
Const SLIDER_MIN_HEIGHT = 30

Const SLIDER_TO_FORM_RATIO_HEIGHT = (1 / 4)
Const SLIDER_TO_FORM_RATIO_WIDTH = (2 / 3)

Sub CenterLabel()
    '设置方向
    If sldTestSlider.Orientation = sldHorizontal Then
        lblValue.Caption = lblValue.Name
        lblValue.Move _
        (sldTestSlider.Width / 2) + sldTestSlider.Left - lblValue.Width, _
        sldTestSlider.Top + sldTestSlider.Height + 200, _
        lblValue.Width, lblValue.Height
        lblValue.Caption = "Selected Value: " & sldTestSlider.Value
    Else
        lblValue.Caption = lblValue.Name
        lblValue.Move _
        (sldTestSlider.Width / 2) + sldTestSlider.Left - lblValue.Width, _
        sldTestSlider.Top + sldTestSlider.Height + 100, _
        lblValue.Width, lblValue.Height
        lblValue.Caption = "Selected Value: " & sldTestSlider.Value
    End If
End Sub

Sub CenterSlider()
    Dim intNewHeight As Integer
    Dim intNewWidth As Integer
    
  If sldTestSlider.Orientation = sldHorizontal Then
    intNewHeight = SLIDER_TO_FORM_RATIO_HEIGHT * Form1.Height
    If intNewHeight < SLIDER_MIN_HEIGHT Then
        intNewHeight = SLIDER_MIN_HEIGHT
    ElseIf intNewHeight > SLIDER_MAX_HEIGHT Then
        intNewHeight = SLIDER_MAX_HEIGHT
    End If

    '设置新的高度和宽度。
    sldTestSlider.Move _
    sldTestSlider.Left, _
    sldTestSlider.Top, _
    Form1.ScaleWidth * SLIDER_TO_FORM_RATIO_WIDTH, _
    intNewHeight

    '设置新的坐标属性。
    sldTestSlider.Move _
    (Form1.ScaleWidth / 2) - (sldTestSlider.Width / 2), _
    (Form1.ScaleHeight / 2) - (sldTestSlider.Height / 2), _
    sldTestSlider.Width, _
    sldTestSlider.Height
  
  Else

    intNewWidth = SLIDER_TO_FORM_RATIO_HEIGHT * Form1.Height
    If intNewWidth < SLIDER_MIN_HEIGHT Then
        intNewWidth = SLIDER_MIN_HEIGHT
    ElseIf intNewWidth > SLIDER_MAX_HEIGHT Then
        intNewWidth = SLIDER_MAX_HEIGHT
    End If

    '设置新的高度和宽度。
    sldTestSlider.Move _
    sldTestSlider.Left, _
    sldTestSlider.Top, _
    intNewWidth, _
    Form1.ScaleHeight * SLIDER_TO_FORM_RATIO_WIDTH

    '设置新的坐标属性。
    sldTestSlider.Move _
    (Form1.ScaleWidth / 2) - (sldTestSlider.Width / 2), _
    (Form1.ScaleHeight / 2) - (sldTestSlider.Height / 2), _
    sldTestSlider.Width, _
    sldTestSlider.Height
  End If

End Sub

Private Sub Form_Activate()
    Form_Resize
End Sub

Private Sub Form_Resize()
    CenterSlider
    CenterLabel
End Sub



Private Sub Form_Unload(Cancel As Integer)
    Set Form1 = Nothing
End Sub

Private Sub mnuExit_Click()
    While Forms.Count > 0
        Unload Forms(0)
    Wend
    End
End Sub

Private Sub mnuProperties_Click()
    '调用属性窗口。
    Load Form2
    Form2.Show
End Sub

Private Sub sldTestSlider_Click()
    If sldTestSlider.SelectRange Then
        lblValue.Caption = "Selected Range from " & _
        sldTestSlider.SelStart & " to " & _
        sldTestSlider.SelStart + sldTestSlider.SelLength
        If Forms.Count > 1 Then
            Form2.lblSelStart = sldTestSlider.SelStart
            Form2.lblSelLength = sldTestSlider.SelLength
        End If
    End If
    
End Sub

Private Sub sldTestSlider_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 If Shift = 1 Then
        sldTestSlider.ClearSel
        sldTestSlider.SelStart = sldTestSlider.Value
    Else
        sldTestSlider.ClearSel
End If
End Sub

Private Sub sldTestSlider_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

    If Shift = 1 And sldTestSlider.SelectRange = True Then
        If sldTestSlider.Value >= sldTestSlider.SelStart Then
            sldTestSlider.SelLength = sldTestSlider.Value - sldTestSlider.SelStart
        End If
    End If

End Sub

Private Sub sldTestSlider_Scroll()
    If Not sldTestSlider.SelectRange Then
        lblValue.Caption = "Selected Value: " & sldTestSlider.Value
    End If
End Sub