Vpanelscroll : un 'conteneur' avec un ascenseur lorsque votre feuille est trop petite

Télécharger le projet
Commenter

Description

Votre « Form » est trop petite ?

Ce contrôle (Lience GNU) est pour vous. Petit, simple, pas d'API ni de DLL, il combine simplement un Conteneur et une VScroll.

Préciser la taille de votre feuille virtuelle, il rajoute un ascenseur. En Mode développement, clique droit pour appeler le menu contextuel, puis « Modifier ». Vous pouvez alors vous déplacer l'ascenseur pour vous déplacer dans votre feuille virtuelle...

A+ Patrick

site : http:\\jeux.cartes.free.fr
email: jeux.cartes@free.fr

Source / Exemple : 


VERSION 5.00
Begin VB.UserControl VPanelScroll 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   6735
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5070
   ControlContainer=   -1  'True
   EditAtDesignTime=   -1  'True
   ScaleHeight     =   6735
   ScaleWidth      =   5070
   ToolboxBitmap   =   "VPanelScroll.ctx":0000
   Begin VB.VScrollBar VScroll 
      Height          =   6735
      LargeChange     =   10
      Left            =   4680
      Max             =   0
      TabIndex        =   0
      Top             =   0
      Width           =   375
   End
End
Attribute VB_Name = "VPanelScroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'________________________________________________________________________________________________
'
' (C)2005 By Patrick
'
' Rq: en mode Dev, faire "Menu Contextuel/Modifier" pour déplace la ScrollBar
'________________________________________________________________________________________________

Option Explicit

Private iVirualHeight As Double     ' Taille de la fenêtre virtuel
Private iScaleChange As Integer     ' Taille d'un "pas". Par defaut, un pixels
Private iValue As Integer           ' Ancienne valeur de VScroll
Private iHideScrollBar As Boolean   ' True : Cache la barre si pas besoin

Public Enum EnumBorderStyle
  vbBSNone
  vbFixedSingle
End Enum

'=================================================================================================
' Property
'=================================================================================================

'---------------------- BorderStyle

Public Property Let BorderStyle(Value As EnumBorderStyle)
  UserControl.BorderStyle = Value
  PropertyChanged ("BorderStyle")
End Property

Public Property Get BorderStyle() As EnumBorderStyle
  BorderStyle = UserControl.BorderStyle
End Property

'---------------------- VirualHeight

Public Property Let VirualHeight(Value As Double)
  iVirualHeight = Value
  PropertyChanged ("VirualHeight")
  Call UserControl_Resize
End Property

Public Property Get VirualHeight() As Double
 Dim MyCtrl As Control
 Dim wkHeight As Double
   For Each MyCtrl In UserControl.ContainedControls
     On Error Resume Next
       wkHeight = Maxi(wkHeight, MyCtrl.Top + MyCtrl.Height)
       wkHeight = Maxi(wkHeight, MyCtrl.X1)
       wkHeight = Maxi(wkHeight, MyCtrl.X2)
     On Error GoTo 0
   Next
   VirualHeight = Maxi(Maxi(UserControl.ScaleHeight, iVirualHeight), wkHeight)
End Property

'---------------------- Enabled

Public Property Let Enabled(Value As Boolean)
  UserControl.Enabled = Value
  PropertyChanged ("Enabled")
End Property

Public Property Get Enabled() As Boolean
  Enabled = UserControl.Enabled
End Property

'---------------------- Value

Public Property Let VScrollValue(Value As Integer)
  UserControl.VScroll.Value = Value
  PropertyChanged ("VScrollValue")
End Property

Public Property Get VScrollValue() As Integer
  VScrollValue = UserControl.VScroll.Value
End Property

'---------------------- ScaleChange

Public Property Let ScaleChange(Value As Integer)
  iScaleChange = IIf(Value > 0, Value, 1)
  PropertyChanged ("ScaleChange")
  iValue = iValue / iScaleChange
  UserControl.VScroll.Value = UserControl.VScroll.Value / iScaleChange
  UserControl_Resize
