Случилось следующее: сижу в Сочи, правлю базу. И вот какая проблема. Есть несколько компьютеров. У одних монитор 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 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Const SM_CXVSCROLL = 2 Private Const SM_CYHSCROLL = 3 Private Const SM_CYCAPTION = 4 Private Const SM_CXBORDER = 5 Private Const SM_CYBORDER = 6 Private Const SM_CXDLGFRAME = 7 Private Const SM_CYDLGFRAME = 8 Private Const SM_CYVTHUMB = 9 Private Const SM_CXHTHUMB = 10 Private Const SM_CXICON = 11 Private Const SM_CYICON = 12 Private Const SM_CXCURSOR = 13 Private Const SM_CYCURSOR = 14 Private Const SM_CYMENU = 15 Private Const SM_CXFULLSCREEN = 16 Private Const SM_CYFULLSCREEN = 17 Private Const SM_CYKANJIWINDOW = 18 Private Const SM_MOUSEPRESENT = 19 Private Const SM_CYVSCROLL = 20 Private Const SM_CXHSCROLL = 21 Private Const SM_DEBUG = 22 Private Const SM_SWAPBUTTON = 23 Private Const SM_RESERVED1 = 24 Private Const SM_RESERVED2 = 25 Private Const SM_RESERVED3 = 26 Private Const SM_RESERVED4 = 27 Private Const SM_CXMIN = 28 Private Const SM_CYMIN = 29 Private Const SM_CXSIZE = 30 Private Const SM_CYSIZE = 31 Private Const SM_CXFRAME = 32 Private Const SM_CYFRAME = 33 Private Const SM_CXMINTRACK = 34 Private Const SM_CYMINTRACK = 35 Private Const SM_CXDOUBLECLK = 36 Private Const SM_CYDOUBLECLK = 37 Private Const SM_CXICONSPACING = 38 Private Const SM_CYICONSPACING = 39 Private Const SM_MENUDROPALIGNMENT = 40 Private Const SM_PENWINDOWS = 41 Private Const SM_DBCSENABLED = 42 Private Const SM_CMOUSEBUTTONS = 43 Private Const SM_CMETRICS = 44 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 var_FormName = frm.Name var_ШиринаФормы = frm.Width ВысотаОбластиДанных = frm.Section(0).Height ЕстьЛиЗаголовокФормы = False On Error GoTo МеткаНетЗаголовкаФормы ВысотаЗаголовкаФормы = frm.Section(1).Height ЕстьЛиЗаголовокФормы = True GoTo ПроверкаПримечанияФормы МеткаНетЗаголовкаФормы: Resume ПроверкаПримечанияФормы ПроверкаПримечанияФормы: ЕстьЛиПримечаниеФормы = False On Error GoTo МеткаНетПримечанияФормы ВысотаПримечанияФормы = frm.Section(2).Height ЕстьЛиПримечаниеФормы = True GoTo ПроверкаВерхнегоКолонтитулаФормы МеткаНетПримечанияФормы: Resume ПроверкаВерхнегоКолонтитулаФормы ПроверкаВерхнегоКолонтитулаФормы: ЕстьЛиВерхнийКолонтитулФормы = False On Error GoTo МеткаНетВерхнегоКолонтитулаФормы ВысотаВерхнегоКолонтитулаФормы = frm.Section(3).Height ЕстьЛиВерхнийКолонтитулФормы = True GoTo ПроверкаНижнегоКолонтитулаФормы МеткаНетВерхнегоКолонтитулаФормы: Resume ПроверкаНижнегоКолонтитулаФормы: ПроверкаНижнегоКолонтитулаФормы: ЕстьЛиНижнийКолонтитулФормы = False On Error GoTo МеткаНетНижнегоКолонтитулаФормы ВысотаНижнегоКолонтитулаФормы = frm.Section(3).Height ЕстьЛиНижнийКолонтитулФормы = True GoTo ОконченаПроверка МеткаНетНижнегоКолонтитулаФормы: Resume ОконченаПроверка ОконченаПроверка: 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 On Error Resume Next frm.Width = var_ШиринаФормы + var_ШиринаФормы * _ var_КоэффициэнтТрансформации frm.Section(0).Height = ВысотаОбластиДанных + _ ВысотаОбластиДанных * var_КоэффициэнтТрансформации 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 frm.Width = var_ШиринаФормы + var_ШиринаФормы * var_КоэффициэнтТрансформации frm.Section(0).Height = ВысотаОбластиДанных + ВысотаОбластиДанных * var_КоэффициэнтТрансформации 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 frm.InsideWidth = frm.Width frm.InsideHeight = Max + 1.5 * Size DoCmd.MoveSize _ (apiGetSys(SM_CXSCREEN) * 20 - frm.InsideWidth) / 16, _ (apiGetSys(SM_CYSCREEN) * 20 - frm.InsideHeight) / 16 Exit_Динамически_ТрансформироватьФорму: Exit Sub Err_Динамически_ТрансформироватьФорму: MsgBox Err.Description Resume Exit_Динамически_ТрансформироватьФорму End Sub 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 Err_NSA_SCR_КоэффициэнтТрансформации: MsgBox Err.Description Resume Exit_NSA_SCR_КоэффициэнтТрансформации End Function |
Просмотров: 12783
 Коментарии (2) |
 |
| Добавить коментарий |