Option Compare Database
Option Explicit

' Nazwa modułu klasy: classResizeV01    (wersja 01)

' Moduł klasy programu MSAccess'97 wspomagający obsługę zdarzenie 'OnResize' formularza.
' Poniższy kod można używać i modyfikować bez ograniczeń. Konstruktywne modyfikacje są
' mile widziane, oraz winny być ogłaszane na forum
' pl.comp.bazy-danych.msaccess' bądź
' via email 'midon@icslab.agh.edu.pl'

' Osoby odpowiedzialne za wszystkie błędy w poniższym module:
'   1. Dominik Marciński (midon@icslab.agh.edu.pl)

' Sposób użycia:
'
'   1. W sekcji deklaracji obsługiwanego formularza należy dodać deklarację:
'
'           Dim objResize As New classResizeV01
'
'   2. Dla zdarzenia 'OnLoad' należy zainicjować obiekt 'objResize' używając
'      metody 'Initialize' z parametrem będącym wskaźnikiem do tego formularza:
'
'          objResize.Initialize Me
'
'   3. Dla zdarzenia 'OnResize' formularza należy wywołać metodę 'Resize'
'      obiektu 'objResize':
'
'          objResize.Resize
'
'   4. Dla każdego formantu, który ma brać udział w operacji zmiany rozmiaru,
'      we właściwości 'Metka' (Tag) należy dodać dwie, lub jedną literę:
'
'          , gdzie
'           = 'M' | 'R' | 
'           = 'M' | 'R' | 
'
'      litery 'M' i 'R' oznaczają kolejno przesunięcie (Move) i zmiana rozmiaru (Resize).
'      Literę na pozycji  /  należy interpretować jako sposób reakcji
'      formantu na zmianę rozmiaru formularza, w kierunku poziomym / pionowym.
'      Litera 'M' (przesunięcie) powodować będzie ruch całego formantu w zadanym kierunku,
'      Litera 'R' (zmiana rozmiaru) powodować będzie ruch prawego dolnego rogu formantu
'      w zadanym kierunku.
'      Litera inna niż 'M' i 'R' nie wpływa na zachowanie się formantu w danym kierunku.
'
'   5. UWAGA:
'
'      Funkcja zmienia położenie (rozmiary) formantów tylko wtedy gdy rozmiar okna jest
'      większy od pierwotnych rozmiarów formularza, tzn. zmnieszanie rozmiaru okna poniżej
'      rozmiaru dla którego został zaprojektowany nie powoduje zagęszczania (zawężania)
'      się formantów

' Przykład: Właściwość Metka formantu zawiera wartość:
'
'   ''    - formant nie rusza się
'   'abc' - formant nie rusza się
'   'rr'  - formant nie rusza się
'   'M'   - formant trzyma się prawej krawędzi okna
'   'R'   - formant rozszerza się w poziomie
'   'xM'  - formant trzyma się dolnej krawędzi okna
'   'MM'  - formant trzyma się prawego dolnego rogu okna
'   'RR'  - formant zmienia rozmiar w pionie i w poziomie
'   'RRx' - jak wyżej




' Sposób działania:
'
'   1. Metoda 'Initialize' w procedurze 'Form_Load' odczytuje wymiary formularza
'      i zapisuje je w zmiennych 'lastW' i 'lastH', oraz ustawia minimalne rozmiary
'      formularza 'minW' i 'minH' równe początkowym wymiarom.
'
'   2. Jeśli rozszerzamy formularz zwiększane są rozmiary sekcji i formularza
'
'   3. Przy zmianie rozmiaru okna odczytywane są te wymiary i obliczana jest różnica
'      względem poprzednich wymiarów 'lastW' i 'lastH'. Różnica zapamiętana w zminennych
'      'diffW' i 'diffH' wykorzystana będzie do:
'           a) dodana do właściwości 'Top', 'Left' formantu w przypadku przesówania go,
'           b) dodana do właściwości 'Top', 'Left', 'Hight', 'Width' w przypadku skalowania.
'
'   4. Jeśli zwężamy formularz, to zmniejszane są rozmiary sekcji i formularza

Const classTitle = "classResize"
Const str1 = "W sekcji 'Nagłówek' lub 'Stopka' znaleziono formant skalowany w pionie. Formanty w wyżej wymienionych sekcjach mogą być jedynie skalowane poziomo."
Const str2 = "Aby używać obliektu 'classResize' należy go wcześniej zainicjalizować. Użyj metody 'objResize.Initialize  Me' w zdarzeniu 'OnLoad' formularza."

