Newsgroup: it.lavoro.informatica
Titolo: fom resiser

      Author  Topic:   Improved version
      ibest
      Junior Member   posted 09-17-2000 01:25 PM
--------------------------------------------------------------------------
      I have made some alterations to the form-resize code that should make
it more useful.
      It has been abstracted into a class module that can be added to any
project. It can then be used by any number of forms in that project without
duplicating the code. It also leaves the tag property of the form's controls
free to be used for something else.
      In this incarnation, this class will only work with forms that do not
have controls
      'added to them dynamically at runtime.
      This code has been altered for and seems to work fine with most
controls, including combo boxes and the Microsoft tabbed dialog box.
      The following code is required in forms that use this class...
      Private Resizer As clsResizer (put this in declarations section)
      Private Sub Form_Load()
      Set Resizer = New clsResizer
      Resizer.GetMySizes Me
      End Sub
      Private Sub Form_Resize()
      If Not Resizer Is Nothing Then Resizer.ResizeAll Me
      End Sub
      Private Sub Form_Unload(Cancel As Integer)
      Set Resizer = Nothing
      End Sub
_______________________________________________________________________
      The following is the class code. create a class module called
clsResizer and paste this code into it:
      Private mFormWidth As Long
      Private mFormHeight As Variant
      Private marrControlsSizes As Variant
      Private miControlsCount As Integer
      Public Event ResizeAllComplete()
      Public Sub GetMySizes(pForm As Form)
      Dim X As Integer 'counter
      On Error GoTo EH
      'Set the object properties to the properties of the calling form...
      mFormWidth = pForm.ScaleWidth
      mFormHeight = pForm.ScaleHeight
      miControlsCount = pForm.Controls.Count
      'Size the array to hold the required number of controls by 6 (for the
6 properties to be stored for each ctl)
      ' ...these being a reference to the control itself and the top, left,
width, height & font size of the control
      ReDim marrControlsSizes(miControlsCount, 5)
      'Populate the array...
      For X = 0 To miControlsCount - 1
      With pForm
      marrControlsSizes(X, 0) = .Controls(X)
      marrControlsSizes(X, 1) = .Controls(X).Top
      marrControlsSizes(X, 2) = .Controls(X).Left
      marrControlsSizes(X, 3) = .Controls(X).Width
      marrControlsSizes(X, 4) = .Controls(X).Height
      marrControlsSizes(X, 5) = .Controls(X).FontSize
      End With
      Next X
      Exit Sub
      EH:
      If Err.Number = 438 Or Err.Number = 383 Then Resume Next
      Err.Raise vbObjectError + 600, "clsResizer.GetMySizes",
Err.Description
      End Sub
      Public Sub ResizeAll(pForm As Form)
      Dim frm As Form
      Dim Ctl As Control
      Dim ScaleX As Double
      Dim ScaleY As Double
      Dim LeftArg As Double
      On Error GoTo EH
      'Set the object properties to the properties of the calling form...
      Set frm = pForm
      'Calculate the scale
      ScaleX = frm.ScaleWidth / mFormWidth
      ScaleY = frm.ScaleHeight / mFormHeight
      'Iterate through the array of stored controls and original sizes to
resize the controls on the form
      For X = 0 To miControlsCount - 1
      Set Ctl = frm.Controls(X)
      With Ctl
      'Set the font size...
      If ScaleX < ScaleY Then
      Ctl.FontSize = marrControlsSizes(X, 5) * ScaleX
      Else
      Ctl.FontSize = marrControlsSizes(X, 5) * ScaleY
      End If
      'The following is to enable compatibility with MS tabbed dialog
control...
      If marrControlsSizes(X, 2) < 0 Then
      LeftArg = (marrControlsSizes(X, 2) + 75000) * ScaleX - 75000
      Else
      LeftArg = marrControlsSizes(X, 2) * ScaleX
      End If
      '=====================================================
      Ctl.Move LeftArg, marrControlsSizes(X, 1) * ScaleY,
marrControlsSizes(X, 3) * marrControlsSizes(X, 4) * ScaleY
      Ctl.Width = marrControlsSizes(X, 3) * ScaleX
      Ctl.Height = marrControlsSizes(X, 4) * ScaleY
      End With
      Next X
      Set frm = Nothing
      RaiseEvent ResizeAllComplete
      Exit Sub
      EH:
      If Err.Number = 438 Or Err.Number = 383 Then Resume Next
      Err.Raise vbObjectError + 601, "clsResizer.ResizeAll", Err.Description
      End Sub
      quick65
      Junior Member   posted 03-20-2001 01:24 PM
--------------------------------------------------------------------------
      Added support for Line and Shape controls....
      // clsResizer Class Code
      'Option Explicit
      Private mFormWidth As Long
      Private mFormHeight As Variant
      Private marrControlsSizes As Variant
      Private miControlsCount As Integer
      Enum CTL_SETTINGS
      SET_CONTROL_NAME
      SET_X1_LEFT
      SET_Y1_TOP
      SET_X2_WIDTH
      SET_Y2_HEIGHT
      SET_FONTSIZE
      SET_FLAG_USEXY
      SET_BORDERWIDTH
      SET_FLAGUSEBORDERWIDTH
      SET_LASTITEM = SET_FLAGUSEBORDERWIDTH
      End Enum
      Public Event ResizeAllComplete()
      Public Sub GetMySizes(pForm As Form)
      Dim X As Integer 'counter
      Dim bParameterError As Boolean
      On Error GoTo EH
      'Set the object properties to the properties of the calling form...
      mFormWidth = pForm.ScaleWidth
      mFormHeight = pForm.ScaleHeight
      miControlsCount = pForm.Controls.Count
      'Size the array to hold the required number of controls by 6 (for the
