VBA, MS Access MS Access в примерах

Элементы формы - Распределение контролей формы по горизонтали с равными расстояниями между ними

Public Sub EqvGorizontal(frm As Form, ctrl As Control, iTotControls%, iControlNo%, _
                        Optional iMinFormWidthCm As Currency = 0)
'es - 25.06.2019: v005  LE: 26.06.2019
'Распределение контролей формы по горизонтали с равными расстояниями между ними, _
    при изменении размеров формы.
'----------------------------------------------------------------
'Внимание!
'   - Очень желательно, что бы ширина контролей была одинаковой (для "красоты").
'   - Свойство Элемента(ов) Horizontal Anchor должно быть устоновлено = Left _
      иначе результат будет не предсказуемым.
'----------------------------------------------------------------
'Аргументы:
'   frm              = Ссылка на Форму - которая изменила размеры
'   ctrl             = Ссылка на Перемещаемый контрол (один из нескольких)
'   iTotControls     = Сколько всего контролей (для обработки)
'   iControlNo       = Номер контрола по счёту (первый = самый левый)
'   iMinFormWidthCm  = Минимальный размер формы (в Сантиметрах, дробное), _
                       по горизонтали при котором пересещения не происходит
'--------------------------------------------------------------------
'Пример эксплуатации (аж на 5 кнопок):
' Private Sub Form_Resize()
'    EqvGorizontal Me, Me!cmd01, 5, 1, 16
'    EqvGorizontal Me, Me!cmd02, 5, 2, 16
'    ...
'    EqvGorizontal Me, Me!cmd05, 5, 5, 16
' End Sub
'--------------------------------------------------------------------
Const TwipsInCM = 567    'Сколько Твипов (Twips) в 1 см
Dim iLeft%, iTop%        'Отступ слева и сверху объекта
Dim iWidth%, iHeight%    'Ширина и высота объекта
Dim iNewFormWidth%       'Новая ширина формы (в твипах)
Dim i As Integer         'Служебная - для разл. расчётов
Static iMinLeft%         'Отступ Слева (он-же и справа)
Static iBetweenLen%      'Промежуток между левыми краями контролей(в твипах)
'--------------------------------------------------------------------
On Error GoTo EqvGorizontal_Err

'Новая ширина формы:
    iNewFormWidth = frm.InsideWidth
 
'Учёт минимальной ширины формы - если новая меньше = на выход (ничего не делаем)
    i = iMinFormWidthCm * TwipsInCM + i
    If iNewFormWidth < i Then GoTo EqvGorizontal_End

'На первом контроле делаем основной расчёт Static переменных
    If iControlNo = 1 Then
        iMinLeft = ctrl.Left           'Отступ слева самого левого
        'Ширина распределения в твипах между левым краем первого и последнего:
        i = iNewFormWidth - (ctrl.Width + iMinLeft)
        'Ширина распределения меду левыми краями соседей
        iBetweenLen = (i - iMinLeft) \ (iTotControls - 1)
        'Первый (самый левый) двигать не нужно - расчёты сделаны - ВСЁ! ...
        GoTo EqvGorizontal_End ' ... на выход.
    End If
    
' Проверка что предыдущие строки были выполнены (на самом левом контроле №1) _
  котрый должен быть первым в перечислении
    If iControlNo > 1 And iMinLeft = 0 Then GoTo EqvGorizontal_End

'--------------------------------------------------------------------
'Берём текущие параметры контрола
    iTop = ctrl.Top    'Отступ сверху контрола
    iWidth = ctrl.Width  'Ширина контрола
    iHeight = ctrl.Height 'Высота контрола

' Расчёт отступа слева
    iLeft = iMinLeft + (iBetweenLen * (iControlNo - 1))

'Собственно перемещение
    ctrl.Move iLeft, iTop, iWidth, iHeight
    
EqvGorizontal_End:
    On Error GoTo 0
    Exit Sub

EqvGorizontal_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure EqvGorizontal.", vbCritical, "Произошла ошибка!"
    Err.Clear
    Resume EqvGorizontal_End

End Sub



Из этого:

Picture


это:

Picture

После изменения размера ...




Скачать

MSA-2003 ( 27 kB) Пример


Назад ToTop
L.E. 16.10.2023
Рейтинг@Mail.ru