VB 5/6-Tipp 0529: Scrollen vieler Textboxen mithilfe eines Frames

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'--- Anfang Projektdatei 240Textboxenueberframescrollen.vbp ---
'--- Anfang Formular "Form1" alias 240Textboxenueberframescrollen.frm ---
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Vertikale Scrollbar "VScroll1"
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Textfeld "Text1" (Index von 0 bis 0) auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 0) auf Frame1

'
'Autor: © "SAP*"  peter.k.sauer@web.de   02.2000
'
'Scrollen eines Frames mit einer Vielzahl von Textboxen + Label
'als Container wird eine Picturebox verwendet

Option Explicit

Private TextBoxAnzahl As Long
Private TextBoxAnzahlQuer As Long
Private TextBoxHeight As Single
Private TextBoxWidth As Single
Private TextBoxLeft As Single
Private LabelWidth As Single
Private LabelLeft As Single
Private TextBoxAbstandHoehe As Long
Private TextBoxAbstandBreite As Long
Private TextBoxContainerTop As Long
Private TextBoxContainerBottom As Long
Private TextBoxContainerLeft As Long
Private TextBoxFrameTotalHeight  As Single
 
Private Sub Form_Load()
 
   Dim i As Long
      
      Me.Width = 800 * Screen.TwipsPerPixelX             'Form setzen
      Me.Height = 570 * Screen.TwipsPerPixelY
      
      If Screen.Width > Me.Width Then
         Me.Top = (Screen.Height - Me.Height) / 2
         Me.Left = (Screen.Width - Me.Width) / 2
      Else
         Me.Top = 0
         Me.Left = 0
      End If
      
      TextBoxAnzahl = 240                                'Anzahl der Textboxen gesamt
      TextBoxAnzahlQuer = 3                              'Anzahl in der Breite
      
      LabelWidth = 450                                   'Breite eines Labels
      LabelLeft = 30                                     'Abstand Links
      
      TextBoxHeight = 315                                'Höhe einer Textbox
      TextBoxWidth = 2100                                'Breite
      TextBoxLeft = 600                                  'Abstand links Textbox(0)
      TextBoxAbstandHoehe = TextBoxHeight + 150          'Abstand vertikal zwischen Boxen
      TextBoxAbstandBreite = TextBoxWidth + 900          'Abstand horizontal
      TextBoxContainerTop = 600                          'Position Top für Picturebox
      TextBoxContainerBottom = 1600                      'Abstand Bottom Picturebox zur Form
      TextBoxContainerLeft = 600                         'Position Picturebox links
     
      'Controls einrichten
      Label1(0).Alignment = vbRightJustify               'Ausrichtung Label
      doIniTextBox Text1(0)                              'Ini Textbox(0)
      doIniLabel Label1(0)                               'Ini Label(0)
      doIniVScroll VScroll1, Picture1                    'Ini VScrollBar
      TextBoxFrameTotalHeight = FrameTotalHeight         'benötigte Höhe berechnen
      doIniPictureContainer Picture1                     'Ini Picturebox
      doIniFrameContainer Frame1, Picture1, VScroll1     'Ini Frame
      doIniTextBoxen Text1                               'Ini Textboxen
      doIniLabels Label1                                 'Ini Labels
      
      For i = 0 To TextBoxAnzahl - 1                     'Boxen für Demo füllen
         Text1(i).Text = "Feld " & i
      Next
      
      For i = 0 To TextBoxAnzahl - 1                     'Label für Demo beschriften
         Label1(i).Caption = Format(i, "000")
      Next
      
      For i = 0 To Text1.Count - 1                       'TabIndex einstellen
         Text1(i).TabIndex = i
      Next
      
      Picture1.TabStop = False
      VScroll1.TabStop = False
End Sub
 
Private Sub Form_Resize()
 
      Dim h As Single
   
      If Me.WindowState = vbMinimized Then
         Exit Sub
      End If
   
      'Controls anpassen
      doResizeControls Picture1, Frame1, VScroll1
End Sub
 
Private Sub Text1_GotFocus(Index As Integer)
 
      'Textbox ggf. sichtbar machen
      doScroll Text1(Index), Picture1, Frame1, VScroll1
 
      'für Demo aktive Box einfärben
      Text1(Index).BackColor = vbYellow
End Sub
 
Private Sub Text1_LostFocus(Index As Integer)
 
      Text1(Index).BackColor = vbWhite
End Sub
 
Private Sub VScroll1_Change()
 
      Form_Resize
End Sub
 
Private Sub doIniTextBox(TBox As TextBox)
' Textbox(0) initialisieren
    With TBox
         Set .Container = Frame1
         .Width = TextBoxWidth
         .Height = TextBoxHeight
         .Top = TextBoxAbstandHoehe - TextBoxHeight
         .Left = TextBoxLeft
      End With
End Sub
 
Private Sub doIniLabel(Lab As Label)
' Textbox(0) initialisieren
    With Lab
         Set .Container = Frame1
         .Width = LabelWidth
         .Height = TextBoxHeight - 60
         .Top = TextBoxAbstandHoehe - TextBoxHeight + 60
         .Left = LabelLeft
      End With
End Sub
 
 
Private Sub doIniVScroll(VScroll As VScrollBar, PictureContainer As PictureBox)
' VScroll intialisieren
    With VScroll
         Set .Container = PictureContainer
         .Width = 255
         .Top = 0
         .Min = 0
         .Max = TextBoxAnzahl \ TextBoxAnzahlQuer - 1
         .LargeChange = 50
         .SmallChange = 20
      End With
