Контроли - По размеру формы

"Красиво" ресайзим контролли под тек. размер формы.
употребимо при развороте формы в полный экран или при разрешеении юсеру "ресайзить" форму.



MSA 2003 SP1 1280x1024 (в полный экран):

MSA 2003 SP1 1280x1024 (нормальное окно):

MSA 2010 1920x1200 (в полный экран):

КОД ИЗ ПРИМЕРА:
Главная форма:

Private Sub Form_Load()

'В полный экран :

DoCmd.Maximize

End Sub

Private Sub Form_Resize()

'es 24.12.2012

'Событие - Изменение размеров формы

'--------------------------------------------------------------------------

'Перемещаем обьекты за именяемой формой

'Используем: object.Move left, top, width, height

'--------------------------------------------------------------------------

Const cm = 567 'Скока Твипов (Twips) в 1 см

Dim iMinFormWidth As Integer 'Мин. допустимая ширина и высота формы

Dim iMinFormHeight As Integer

Dim iNewFormWidth As Integer 'Новая ширина и высота формы

Dim iNewFormHeight As Integer

Dim l As Integer 'отступ слева

Dim t As Integer 'отступ сверху

Dim w As Integer 'ширина

Dim h As Integer 'высота

Dim iMid As Integer 'Середина формы

Dim iTemp As Integer 'Служебная для разл. расчётов

'--------------------------------------------------------------------------

On Error GoTo Form_ResizeErr

'

iMinFormWidth = 23 * cm 'Мин. допустимая ширина формы

iMinFormHeight = 10 * cm 'Мин. допустимая высота формы

iNewFormWidth = Me.InsideWidth

iNewFormHeight = Me.InsideHeight

'--------------------------------------------------------------------------

' КОТРОЛИ:

'--------------------------------------------------------------------------

'Заголовок

iTemp = Me!lblHeeader.Left

Me!lblHeeader.Width = iNewFormWidth - iTemp 'По размеру и с одинаковым отступом по краям

'Фон Заголовка формы

Me!imgFormHeaderFon.Width = iNewFormWidth

'Поле поиска

iMid = Round(iNewFormWidth / 2, 0)

iTemp = Round(Me!txtTextToSearch.Width / 2, 0)

t = Me!txtTextToSearch.Top ' Отступ сверху контрола

l = iMid - iTemp ' по центру

w = Me!txtTextToSearch.Width

h = Me!txtTextToSearch.Height

Me!txtTextToSearch.Move l, t, w, h

'Лейбл (подпись) поиска

w = Me!lblTextToSearch.Width

l = l - Round(2 * cm, 0)

Me!lblTextToSearch.Move l, t, w, h

'Кнопка очистки фильтра - cmdClearSearch относит. txtTextToSearch

l = Me!txtTextToSearch.Left + Me!txtTextToSearch.Width + 60

w = cmdClearSearch.Width

Me!cmdClearSearch.Move l, t, w, h

'Кнопка "Закрыть" - Просто загоняем её в правый угол с отступом справа

l = iNewFormWidth - Me!cmdClose.Width - 100

Me!cmdClose.Left = l

'Фон "Подвала"

Me!imgFormFooterFon.Width = iNewFormWidth

'Лейбл: Для перхода к полю поиска... - ПО ЦЕНТРУ

iTemp = Round(Me!lblTabToS.Width / 2, 0)

l = iMid - iTemp ' по центру

Me!lblTabToS.Left = l

'Объект = Подчинённая форма = Me!objSubForm

' - Объекты подчинённой обрабатываються в её собственном модуле

l = 0

t = Me!objSubForm.Top 'Отступ сверху

w = iNewFormWidth 'Ширина

'Получаем высоту подчинённой

iTemp = Me.objFormHeader.Height + Me.objFormFooter.Height + t

h = iNewFormHeight - iTemp

Me!objSubForm.Move l, t, w, h

Form_ResizeBye:

Exit Sub

Form_ResizeErr:

If Err = 2100 Then 'Сворачивание

Err.Clear

'Debug.Print Err.Description

