размер объектов формы при разных разрешениях экрана

[vbarkov]

Подскажите, как сделать, чтобы при различных разрешениях экрана
объекты формы (кнопки, текст, и т.д.) имели на экране одинаковый
размер ?
СПАСИБО!

[Urvin]

cmdButton.width = screen.width / 10
cmdButton.height = screen.height / 20

[MEMBER]

Лучше так: http://vbnet.ru/faq/showtopic.asp?id=376
Только код:

Код: Выделить всё

Private Sub Form_Resize()
ResizeForm Me
End Sub


замени на:

Код: Выделить всё

Private Sub Form_Resize()
If Me.Windowstate = 1 Then Exit Sub
ResizeForm Me
End Sub


[vbarkov]

cmdButton.width = screen.width / 10
cmdButton.height = screen.height / 20

Уважаемый г-н Urvin!
Спасибо за Ваш ответ. Осмелюсь заметить,что, сожалению,
предлагаемый Вами способ не всегда хорош: кроме width и height
объекты формы обладают свойствами top и left. Кроме этого,
каждый из объектов содержит текст. Т.о. получается 5 параметров
объекта, подлежащих настройке. А если на форме 30 объектов
(видны в разное время) ? Не знаю как Вам, а мне становится скучно.
А нельзя ли как-то воспользоваться свойствами формы,
содержащими слово SCALE ?
В. Барков

[vbarkov]

Лучше так: http://vbnet.ru/faq/showtopic.asp?id=376
Только код:

Код: Выделить всё

Private Sub Form_Resize()
ResizeForm Me
End Sub


замени на:

Код: Выделить всё

Private Sub Form_Resize()
If Me.Windowstate = 1 Then Exit Sub
ResizeForm Me
End Sub


Уважаемый г-н MEMBER, спасибо!
К сожалению, мне не удалось воспользоваться Вашим советом,
т.к. комп сообщает, что "sub или функция ResizeForm не определена",
а попасть по адресу, куда Вы меня послали, не удается из-за
проблем с регистрацией. Если можно, поясните, пожалуйта,
подробно, что надо сделать. А может быть, если есть такая
возможность, проще менять из программы разрешение экрана?
В. Барков

[FaKk2]

Цитата:

Отличный и бесподобный пример, автору которого надо выдавать приз за один из отличнейших примеров. К сожалению, я не знаю ни имени автора, ни сайта, разместившего в первоисточнике этот пример. Что делает пример? Ни много, ни мало, а код в зависимости от изменения размеров формы, меняет размеры всех контролов, расположенных на этой форме!!! Вам надо добавить на форму 2 элемента CommanButton и дополнительный модуль в программу. Запустите программу и попробуйте изменять размеры формы. Впечатляет? В любой момент нажмите на кнопку 1, измените размеры формы и нажмите на кнопку 2. Впечатляет?!?
--------------------------------------------------------------------------------

Код: Выделить всё

'КОД ФОРМЫ

Private Sub Command1_Click()
SaveFormPosition Me
End Sub

Private Sub Command2_Click()
RestoreFormPosition Me
End Sub

Private Sub Form_Resize()
ResizeForm Me
End Sub

'КОД МОДУЛЯ

Option Explicit
Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type
Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private MaxForm As Long
Private MaxControl As Long

Private Function ActualPos(plLeft As Long) As Long
If plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft
End Function

Private Function FindForm(pfrmIn As Form) As Long
Dim i As Long
FindForm = -1
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then FindForm = i: Exit Function
Next i
End If
End Function

Private Function AddForm(pfrmIn As Form) As Long
Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)
FormRecord(MaxForm).Name = pfrmIn.Name
FormRecord(MaxForm).Top = pfrmIn.Top
FormRecord(MaxForm).Left = pfrmIn.Left
FormRecord(MaxForm).Height = pfrmIn.Height
FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1
For Each FormControl In pfrmIn
i = FindControl(FormControl, pfrmIn.Name)
If i < 0 Then i = AddControl(FormControl, pfrmIn.Name)
Next FormControl
End Function

Private Function FindControl(inControl As Control, inName As String) As Long
Dim i As Long
FindControl = -1
For i = 0 To (MaxControl - 1)
If ControlRecord(i).Parrent = inName Then
If ControlRecord(i).Name = inControl.Name Then
On Error Resume Next
If ControlRecord(i).Index = inControl.Index Then
FindControl = i
Exit Function
End If
On Error GoTo 0
End If
End If
Next i
End Function

Private Function AddControl(inControl As Control, inName As String) As Long
ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName
If TypeOf inControl Is Line Then
ControlRecord(MaxControl).Top = inControl.Y1
ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
ControlRecord(MaxControl).Height = inControl.Y2
ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
ControlRecord(MaxControl).Top = inControl.Top
ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
ControlRecord(MaxControl).Height = inControl.Height
ControlRecord(MaxControl).Width = inControl.Width
End If
On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function

Private Function PerWidth(pfrmIn As Form) As Long
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)
PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function

Private Function PerHeight(pfrmIn As Form) As Single
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)
PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function

Private Sub ResizeControl(inControl As Control, pfrmIn As Form)
Dim i As Long
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)
On Error GoTo Moveit
If inControl.Left < 0 Then
lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
'
Moveit:
On Error GoTo MoveError1
If TypeOf inControl Is Line Then
If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
Else
inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
End If
inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
Else
If TypeOf inControl Is Timer Then GoTo subExit
inControl.Move lLeft, lTop, lWidth, lHeight
End If
GoTo subExit
'
MoveError1:
On Error GoTo MoveError2
inControl.Move lLeft, lTop, lWidth
GoTo subExit
'
MoveError2:
On Error GoTo subExit
inControl.Move lLeft, lTop
'
subExit:
On Error GoTo 0
End Sub

Public Sub ResizeForm(pfrmIn As Form)
Dim FormControl As Control
Dim isVisible As Boolean
If pfrmIn.Top < 30000 Then
isVisible = pfrmIn.Visible
pfrmIn.Visible = False
For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl
pfrmIn.Visible = isVisible
End If
End Sub

Public Sub SaveFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
FormRecord(i).Top = pfrmIn.Top
FormRecord(i).Left = pfrmIn.Left
FormRecord(i).Height = pfrmIn.Height
FormRecord(i).Width = pfrmIn.Width
Exit Sub
End If
Next i
AddForm (pfrmIn)
End If
End Sub

Public Sub RestoreFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
If FormRecord(i).Top < 0 Then
pfrmIn.WindowState = 2
ElseIf FormRecord(i).Top < 30000 Then
pfrmIn.WindowState = 0
pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top
pfrmIn.Width = FormRecord(i).Width
pfrmIn.Height = FormRecord(i).Height
Else
pfrmIn.WindowState = 1
End If
Exit Sub
End If
Next i
End If
End Sub

[alibek]

FAKK2, а по мне это "заказанная" рецензия. На деле имеем обычное запоминание пропорций и их пересчет для новых размеров. Правда код помоему умеет работать с контейнерами, но не рекурсивно (хотя я толком и не смотрел).
Обычно требуется не пропорциональное изменение, а изменение размеров для части контролов и перемещение другой части контролов.
vbarkov, а эту функцию тебе надо будет написать самому, MEMBER дал идею. Другой способ: есть замечательный контрол Olectra Resizer который берет на себя всю работу по изменению координат и размеров контролов. Контрол замечательный, но платный. Если твоя программа будет коммерческой, имеет смысл купить его.