scrllngfrm.ctl

几个不错的VB例子

VERSION 5.00
Begin VB.UserControl ScrllngFrm 
   Alignable       =   -1  'True
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   1815
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2655
   ControlContainer=   -1  'True
   EditAtDesignTime=   -1  'True
   PropertyPages   =   "ScrllngFrm.ctx":0000
   ScaleHeight     =   1815
   ScaleWidth      =   2655
   ToolboxBitmap   =   "ScrllngFrm.ctx":0050
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   720
      Top             =   720
   End
   Begin VB.VScrollBar VScroll 
      Height          =   1575
      Left            =   2400
      Max             =   115
      SmallChange     =   100
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   255
   End
   Begin VB.HScrollBar HScroll 
      Height          =   255
      Left            =   0
      Max             =   80
      SmallChange     =   100
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   1560
      Width           =   2415
   End
   Begin VB.PictureBox pCorner 
      BorderStyle     =   0  'None
      Height          =   255
      Left            =   2400
      ScaleHeight     =   255
      ScaleWidth      =   315
      TabIndex        =   2
      Top             =   1560
      Width           =   315
   End
   Begin VB.PictureBox pView 
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1755
      Left            =   0
      ScaleHeight     =   1755
      ScaleWidth      =   2595
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   0
      Width           =   2595
   End
End
Attribute VB_Name = "ScrllngFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
'Name: ScrllngFrm
'
'Description: This control is very useful for
' those who need more space on their forms.
' Run this example.
'
'How to use:
'
' 1. Insert a ScrllngFrm Control into your Form.
'
' 2. Insert one or more Picture Boxes into the
'    ScrllngFrm Control.
'
' 3. Set the visible property of each Picture Box
'    to False.
'
' 4. Insert other controls (Such us Command Buttons,
'    Text Boxes...) into each Picture Box.
'
'    TIP: Right-click the Picture Boxes and select
'         "Bring To Front" or "Send To Back" so
'         you can edit the controls contained by
'         each PictureBox more comfortably.
'
' 5. If you added Command Buttons to your Picture
'    Boxes (the pages) you should set their Style
'    property to Graphical.
'
' 6. On the Form_Load Event call the AddPage function.
'    Each Picture Box will correspond to a page.
'
'
'Notes:
'   The Control captures the events of the Picture Box,
'   so, if you resize the Picture Box, the control
'   adjust the scrollbars. Also, if you resize the
'   ScrllngFrm Control, it adjust its properties.
'   You can, also, have more than one PictureBox added
'   to the control. This control will manage each
'   PictureBox as if each one was a page.
'
'Acknowledgment:
'
'   Some parts of this ActiveX Control were based
'   on codes submitted by other programmers on
'   Planet-Source-Code.
'   I would like to give many thanks to:
'
'   Fred_Cpp
'   http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=31896&lngWId=1
'
'   TopCoder
'   http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=13566&lngWId=1
'
'Author:
'   Elias Barbosa
'   Date: 02/19/2002
'   Updated: 03/18/2002
'   Updated: 03/28/2002
'   e-mail: [e-mail]
'   http://www.planet-source-code.com/vb/default.asp?lngCId=32374&lngWId=1

Option Explicit

Private intChanged As Boolean
Private Gpast As Variant
Private Gcurrent As Object
Private lPrevParent As Long
Private WithEvents pChild As PictureBox
Attribute pChild.VB_VarHelpID = -1
Private currPage As Integer
Private FirstControl()
Private intSetFocus As Boolean

'Default Property Values:
Const m_def_MemorizeField = True
Const m_def_MemorizeScroll = True
Const m_def_NextEnabled = False
Const m_def_PreviousEnabled = False
Const m_def_CurrentPage = 0
Const m_def_HowManyPages = 0
Const m_def_SelectText = True
Const m_def_HighPicture = False
Const m_def_HighlightColor = &HFFC0C0
Const m_def_Highlight = True
Const m_def_BackColor = &H8000000C

