Статья с ресурса NSA.CHAT.RU Источник: http://nsa.chat.ru/UserInterfase_Dinamic_Scr.html
Изменение размеров формы под разрешение экрана
Случилось следующее: сижу в Сочи, правлю базу. И вот какая проблема. Есть несколько компьютеров. У одних монитор 14' с разрешением 800*600, а у других - 17' с разрешением 1024*768. Создал копии оболочек для разных разрешений. Но исправления нужно вносить во все оболочки, а тут недолго и запутаться. Поэтому пришлось сделать динамическое изменениен размеров форма в зависимости от разрешения экрана. За основу взял функцию из своего Мастера изменения размеров. Итак, вставляете в каждую форму, которая должна динамически меняться в зависимости от разрешения экрана вставляем следующий код:
Благодаря Игорю (ICQ#31419537) исправлен баг при работе со всплывающими окнами. Спасибо ему за это огромное.
Private Sub Form_Open(Cancel As Integer) Call ТрансформироватьФорму(Me, "800*600") End Sub
В данном случае "800*600" - это разрешение, на которое настроена форма.
Добавляем в базу модуль следующего содержания:
Option Compare Database Option Explicit
Private Declare Function apiGetSys Lib "user32" _ Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Function fGetSysStuff(strWhat As String) As String Dim strRet As String
Select Case LCase(strWhat) Case "resolution" strRet = apiGetSys(SM_CXSCREEN) & "*" _ & apiGetSys(SM_CYSCREEN) Case "windowsize" strRet = apiGetSys(SM_CXFULLSCREEN) & "*" _ & apiGetSys(SM_CYFULLSCREEN) End Select
fGetSysStuff = strRet End Function
Sub ТрансформироватьФорму(frm As Form, _ var_РазрешениеЭкранаНаКотороеНастроенаФорма As String)
Dim КоэффициентТрансформации As Double
If fGetSysStuff("resolution") <> _ var_РазрешениеЭкранаНаКотороеНастроенаФорма Then КоэффициентТрансформации = _ NSA_SCR_КоэффициэнтТрансформации_ (var_РазрешениеЭкранаНаКотороеНастроенаФорма, _ fGetSysStuff("resolution")) Call Динамически_ТрансформироватьФорму(frm, _ КоэффициентТрансформации) End If
End Sub
Sub Динамически_ТрансформироватьФорму(frm As Form, _ var_КоэффициэнтТрансформации As Double)
On Error GoTo Err_Динамически_ТрансформироватьФорму
Dim ctr As Control Dim i As Variant Dim j As Variant Dim var_ШиринаФормы As Double Dim var_FormName As String Dim ЕстьЛиЗаголовокФормы As Boolean Dim ЕстьЛиПримечаниеФормы As Boolean Dim ЕстьЛиВерхнийКолонтитулФормы As Boolean Dim ЕстьЛиНижнийКолонтитулФормы As Boolean
Dim ВысотаОбластиДанных As Double Dim ВысотаЗаголовкаФормы As Double Dim ВысотаПримечанияФормы As Double Dim ВысотаВерхнегоКолонтитулаФормы As Double Dim ВысотаНижнегоКолонтитулаФормы As Double Dim Max Dim Size
ОконченаПроверка: On Error GoTo Err_Динамически_ТрансформироватьФорму
Dim КолЭлУпр As Long КолЭлУпр = frm.Controls.Count
ReDim МассивЭлементов(1 To 7, _ 0 To КолЭлУпр - 1) As Double Dim kolWkl As Long kolWkl = 0
For i = 0 To КолЭлУпр - 1
Set ctr = frm.Controls(i)
If ctr.ControlType = acPage Then
МассивЭлементов(1, kolWkl) = i МассивЭлементов(2, kolWkl) = ctr.Top МассивЭлементов(3, kolWkl) = ctr.Left МассивЭлементов(4, kolWkl) = ctr.Width МассивЭлементов(5, kolWkl) = ctr.Height МассивЭлементов(6, kolWkl) = 0 For Each j In ctr.Properties
If j.Name = "FontSize" Then МассивЭлементов(6, kolWkl) = -1 МассивЭлементов(7, kolWkl) = ctr.FontSize Exit For End If
Next j kolWkl = kolWkl + 1
End If
Next i
For i = 0 To КолЭлУпр - 1
Set ctr = frm.Controls(i)
If ctr.ControlType = acTabCtl Then
МассивЭлементов(1, kolWkl) = i МассивЭлементов(2, kolWkl) = ctr.Top МассивЭлементов(3, kolWkl) = ctr.Left МассивЭлементов(4, kolWkl) = ctr.Width МассивЭлементов(5, kolWkl) = ctr.Height МассивЭлементов(6, kolWkl) = 0 For Each j In ctr.Properties
If j.Name = "FontSize" Then МассивЭлементов(6, kolWkl) = -1 МассивЭлементов(7, kolWkl) = ctr.FontSize Exit For End If
Next j kolWkl = kolWkl + 1
End If
Next i
For i = 0 To КолЭлУпр - 1 Set ctr = frm.Controls(i) If ctr.ControlType <> acTabCtl And _ ctr.ControlType <> acPage Then МассивЭлементов(1, kolWkl) = i МассивЭлементов(2, kolWkl) = ctr.Top МассивЭлементов(3, kolWkl) = ctr.Left МассивЭлементов(4, kolWkl) = ctr.Width МассивЭлементов(5, kolWkl) = ctr.Height МассивЭлементов(6, kolWkl) = 0 For Each j In ctr.Properties If j.Name = "FontSize" Then МассивЭлементов(6, kolWkl) = -1 МассивЭлементов(7, kolWkl) = ctr.FontSize Exit For End If Next j kolWkl = kolWkl + 1 End If Next i
If ЕстьЛиЗаголовокФормы Then frm.Section(1).Height = ВысотаЗаголовкаФормы + _ ВысотаЗаголовкаФормы * var_КоэффициэнтТрансформации End If
If ЕстьЛиПримечаниеФормы Then frm.Section(2).Height = ВысотаПримечанияФормы + _ ВысотаПримечанияФормы * var_КоэффициэнтТрансформации End If
If ЕстьЛиВерхнийКолонтитулФормы Then frm.Section(3).Height = _ ВысотаВерхнегоКолонтитулаФормы + _ ВысотаВерхнегоКолонтитулаФормы * _ var_КоэффициэнтТрансформации End If
If ЕстьЛиНижнийКолонтитулФормы Then frm.Section(4).Height = _ ВысотаНижнегоКолонтитулаФормы + _ ВысотаНижнегоКолонтитулаФормы * _ var_КоэффициэнтТрансформации End If
For i = КолЭлУпр - 1 To 0 Step -1 Set ctr = frm.Controls(МассивЭлементов(1, i))
'От верхнего края ctr.Top = МассивЭлементов(2, i) + _ МассивЭлементов(2, i) * var_КоэффициэнтТрансформации 'От левого края ctr.Left = МассивЭлементов(3, i) + _ МассивЭлементов(3, i) * var_КоэффициэнтТрансформации 'Ширина ctr.Width = МассивЭлементов(4, i) + _ МассивЭлементов(4, i) * var_КоэффициэнтТрансформации 'Высота ctr.Height = МассивЭлементов(5, i) + _ МассивЭлементов(5, i) * var_КоэффициэнтТрансформации If ctr.Top > Max Then Max = ctr.Top Size = ctr.Height End If If МассивЭлементов(6, i) = -1 Then _ ctr.FontSize = МассивЭлементов(7, i) + _ МассивЭлементов(7, i) * _ var_КоэффициэнтТрансформации If var_КоэффициэнтТрансформации = -0.2 Then ctr.FontName = "SmallFonts" End If Next i
If ЕстьЛиЗаголовокФормы Then frm.Section(1).Height = ВысотаЗаголовкаФормы + _ ВысотаЗаголовкаФормы * var_КоэффициэнтТрансформации End If
If ЕстьЛиПримечаниеФормы Then frm.Section(2).Height = ВысотаПримечанияФормы + _ ВысотаПримечанияФормы * var_КоэффициэнтТрансформации End If
If ЕстьЛиВерхнийКолонтитулФормы Then frm.Section(3).Height = _ ВысотаВерхнегоКолонтитулаФормы + _ ВысотаВерхнегоКолонтитулаФормы * _ var_КоэффициэнтТрансформации End If
If ЕстьЛиНижнийКолонтитулФормы Then frm.Section(4).Height = _ ВысотаНижнегоКолонтитулаФормы + _ ВысотаНижнегоКолонтитулаФормы * _ var_КоэффициэнтТрансформации End If
Function NSA_SCR_КоэффициэнтТрансформации _ (var_ИсходныйРазмерЭкрана As String, _ var_КонечныйРазмерЭкрана As String) As Double
On Error GoTo Err_NSA_SCR_КоэффициэнтТрансформации
'Функция возвращает коэффициэнт увеличения (или 'уменьшения) размеров и позиций элементов управления 'в формах для преобразования из одного 'размера экрана в другой. 'Возможные варианты размеров экрана: ' "640*480" ' "800*600" ' "1024*768" ' "1280*1024"
Dim a As Double
Select Case var_ИсходныйРазмерЭкрана Case "640*480" Select Case var_КонечныйРазмерЭкрана Case "640*480" a = 0 Case "800*600" a = 0.25 Case "1024*768" a = 0.6 Case "1280*1024" a = 1 Case Else a = 0 End Select Case "800*600" Select Case var_КонечныйРазмерЭкрана Case "640*480" a = -0.2 Case "800*600" a = 0 Case "1024*768" a = 0.28 Case "1280*1024" a = 0.6 Case Else a = 0 End Select Case "1024*768" Select Case var_КонечныйРазмерЭкрана Case "640*480" a = -0.375 Case "800*600" a = -0.21875 Case "1024*768" a = 0 Case "1280*1024" a = 0.25 Case Else a = 0 End Select Case "1280*1024" Select Case var_КонечныйРазмерЭкрана Case "640*480" a = -0.5 Case "800*600" a = -0.375 Case "1024*768" a = -0.2 Case "1280*1024" a = 0 Case Else a = 0 End Select Case Else a = 0 End Select
NSA_SCR_КоэффициэнтТрансформации = a
Exit_NSA_SCR_КоэффициэнтТрансформации: Exit Function