_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

Option Explicit
    Private mCol As Collection
 
 
' -----------------------------------------------------------------
' Erstellt das Collection Objekt beim erstem Zugriff auf die Klasse
' -----------------------------------------------------------------
 
Private Sub Class_Initialize()
  Set mCol = New Collection
End Sub
 
' -----------------------------------------------------------------
' Zerstört das Collection Objekt wenn die Klasse beendet wird
' -----------------------------------------------------------------
 
Private Sub Class_Terminate()
  Set mCol = Nothing
End Sub
 
' -----------------------------------------------------------------
' Objekt der Collection zurückgeben
' -----------------------------------------------------------------
 
Public Property Get Item(ByVal Index As Long) As clsControl
  Set Item = mCol(Index)
End Property
 
' -----------------------------------------------------------------
' Anzahl der Objekte durchreichen
' -----------------------------------------------------------------
 
Public Property Get Count() As Long
  Count = mCol.Count
End Property
 
' -----------------------------------------------------------------
' Anzahl der Objekte durchreichen
' -----------------------------------------------------------------
 
Public Function Add(ByVal lTop As Long, _
  ByVal lLeft As Long, _
  ByVal lWidth As Long, _
  ByVal lHeight As Long, _
  ByVal sName As String, _
  ByVal iFontSize As Single) As clsControl
 
  On Local Error GoTo 0
  ' -------------------------------- Eigenschaften zuweisen
  Dim objNewMember As clsControl
  Set objNewMember = New clsControl
  With objNewMember
    .top = lTop
    .left = lLeft
    .Height = lHeight
    .Width = lWidth
    .Tag = mCol.Count + 1
    .name = sName
    .FontSize = iFontSize
  End With
 
  ' -------------------------------- Objekt der Collection zuweisen
  mCol.Add objNewMember, sName
  ' -------------------------------- Objekt zurückgeben
  Set Add = objNewMember
  ' -------------------------------- neues Objekt zerstören
  Set objNewMember = Nothing
End Function
 
Public Function AddLine(ByVal lX1 As Long, _
  ByVal lX2 As Long, _
  ByVal lY1 As Long, _
  ByVal lY2 As Long, _
  sName As String) As clsControl
 
  On Local Error GoTo 0
  Dim objNewMember As clsControl
  Set objNewMember = New clsControl
 
  ' Eigenschaften zuweisen
  With objNewMember
    .x1 = lX1
    .x2 = lX2
    .Y1 = lY1
    .Y2 = lY2
    .ResizeOption = 0
    .Tag = mCol.Count + 1
    .name = sName
  End With
 
  ' -------------------------------- Objekt der Collection zuweisen
  mCol.Add objNewMember, sName
  ' -------------------------------- Objekt zurückgeben
  Set AddLine = objNewMember
  ' -------------------------------- neues Objekt zerstören
  Set objNewMember = Nothing
End Function

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

' -----------------------------------------------------------------
' Anzahl der Objekte durchreichen
' -----------------------------------------------------------------
 
Public Function Add(ByVal lTop As Long, _
  ByVal lLeft As Long, _
  ByVal lWidth As Long, _
  ByVal lHeight As Long, _
  ByVal sName As String, _
  ByVal iFontSize As Single) As clsControl
 
  On Local Error GoTo 0
  ' -------------------------------- Eigenschaften zuweisen
  Dim objNewMember As clsControl
  Set objNewMember = New clsControl
  With objNewMember
    .Top = lTop
    .Left = lLeft
    .Height = lHeight
    .Width = lWidth
    .Tag = mCol.Count + 1
    .name = sName
    .FontSize = iFontSize
  End With
 
  ' -------------------------------- Objekt der Collection zuweisen
  mCol.Add objNewMember, sName
  ' -------------------------------- Objekt zurückgeben
  Set Add = objNewMember
  ' -------------------------------- neues Objekt zerstören
  Set objNewMember = Nothing
End Function

'Zuweisen & Abrufen mvar_Name
Public Property Let Name(ByVal vData As String)
  mvar_Name = vData
End Property
 
Public Property Get Name() As String
  Name = mvar_Name
End Property

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

Option Explicit
Dim oResize         As clsResize
 
...
 
Private Sub Form_Load()
    DisableCloseWindowButton Me
 
    Set oResize = New clsResize
    oResize.oForm = Me
    oResize.Initialize
 
 
    Me.KeyPreview = True
    sevUser = ""
    sevKennwort = ""
    AnmeldeStatus = "Exit"
    CryptZähler = 0
    CheckPasswort = "Nein"
 
    aRs_Close
    sSQL = "SELECT * FROM tblsystem"
    aRs.CursorLocation = adUseClient
    aRs.Open sSQL, oConn, adOpenForwardOnly, adLockOptimistic
    aRsOpen = True
    If aRs.RecordCount > 0 Then
       CheckPasswort = aRs!SysPassword
    End If
    If CheckPasswort <> "Ja" Then
       sevLabel1.Visible = False
       sevKennwort.Visible = False
    End If
End Sub
 
Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized Then
       oResize.DoResize
    End If
End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

Public Sub Initialize()
  'Initialisieren
 
  Dim oControl As Control
  Dim sControlName As String
  Dim iFontSize As Single
  Dim lTag As Long
 
  Dim mcol_SSTAB  As Collection
  Set mcol_SSTAB = New Collection
  ...
  'Alle Controls durchlaufen und Eigenschaften speichern
  For Each oControl In oForm_Now.Controls
    On Error Resume Next
    If oControl.left < 0 Then
       mcol_SSTAB.Add oControl                  ' Merken
       oControl.left = oControl.left + 750000   ' verschieben
    End If
    With oControl
 
 
Public Sub DoResize()
  'Etwaige Fehler wie bei Timern usw. übergehen
  On Error Resume Next
 
  Dim oControl As Control
  Dim sngFaktor_Height As Single
  Dim sngFaktor_Width As Single
  Dim sngFaktor_FontSize As Single
  Dim sControlName As String
 
  Dim mcol_SSTAB As Collection
  Set mcol_SSTAB = New Collection
  ...
  'Alle Controls durchlaufen und der Größe nach anpassen
  For Each oControl In oForm_Now.Controls
      If oControl.left < 0 Then
         mcol_SSTAB.Add oControl
      End If
      sControlName = oControl.name
      sControlName = sControlName & CStr(oControl.Index)
      ...
  Else
    DoResize_First False
  End If
  For Each oControl In mcol_SSTAB
      oControl.left = oControl.left - 75000
  Next
 
 
'Ursprungszustand wieder herstellen
Public Sub DoResize_First(ByVal bWithForm As Boolean)
  'Etwaige Fehler wie bei Timern usw. übergehen
  On Error Resume Next
 
  Dim mcol_SSTAB As Collection
  Set mcol_SSTAB = New Collection
 
  Dim oControl As Control
  ....
  'Alle Controls durchlaufen und der Größe nach anpassen
  For Each oControl In oForm_Now.Controls
 
      If oControl.left < 0 Then
         mcol_SSTAB.Add oControl
      End If
 
      sControlName = oControl.name
      sControlName = sControlName & CStr(oControl.Index)
  ....
  Next
 
  For Each oControl In mcol_SSTAB
      oControl.left = oControl.left - 75000
  Next
 
  'zu guter Letzt Größe der Form wieder herstellen
  If bWithForm Then
   oForm_Now.Height = oForm_First.Height
   oForm_Now.Width = oForm_First.Width
  End If
End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de