6 properties to be stored for each ctl)
      ' ...these being a reference to the control itself and the top, left,
width, height & font size of the control
      ReDim marrControlsSizes(miControlsCount, SET_LASTITEM)
      'Populate the array...
      For X = 0 To miControlsCount - 1
      With pForm
      Debug.Print .Controls(X).Name
      marrControlsSizes(X, SET_CONTROL_NAME) = .Controls(X)
      bParameterError = False
      marrControlsSizes(X, SET_X1_LEFT) = .Controls(X).Left
      If bParameterError Then
      marrControlsSizes(X, SET_X1_LEFT) = .Controls(X).X1
      marrControlsSizes(X, SET_Y1_TOP) = .Controls(X).Y1
      marrControlsSizes(X, SET_X2_WIDTH) = .Controls(X).X2
      marrControlsSizes(X, SET_Y2_HEIGHT) = .Controls(X).Y2
      marrControlsSizes(X, SET_FLAG_USEXY) = True
      Else
      marrControlsSizes(X, SET_X1_LEFT) = .Controls(X).Left
      marrControlsSizes(X, SET_Y1_TOP) = .Controls(X).Top
      marrControlsSizes(X, SET_X2_WIDTH) = .Controls(X).Width
      marrControlsSizes(X, SET_Y2_HEIGHT) = .Controls(X).Height
      marrControlsSizes(X, SET_FLAG_USEXY) = False
      End If
      marrControlsSizes(X, SET_FONTSIZE) = .Controls(X).FontSize
      bParameterError = False
      marrControlsSizes(X, SET_BORDERWIDTH) = .Controls(X).BorderWidth
      If bParameterError Then
      marrControlsSizes(X, SET_FLAGUSEBORDERWIDTH) = False
      Else
      marrControlsSizes(X, SET_FLAGUSEBORDERWIDTH) = True
      End If
      End With
      Next X
      Exit Sub
      EH:
      If Err.Number = 438 Or Err.Number = 383 Then
      bParameterError = True
      Resume Next
      End If
      Err.Raise vbObjectError + 600, "clsResizer.GetMySizes",
Err.Description
      End Sub
      Public Sub ResizeAll(pForm As Form)
      Dim frm As Form
      Dim Ctl As Control
      Dim ScaleX As Double
      Dim ScaleY As Double
      Dim LeftArg As Double
      Dim nBorderWidth As Double
      On Error GoTo EH
      'Set the object properties to the properties of the calling form...
      Set frm = pForm
      'Calculate the scale
      ScaleX = frm.ScaleWidth / mFormWidth
      ScaleY = frm.ScaleHeight / mFormHeight
      'Iterate through the array of stored controls and original sizes to
resize the controls on the form
      For X = 0 To miControlsCount - 1
      Set Ctl = frm.Controls(X)
      If Ctl.Name = "Line1" Then
      Debug.Print Ctl.Name
      End If
      If marrControlsSizes(X, SET_FLAG_USEXY) = True Then
      With Ctl
      Ctl.X1 = marrControlsSizes(X, SET_X1_LEFT) * ScaleX
      Ctl.Y1 = marrControlsSizes(X, SET_Y1_TOP) * ScaleY
      Ctl.X2 = marrControlsSizes(X, SET_X2_WIDTH) * ScaleX
      Ctl.Y2 = marrControlsSizes(X, SET_Y2_HEIGHT) * ScaleY
      End With
      Else
      With Ctl
      'Set the font size...
      If ScaleX < ScaleY Then
      Ctl.FontSize = marrControlsSizes(X, SET_FONTSIZE) * ScaleX
      Else
      Ctl.FontSize = marrControlsSizes(X, SET_FONTSIZE) * ScaleY
      End If
      'The following is to enable compatibility with MS tabbed dialog
control...
      If marrControlsSizes(X, SET_X1_LEFT) < 0 Then
      LeftArg = (marrControlsSizes(X, SET_X1_LEFT) + 75000) * ScaleX - 75000
      Else
      LeftArg = marrControlsSizes(X, SET_X1_LEFT) * ScaleX
      End If
      '=====================================================
      Ctl.Move LeftArg, marrControlsSizes(X, SET_Y1_TOP) * ScaleY,
marrControlsSizes(X, 3) * marrControlsSizes(X, SET_X2_WIDTH) * ScaleY
      Ctl.Width = marrControlsSizes(X, SET_X2_WIDTH) * ScaleX
      Ctl.Height = marrControlsSizes(X, SET_Y2_HEIGHT) * ScaleY
      End With
      End If
      If marrControlsSizes(X, SET_FLAGUSEBORDERWIDTH) = True Then
      If ScaleX < ScaleY Then
      nBorderWidth = Int(Round(marrControlsSizes(X, SET_BORDERWIDTH) *
ScaleX, 0))
      Else
      nBorderWidth = Int(Round(marrControlsSizes(X, SET_BORDERWIDTH) *
ScaleY, 0))
      End If
      Ctl.BorderWidth = IIf(nBorderWidth < 1, 1, nBorderWidth)
      End If
      Next X
      Set frm = Nothing
      RaiseEvent ResizeAllComplete
      Exit Sub
      EH:
      If Err.Number = 438 Or Err.Number = 383 Then Resume Next
      Err.Raise vbObjectError + 601, "clsResizer.ResizeAll", Err.Description
      End Sub
      Benh
      Junior Member   posted 03-30-2001 03:51 PM
--------------------------------------------------------------------------
      I get a run time error 'Left' property cannot be read at run time.
--
===============================
Patrizio Rondini
patrizio...@tin.it
===============================
Via poliziano 2
42100 Reggio Emilia
Italia
tel   
+39 0522 32 20 76
Cel  +39 348 31 23 343
===============================


wrote:
 <omesso>
OT!