Else

MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbCrLf & _

"in procedure Form_Resize ", vbCritical, "Error!"

End If

Resume Form_ResizeBye

End Sub

Подчинённая форма:

Private Sub Form_Resize()

'Событие - Изменение размеров формы

'es - 24.12.2012

'--------------------------------------------------------------------

Const cm = 567 'Сколько Твипов (Twips) в 1 см '567 твипов = 1 см ' 1440 твипов = 1 дюйм

Dim iNewFormWidth As Integer 'Новая ширина формы (Всегда больше минимальной)

Dim xPlus As Integer

Dim wPlus As Integer

Dim l As Integer 'Отступ слева

Dim w As Integer 'Ширина

'Мин. допустимая ширина формы

Dim iMinFormWidth As Integer: iMinFormWidth = CInt(19 * cm)

'Начальная (минимальная) ширина полей в подчинённой форме

'Размеры берём в конструкторе формы

Dim iTypeNameWidth As Integer: iTypeNameWidth = CInt(3 * cm)

Dim iManNameWidth As Integer: iManNameWidth = CInt(4 * cm)

Dim iGoodNameWidth As Integer: iGoodNameWidth = CInt(6 * cm)

Dim iGoodDescriptionWidth As Integer: iGoodDescriptionWidth = CInt(4 * cm)

'--------------------------------------------------------------------

On Error GoTo Form_Resize_Err

'Определяем новый размер формы

w = Me.CurrentSectionLeft ' Ширина области выделения формы

iNewFormWidth = Me.InsideWidth - w ' Чистая ширина формы

'Форма не может быть меньше минимального размера

If iNewFormWidth <= iMinFormWidth Then GoTo Form_Resize_Bye

'Теперь обьекты формы

With Me

xPlus = iNewFormWidth - iMinFormWidth 'Получили тек прирост ширины формы

If xPlus > 4 Then

'Делим добавку ширины на 4 поля поровну

wPlus = CInt(xPlus / 4) 'Прирост ширины для одного поля

Else

wPlus = 0

End If

'Переставляем обьекты

'--------------------------------------------------------------------

'00 - Линия

w = iNewFormWidth - !UnderLine.Left

!UnderLine.Width = w 'Линию подчёркивания по ширине

'01 Поле "Тип ТОВАРА"

l = !txtTypeName.Left 'Отступ не трогаем

w = iTypeNameWidth + wPlus 'Нов ширина

!txtTypeName.Left = l

!txtTypeName.Width = w

'Лейбл

!lblTypeName.Left = l

!lblTypeName.Width = w

'02- Производитель

l = l + w 'Отступ слева:l и ширина:w уже расчитаны выше

w = iManNameWidth + wPlus 'Нов ширина

!txtManName.Left = l

!txtManName.Width = w

'Лебл - туда же!

!lblManName.Left = l

!lblManName.Width = w

'03 Наменование (полностью аналогично)

l = l + w

w = iGoodNameWidth + wPlus 'Нов ширина

!txtGoodName.Left = l

!txtGoodName.Width = w

!lblGoodName.Left = l 'Лейбл

!lblGoodName.Width = w

'04 - Цена - просто передвигаем

l = l + w

w = !txtGoodPrice.Width 'Ширина = без изменений

!txtGoodPrice.Left = l

!txtGoodPrice.Width = w

!lblGoodPrice.Left = l 'Лейбл

!lblGoodPrice.Width = w

'05- Описание Товара - по остаточному принципу (поправка на округление значения прироста ширины)

l = l + w

w = iNewFormWidth - l

w = w - 4 ' Для чёткого отображения правой границы: уменьшаю ширину на n твипов

!txtGoodDescription.Left = l

!txtGoodDescription.Width = w

!lblGoodDescription.Left = l 'Лейбл

!lblGoodDescription.Width = w

End With

Form_Resize_Bye:

Exit Sub

Form_Resize_Err:

Debug.Print "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _

"in procedure Form_Resize"

Resume Form_Resize_Bye

End Sub

MSA-2003 ( 123 kB)