'Property Variables:
'
'============================
'These properties are related
'to page navigation.
'============================
Dim m_NextEnabled As Boolean
Dim m_PreviousEnabled As Boolean
Dim m_CurrentPage As Integer
Dim m_HowManyPages As Integer

'============================
'These properties are related
'to field selection behavior.
'============================
Dim m_MemorizeField As Boolean
Dim m_MemorizeScroll As Boolean
Dim m_SelectText As Boolean
Dim m_Highlight As Boolean
Dim m_HighPicture As Boolean
Dim m_HighlightColor As OLE_COLOR

'============================
'These properties are related
'to UserControl appearance.
'============================
Dim m_BackPicture As Picture
Dim m_BackColor As OLE_COLOR

'Event Declarations:
Event Resize()
Event Scroll()
Public Event FocusMoved()
Public Event PageChanged()

'API Declarations
Private Declare Function SetParent _
    Lib "user32" ( _
    ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long) As Long

Private Sub UserControl_Initialize()
    'This Array will manage each page (PictureBox) added to the control.
    'FirstControl(1, 1) = hWnd of current page (PictureBox attached).
    'FirstControl(2, 1) = Name of the first control on TabStop Index that is contained by current page.
    'FirstControl(3, 1) = Index number of the first control on TabStop Index that is contained by current page.
    'FirstControl(4, 1) = hWnd of the first control on TabStop Index that is contained by current page.
    'FirstControl(5, 1) = Last value of the VScroll Scroll Bar on current page.
    'FirstControl(6, 1) = Last value of the HScroll Scroll Bar on current page.
    'FirstControl(7, 1) = Name of PictureBox that represent current page.
    'FirstControl(8, 1) = Index Number of PictureBox that represent current page.
    ReDim FirstControl(8, 1)
    
End Sub

'=======================================================
'======= Following are some Subs that are called =======
'======= by events associated with controls      =======
'======= contained in this UserControl or with   =======
'======= the UserControl itself.                 =======
'=======================================================

'Some of the most important tasks executed on this
'control are taken care of on the Resize Sub.
'For example:
'    * The scrolling size adjustment.
'    * The necessity or not of having a horizontal
'      or vertical scroll bar visible.
'    * The maximum and minimum values of each Scroll
'      Bar after each resize of the form...
Private Sub UserControl_Resize()
    Dim loff As Integer
    Dim loffV As Integer
    Dim loffH As Integer
    Dim sV As Single
    Dim sH As Single
    On Error Resume Next
    
    'Vertical additional space...
    loffV = 39
    'Horizontal addidional space...
    loffH = 45
    
    'The following subs will be called
    're-dimension the UserControl window
    'according to the new size of the new
    'UserControl size.
    Call VScroll.Move(UserControl.Width - VScroll.Width - loffV, 0, VScroll.Width, UserControl.Height - HScroll.Height - loffH)
    Call HScroll.Move(0, UserControl.Height - HScroll.Height - loffH, UserControl.Width - VScroll.Width - loffV, HScroll.Height)
    Call pCorner.Move(UserControl.Width - VScroll.Width - loffV, UserControl.Height - HScroll.Height - loffH, VScroll.Width, HScroll.Height)
    Call pView.Move(0, 0, Width - VScroll.Width, Height - HScroll.Height)
    
    HScroll.Min = 1
    VScroll.Min = 1
    
    sH = pChild.Width - pView.Width
    sV = pChild.Height - pView.Height
    
    'Modify Vertical ScrollBar.
    If (sV = 0) Then
        VScroll.Max = 1
        VScroll.Width = 0
        VScroll.Left = UserControl.Width
        loffV = 37
    ElseIf (sV < 0) Then
        VScroll.Max = 1 ' -sV
        VScroll.Width = 0
        VScroll.Left = UserControl.Width
        loffV = 37
    Else
        VScroll.Max = sV
        VScroll.Width = 255
    End If
    
    'Modify Horizontal Scrollbar.
    If (sH = 0) Then
        HScroll.Max = 1
        HScroll.Height = 0
        loffH = 25
    ElseIf (sH < 0) Then
        HScroll.Max = 1 '-sH
        HScroll.Visible = False
        HScroll.Height = 0
        loffH = 25
    Else
        HScroll.Max = sH
        HScroll.Visible = True
        HScroll.Height = 255
        
    End If
    
    'The following subs will be called again
    'because, depending on the new size of the
    'UserControl, one of the Scrolling Bars may
    'be hidden. On this event the UserControl
    'window will have to be re-dimensioned to
    'adjust to this new circumstance.
    Call VScroll.Move(UserControl.Width - VScroll.Width - loffV, 0, VScroll.Width, UserControl.Height - HScroll.Height - loffH)
    Call HScroll.Move(0, UserControl.Height - HScroll.Height - loffH, UserControl.Width - VScroll.Width - loffV, HScroll.Height)
    Call pCorner.Move(UserControl.Width - VScroll.Width - loffV, UserControl.Height - HScroll.Height - loffH, VScroll.Width, HScroll.Height)
    Call pView.Move(0, 0, Width - VScroll.Width, Height - HScroll.Height)
    
    VScroll.Max = pChild.Height - pView.Height
    HScroll.Max = pChild.Width - pView.Width
    
    HScroll.LargeChange = UserControl.Width
    VScroll.LargeChange = UserControl.Height
    
    RaiseEvent Resize
    