End Sub
 
Private Function FrameTotalHeight() As Long
' benötigte Höhe für Frame berechnen
    FrameTotalHeight = (TextBoxAbstandHoehe - TextBoxHeight) * 2 + _
                          TextBoxAbstandHoehe * TextBoxAnzahl / TextBoxAnzahlQuer
 
End Function
 
Private Sub doIniPictureContainer(PictureContainer As PictureBox)
' Ini Picturebox als Container für Frame
    With PictureContainer
         .BorderStyle = 1
         .Width = TextBoxAbstandBreite * TextBoxAnzahlQuer + _
                  VScroll1.Width - TextBoxLeft + 600
         .Top = TextBoxContainerTop
         .Left = TextBoxContainerLeft
      End With
End Sub
 
Private Sub doIniFrameContainer(FrameContainer As Frame, _
                                PictureContainer As PictureBox, _
                                VScroll As VScrollBar)
' Ini Frame als Container für Textboxen
    With FrameContainer
         .BorderStyle = 0
         .Caption = ""
         Set .Container = PictureContainer
         .Height = Me.ScaleHeight
         .Width = PictureContainer.ScaleWidth - VScroll.Width - 90
         .Top = 0
         .Left = 0
      End With
End Sub
 
Private Sub doIniTextBoxen(TBox As Object)
' Initialisieren Textboxen und anordnen auf Frame
   Dim i As Long
   Dim j As Long
   Dim k As Long
   
      For i = 0 To TextBoxAnzahl - 1 Step TextBoxAnzahlQuer
         For j = 0 To TextBoxAnzahlQuer - 1
            If i + j > 0 Then
               Load TBox(i + j)
               With TBox(i + j)
                  .Visible = True
                  k = Abs(i + j) \ TextBoxAnzahlQuer
                  .Top = TBox(0).Top + k * TextBoxAbstandHoehe
                  If j > 0 Then
                     .Left = .Left + (TextBoxAbstandBreite) * j
                  End If
               End With
            End If
         Next
      Next
End Sub
 
Private Sub doIniLabels(Lab As Object)
' Initialisieren Labels und anordnen auf Frame
   Dim i As Long
   Dim j As Long
   Dim k As Long
   
      For i = 0 To TextBoxAnzahl - 1 Step TextBoxAnzahlQuer
         For j = 0 To TextBoxAnzahlQuer - 1
            If i + j > 0 Then
               Load Lab(i + j)
               With Lab(i + j)
                  .Visible = True
                  k = Abs(i + j) \ TextBoxAnzahlQuer
                  .Top = Lab(0).Top + k * TextBoxAbstandHoehe
                  If j > 0 Then
                     .Left = .Left + (TextBoxAbstandBreite) * j
                  End If
               End With
            End If
         Next
      Next
End Sub
 
Private Sub doResizeControls(PictureContainer As PictureBox, _
                             FrameContainer As Frame, VScroll As VScrollBar)
   Dim h As Single
                           
                         
      With PictureContainer                        'Picturebox anpassen
         .Height = Me.ScaleHeight - .Top - TextBoxContainerBottom
      End With
      
      With FrameContainer                          'Frame anpassen
         If TextBoxAbstandHoehe > 0 Then
            .Height = ((Me.ScaleHeight - PictureContainer.Top - TextBoxContainerBottom) _
            \ TextBoxAbstandHoehe) * TextBoxAbstandHoehe
         End If
      End With
      
      With VScroll                                 'VScrollbar anpassen
         .Height = PictureContainer.ScaleHeight
         .Left = PictureContainer.ScaleWidth - .Width
         h = (TextBoxFrameTotalHeight - FrameContainer.Height) * .Value / .Max
         If h > 0 Then
            h = (h \ TextBoxAbstandHoehe) * TextBoxAbstandHoehe
         End If
         FrameContainer.Top = h * -1               'Frame verschieben
         If h > 0 Then
            FrameContainer.Height = FrameContainer.Height + h
         End If
      End With
 
End Sub
 
 
Public Sub doScroll(TBox As TextBox, PictureContainer As PictureBox, _
                    FrameContainer As Frame, VScroll As VScrollBar)
'Frame automatisch scrollen um Textbox sichtbar zu machen
   Dim i As Long
   
      If TBox.Top + TBox.Height + FrameContainer.Top > PictureContainer.Height Then
         Do
            i = VScroll.Value + 1
            If i > VScroll.Max Then
               i = VScroll.Max
            End If
            VScroll1.Value = i
            If TBox.Top + TBox.Height + FrameContainer.Top <= PictureContainer.Height Then
               Exit Do
            End If
         Loop
      ElseIf TBox.Top + FrameContainer.Top < 0 Then
         If VScroll.Value = VScroll.Max Then
            i = 0
         Else
            i = VScroll.Value - 1
         End If
         If i < VScroll.Min Then
            i = VScroll.Min
         End If
         VScroll.Value = i
      End If
      
End Sub

Private Sub VScroll1_Scroll()
    
    Form_Resize
End Sub
'--- Ende Formular "Form1" alias 240Textboxenueberframescrollen.frm ---
'--- Ende Projektdatei 240Textboxenueberframescrollen.vbp ---