End Property

Public Property Get ScaleChange() As Integer
  ScaleChange = iScaleChange
End Property

'---------------------- ScaleChange

Public Property Let HideScrollBar(Value As Boolean)
  iHideScrollBar = Value
  PropertyChanged ("HideScrollBar")
  UserControl_Resize
End Property

Public Property Get HideScrollBar() As Boolean
  HideScrollBar = iHideScrollBar
End Property

'---------------------- A Propos de

Public Sub AProposDe()
  MsgBox "VPanelScroll" & vbCrLf & vbCrLf & "(C)2005 By Patrick" & vbTab & " Licence GNU" & vbCrLf & vbCrLf & "Rq: Faire faire 'Menu Contextuel/Modifier' pour déplace la ScrollBar"
End Sub

'=================================================================================================
' Interne
'=================================================================================================

Private Sub UserControl_Initialize()
  iScaleChange = 1
End Sub

Private Sub UserControl_Show()
  Call UserControl_Resize
End Sub

Private Sub UserControl_Resize()
   UserControl.VScroll.Height = UserControl.ScaleHeight
   UserControl.VScroll.Left = UserControl.ScaleWidth - UserControl.VScroll.Width
   UserControl.VScroll.Max = Mini(32767, UserControl.ScaleY(Me.VirualHeight - UserControl.ScaleHeight, UserControl.ScaleMode, vbPixels) / iScaleChange)
   UserControl.VScroll.Enabled = (UserControl.VScroll.Max > 0)
   UserControl.VScroll.Visible = (UserControl.VScroll.Enabled Or iHideScrollBar = False)
End Sub

Private Sub VScroll_Change()
   Dim Ctrl As Control
   Dim Offset As Double
   Offset = UserControl.ScaleY(iValue - UserControl.VScroll.Value, vbPixels, UserControl.ScaleMode) * iScaleChange
   For Each Ctrl In UserControl.ContainedControls
     On Error Resume Next
       Ctrl.Top = Ctrl.Top + Offset
       Ctrl.X1 = Ctrl.X1 + Offset
       Ctrl.X2 = Ctrl.X2 + Offset
     On Error GoTo 0
   Next
   iValue = UserControl.VScroll.Value
End Sub

'---------------------------- Chargement Valeur depuis Source ----------------------------

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  On Error Resume Next
   Me.Enabled = PropBag.ReadProperty("Enabled", True)
   Me.BorderStyle = PropBag.ReadProperty("BorderStyle", vbFixedSingle)
   Me.VirualHeight = PropBag.ReadProperty("VirualHeight", iVirualHeight)
   Me.VScrollValue = PropBag.ReadProperty("VScrollValue", UserControl.VScroll.Min)
   Me.ScaleChange = PropBag.ReadProperty("ScaleChange", 1)
   Me.HideScrollBar = PropBag.ReadProperty("HideScrollBar", False)
  On Error GoTo 0
  iValue = UserControl.VScroll.Value
End Sub
'---------------------------- Sauvegarde Valeur dans le Source ---------------------------

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  On Error Resume Next
   PropBag.WriteProperty "Enabled", Me.Enabled
   PropBag.WriteProperty "BorderStyle", Me.BorderStyle
   PropBag.WriteProperty "VirualHeight", iVirualHeight
   PropBag.WriteProperty "VScrollValue", VScrollValue
   PropBag.WriteProperty "ScaleChange", iScaleChange
   PropBag.WriteProperty "HideScrollBar", iHideScrollBar
  On Error GoTo 0
End Sub

'-------------------------------------- Maxi / Mini --------------------------------------

Private Function Maxi(val1, val2)
  Maxi = IIf(val1 > val2, val1, val2)
End Function

Private Function Mini(val1, val2)
  Mini = IIf(val1 < val2, val1, val2)
End Function
Télécharger le projet

Codes Sources

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_patrick)