Const cm = 567		' Twipów
Dim frmRelated As Form	' Related form
Dim lastW As Integer	' last Width
Dim lastH As Integer	' last Height
Dim minW As Integer	' minimal Width
Dim minH As Integer	' minimal Height

Private Function MAX(val1 As Integer, val2 As Integer)
    MAX = IIf(val1 > val2, val1, val2)
End Function

Public Sub Initialize(initForm As Form)
    ' Funkcja ma za zadanie zdobycie wskaźnika do formularza ('initForm'), który będzie
    ' korzystał z obiektu classResize, oraz uzyskanie paru informacji o nim.

    Dim currC As Control
    Dim cTag As Variant

    Set frmRelated = initForm
    With frmRelated

        ' Pętla ma za zadanie sprawdzić czy w sekcjach 'Nagłówek' lub 'Stopka' nie ma
        ' formantów skalowanych w pionie. Podczas zmiany rozmiaru formularza na wysokość
        ' zmianie rozmiaru ulega tylko sekcja 'Szczegóły', a inne sekcje nie zmieniają
        ' swojej wysokości.
        For Each currC In .Controls
            cTag = Mid(currC.Tag, 2, 1)
            If cTag = "M" Or cTag = "R" Then
                If Not currC.Section = acDetail Then
                    MsgBox str1, vbExclamation, classTitle
                    Set frmRelated = Nothing
                    Exit Sub
                End If
            End If
        Next currC

        ' Zapamiętanie początkowych rozmiarów formularza, tzn. rozmiarów oryginalnych
        ' oraz ustawienie minimalnych rozmiarów formularza na takie same wartości.
        ' Oznacza to, że metoda 'Resize' wspomaga powiększanie formularzy, a nie ich
        ' zmniejszanie. Najlepiej więc tworzyć skalowane formularze dla najmniejszych
        ' rozdzielczości z jakimi się pracuje.
        lastW = .Width
        lastH = .Section(acDetail).Height
        On Error Resume Next
        lastH = lastH + .Section(acHeader).Height
        lastH = lastH + .Section(acFooter).Height
        minW = lastW
        minH = lastH
    End With
End Sub

Sub Resize()
    ' Ta metoda jest odpowiedzialna za zmianę rozmiaru lub przesówanie formantów
    ' na formularzu według zadanych znaczników we właściwości 'Metka' formantu.
    ' Znaczniki rozpoznawane przes metodę to 'M' - Move i 'R' - Resize.

    Static diffW As Integer     ' Width difference
    Static diffH As Integer     ' Height difference
    Static currC As Control     ' current Control
    Static cTag As Variant      ' control's Tag


    On Error GoTo Resize_Error

    With frmRelated

        ' Obliczanie zmian rozmiaru okna w stosunku do poprzednich wymiarów
        ' Różnica ta nie może jednak spowodować zmiany zbyt daleko idącej tzn. poniżej minimum
        diffW = MAX(.InsideWidth, minW) - lastW
        diffH = MAX(.InsideHeight, minH) - lastH

        If Not lastW < minW Then
            If Not diffW = 0 Then
                If diffW > 0 Then .Width = .Width + diffW   ' Jeśli powiększamy okno
                For Each currC In .Controls
                    cTag = Left(currC.Tag, 1)       ' Odczytanie pierwszej litery
                    If Not IsNull(cTag) Then
                        Select Case cTag
                            Case "M":
                                currC.Left = currC.Left + diffW
                            Case "R":
                                currC.Width = currC.Width + diffW
                        End Select
                    End If
                Next currC
                If diffW < 0 Then .Width = .Width + diffW   ' Jeśli zmniejszamy okno
            End If
        End If
        lastW = MAX(.InsideWidth, minW)

        If Not lastH < minH Then
            If Not diffH = 0 Then
                If diffH > 0 Then .Section(acDetail).Height = .Section(acDetail).Height + diffH
                For Each currC In .Controls
                    cTag = Mid(currC.Tag, 2, 1)
                    If Not IsNull(cTag) Then
                        Select Case cTag
                            Case "M":
                                currC.Top = currC.Top + diffH
                            Case "R":
                                currC.Height = currC.Height + diffH
                        End Select
                    End If
                Next currC
                If diffH < 0 Then .Section(acDetail).Height = .Section(acDetail).Height + diffH
            End If
        End If
        lastH = MAX(.InsideHeight, minH)
    End With
    Exit Sub

Resize_Error:
    If Err = 91 Then
        MsgBox str2, vbExclamation, classTitle
        Exit Sub
    Else
        Err.Raise Err
    End If

End Sub