tsunami

log in
history

VB6: ControlPlacement.bas

Luke Breuer
2009-01-10 00:10 UTC
tags: vb6

usage
Private Sub Form_Load()

    Call InitControlPlacement

End Sub

Private Sub Form_Resize()
    
    Call ResizeControls(Me)
    
End Sub


Private Sub InitControlPlacement()
    ' this code uses ControlPlacement.bas

    Dim i As Long
    
    
    Call AddControl(txt, , atSNAP, , , atSNAP)
    Call AddControl(lst, , , , , atSNAP)
    
    For i = 0 To txtStatus.Count
        Call AddControl(txtStatus(i), , , , , atSTATIC)
    Next i
    
    For i = 0 To lblStatus.Count
        Call AddControl(lblStatus(i), , , , , atSTATIC)
    Next i
    
End Sub
library
Attribute VB_Name = "ControlPlacement"
'Don't ask for comments.  It works and is only here because we aren't using VB.NET yet.
'The comments on the user defined types are all that are needed to use this module

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
   (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Public Enum AlignType
    atNONE
    atSTATIC    'fixed distance from an edge of the form
    atSNAP      'like static, except the height/width will resize
    atPERCENT   'a fixed percentage of the screen
    atCONTROL   'fixed distance from a control
    atCENTER    'centered on the screen
End Enum

Public Type AlignInfo
    atAlign As AlignType    'see AlignType
    fData   As Single       'either the percentage, or distance value
    Control As Control      'must be set if atAlign = atCONTROL
End Type

'anything other than the listed AlignTypes will be blatantly ignored
Private Type ControlPlacement
    Left    As AlignInfo 'atPERCENT or atCONTROL or atCENTER
    Right   As AlignInfo 'atSNAP or atSTATIC
    Top     As AlignInfo 'atPERCENT or atCONTROL or atCENTER
    Bottom  As AlignInfo 'atSNAP or atSTATIC
    Width   As AlignInfo 'atPERCENT
    Height  As AlignInfo 'atPERCENT
    Control As Control
End Type
    
Private CPs() As ControlPlacement
Private uCP As Long

Public lPercentHeightIgnore As Long
Public lPercentWidthIgnore As Long

Public Sub ResizeControls(frm As Form, _
                          Optional bHorizontal As Boolean = True, _
                          Optional bVertical As Boolean = True)
                          
    Dim i As Long
    Dim cp As ControlPlacement
    
    
    On Error Resume Next
    
    For i = 0 To uCP - 1
        With CPs(i)
            If .Control.Parent Is frm Then
                If bHorizontal Then
                    If .Left.atAlign = atSNAP Then
                        .Control.Left = .Left.fData
                    ElseIf .Left.atAlign = atPERCENT Then
                        .Control.Left = (CPs(i).Control.Parent.ScaleWidth - lPercentWidthIgnore) * .Left.fData
                    ElseIf .Left.atAlign = atCONTROL Then
                        .Control.Left = .Left.Control.Left + .Left.Control.Width + .Left.fData
                    ElseIf .Left.atAlign = atCENTER Then
                        .Control.Left = (frm.ScaleWidth - .Control.Width) \ 2
                    End If
                    
                    If .Right.atAlign = atSNAP Then
                        .Control.Width = CPs(i).Control.Parent.ScaleWidth - .Control.Left - .Right.fData
                    ElseIf .Right.atAlign = atSTATIC Then
                        .Control.Left = CPs(i).Control.Parent.ScaleWidth - .Right.fData - .Control.Width
                    End If
                    
                    If .Width.atAlign = atPERCENT Then
                        .Control.Width = (CPs(i).Control.Parent.ScaleWidth - lPercentWidthIgnore) * .Width.fData
                    End If
                End If
                
                If bVertical Then
                    If .Top.atAlign = atSNAP Then
                        .Control.Top = .Top.fData
                    ElseIf .Top.atAlign = atPERCENT Then
                        .Control.Top = (CPs(i).Control.Parent.ScaleHeight - lPercentHeightIgnore) * .Top.fData
                    ElseIf .Top.atAlign = atCONTROL Then
                        .Control.Top = .Top.Control.Top + .Top.Control.Height + .Top.fData
                    ElseIf .Top.atAlign = atCENTER Then
                        .Control.Top = (frm.ScaleHeight - .Control.Height) \ 2
                    End If
                    
                    If .Bottom.atAlign = atSNAP Then
                        .Control.Height = CPs(i).Control.Parent.ScaleHeight - .Control.Top - .Bottom.fData
                    ElseIf .Bottom.atAlign = atSTATIC Then
                        .Control.Top = CPs(i).Control.Parent.ScaleHeight - .Bottom.fData - .Control.Height
                    End If
                    
                    If .Height.atAlign = atPERCENT Then
                        .Control.Height = (CPs(i).Control.Parent.ScaleHeight - lPercentHeightIgnore) * .Height.fData
                    End If
                End If
            End If
            
        End With
    Next i
End Sub

Private Sub SetControlPlacementDefaults(cp As ControlPlacement)
    With cp
        If .Left.atAlign = atSNAP Then
            .Left.fData = .Control.Left
        ElseIf .Left.atAlign = atPERCENT Then
            .Left.fData = .Control.Left / (.Control.Parent.ScaleWidth - lPercentWidthIgnore)
        ElseIf .Left.atAlign = atCONTROL Then
            .Left.fData = .Control.Left - .Left.Control.Left - .Left.Control.Width
        End If
        
        If .Width.atAlign = atPERCENT Then
            .Width.fData = .Control.Width / (.Control.Parent.ScaleWidth - lPercentWidthIgnore)
        End If

        If .Right.atAlign = atSNAP Or .Right.atAlign = atSTATIC Then
            .Right.fData = .Control.Parent.ScaleWidth - .Control.Width - .Control.Left
        End If
        
        If .Top.atAlign = atSNAP Then
            .Top.fData = .Control.Top
        ElseIf .Top.atAlign = atPERCENT Then
            .Top.fData = .Control.Top / (.Control.Parent.ScaleHeight - lPercentHeightIgnore)
        ElseIf .Top.atAlign = atCONTROL Then
            .Top.fData = .Control.Top - .Top.Control.Top - .Top.Control.Height
        End If
        
        If .Height.atAlign = atPERCENT Then
            .Height.fData = .Control.Height / (.Control.Parent.ScaleHeight - lPercentHeightIgnore)
        End If
        
        If .Bottom.atAlign = atSNAP Or .Bottom.atAlign = atSTATIC Then
            .Bottom.fData = .Control.Parent.ScaleHeight - .Control.Height - .Control.Top
        End If
    End With
End Sub

Public Function AddControl(Control As Control, _
                           Optional LeftAlignType As AlignType, _
                           Optional RightAlignType As AlignType, _
                           Optional WidthAlignType As AlignType, _
                           Optional TopAlignType As AlignType, _
                           Optional BottomAlignType As AlignType, _
                           Optional HeightAlignType As AlignType, _
                           Optional LeftControl As Control, _
                           Optional TopControl As Control) As Long
    
    On Error GoTo EH
    
    ReDim Preserve CPs(uCP)
    
    With CPs(uCP)
        Set .Control = Control
        
        .Left.atAlign = LeftAlignType
        .Right.atAlign = RightAlignType
        .Width.atAlign = WidthAlignType
        .Top.atAlign = TopAlignType
        .Bottom.atAlign = BottomAlignType
        .Height.atAlign = HeightAlignType
        Set .Left.Control = LeftControl
        Set .Top.Control = TopControl
    End With
    
    SetControlPlacementDefaults CPs(uCP)
    
    AddControl = uCP
    uCP = uCP + 1
    
    Exit Function
    
EH:
End Function

Public Sub DeleteControls(frm As Form)
    Dim i As Long
    
    
    For i = uCP - 1 To 0 Step -1
        With CPs(i)
            If .Control.Parent Is frm Then
                Set .Control = Nothing
                Set .Left.Control = Nothing
                Set .Top.Control = Nothing
            End If
            
            If i < uCP - 1 Then
                Call CopyMemory(CPs(i), CPs(i + 1), LenB(CPs(0)) * (uCP - i))
            End If
            
            uCP = uCP - 1
        End With
    Next i
    
    ReDim Preserve CPs(uCP)
    
End Sub

Public Sub ChangeHeightPercent(sControlName As String)
    Dim i As Long
    
    For i = 0 To uCP - 1
        If CPs(i).Control.Name = sControlName Then
            CPs(i).Height.fData = CPs(i).Control.Height / (CPs(i).Control.Parent.ScaleHeight - lPercentHeightIgnore)

            Exit Sub
        End If
    Next i
    
End Sub

Public Sub ChangeWidthPercent(Control As Control)
    Dim i As Long
    
    For i = 0 To uCP - 1
        If CPs(i).Control = Control Then
            CPs(i).Width.fData = CPs(i).Control.Width / (CPs(i).Control.Parent.ScaleWidth - lPercentWidthIgnore)

            Exit Sub
        End If
    Next i
    
End Sub