End Sub

Private Sub pChild_Resize()
    Call UserControl_Resize
    
End Sub

'Both events, the Change event and the Scroll events
'are used for the following reason:
'   Change Event: This event will be called if the
'      Scroll Bar value has changed. This event will
'      be called even if the change was made by code.
'   Scroll Event: This event will be called while the
'      user interacts with the Scroll Bar and not after
'      the user have changed the scroll bar position.
Private Sub VScroll_Change()
    UpdatePos
    FirstControl(5, currPage) = VScroll.Value
    
End Sub

Private Sub VScroll_Scroll()
    UpdatePos
    
End Sub

Private Sub HScroll_Change()
    UpdatePos
    FirstControl(6, currPage) = HScroll.Value
    
End Sub

Private Sub HScroll_Scroll()
    UpdatePos
    
End Sub

Private Sub pChild_GotFocus()
    'The pChild_GotFocus event is raised whenever the
    'user sets focus to the Picture Box that was set
    'as the current page. Because setting focus to the
    'page (Picture Box) was not a desirable behavior,
    'I decided to redirect the focus to the last
    'selected field on the current page.
    Call subSelectFirst
    
End Sub

Private Sub UserControl_EnterFocus()
    'The UserControl_EnterFocus event is raised whenever
    'the user sets focus to the User Control itself.
    'Because setting focus to the User Control was not
    'a desirable behavior, I decided to redirect the
    'focus to the last selected field on the current
    'page. However, I would get an error if I tried to
    'do this while there is no page attached to the
    'user control. That's why I used the variable
    'intSetFocus. When this variable is set to true
    'and there is no page attached, the User Control
    'will not try to set focus to any field.
    intSetFocus = True
    Call subSelectFirst
    
End Sub

'==================================
'======= Following are some  ======
'======= complementary Subs. ======
'==================================

Private Sub UpdatePos()
    'Called when Scrolls have Changed
    On Error Resume Next
    pChild.Move -HScroll.Value, -VScroll.Value
    RaiseEvent Scroll
    
End Sub

Public Function hwnd()
    hwnd = UserControl.hwnd
    
End Function

Public Sub AddPage(NewPictureBox)
    Dim intPage As Integer
    Dim intTempIndex As String
    Dim i As Integer
    
    If (Len(FirstControl(1, 0)) > 0) Then
        
        For i = 0 To m_HowManyPages - 1
            If (Len(FirstControl(1, i)) = 0) _