Newsgroup: it.comp.lang.visual-basic
Titolo: Problema ridimensionamento risolto

Scusate per la precedente E-Mail sono riuscita a risolvere il mio
problema......

 ha scritto nel messaggio
news:Hq1Z7.30$Ar....@nreader2.kpnqwest.net...


 problema......
Hai lasciato perdere ammettilo! :-)))))))))
Davide

un pò lunghina ma funziona...........
in un modulo
(Module1:)
Public Type Controllo
  Nome 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 RidimensioneForm() As Controllo
Private RidimensioneOggetto() As Controllo
Private Azione As Boolean
Private MaxForm As Long
Private MaxOggetto As Long
Private Function PosizioneAttuale(PosLeft As Long) As Long
  If PosLeft < 0 Then
    PosizioneAttuale = PosLeft + 75000
  Else
    PosizioneAttuale = PosLeft
  End If
End Function
Private Function TrovaForm(MiaForm As Form) As Long
  Dim i As Long
  TrovaForm = -1
  If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If RidimensioneForm(i).Nome = MiaForm.Name Then
        TrovaForm = i
        Exit Function
      End If
    Next i
  End If
End Function
Private Function AggiungiForm(MiaForm As Form) As Long
  Dim FormOggetto As Control
  Dim i As Long
  ReDim Preserve RidimensioneForm(MaxForm + 1)
  RidimensioneForm(MaxForm).Nome = MiaForm.Name
  RidimensioneForm(MaxForm).Top = MiaForm.Top
  RidimensioneForm(MaxForm).Left = MiaForm.Left
  RidimensioneForm(MaxForm).Height = MiaForm.Height
  RidimensioneForm(MaxForm).Width = MiaForm.Width
  RidimensioneForm(MaxForm).ScaleHeight = MiaForm.ScaleHeight
  RidimensioneForm(MaxForm).ScaleWidth = MiaForm.ScaleWidth
  AggiungiForm = MaxForm
  MaxForm = MaxForm + 1
  For Each FormOggetto In MiaForm
    i = TrovaOggetto(FormOggetto, MiaForm.Name)
    If i < 0 Then i = AggiungiOggetto(FormOggetto, MiaForm.Name)
  Next FormOggetto
End Function
Private Function TrovaOggetto(Oggetto As Control, Nome As String) As Long
  Dim i As Long
  TrovaOggetto = -1
  For i = 0 To (MaxOggetto - 1)
    If RidimensioneOggetto(i).Parrent = Nome Then
      If RidimensioneOggetto(i).Nome = Oggetto.Name Then
        On Error Resume Next
        If RidimensioneOggetto(i).Index = Oggetto.Index Then
          TrovaOggetto = i
          Exit Function
        End If
        On Error GoTo 0
      End If
    End If
  Next i
End Function
Private Function AggiungiOggetto(Oggetto As Control, Nome As String) As Long
  ReDim Preserve RidimensioneOggetto(MaxOggetto + 1)
  On Error Resume Next
  RidimensioneOggetto(MaxOggetto).Nome = Oggetto.Name
  RidimensioneOggetto(MaxOggetto).Index = Oggetto.Index
  RidimensioneOggetto(MaxOggetto).Parrent = Nome
  If TypeOf Oggetto Is Line Then
    RidimensioneOggetto(MaxOggetto).Top = Oggetto.Y1
    RidimensioneOggetto(MaxOggetto).Left = PosizioneAttuale(Oggetto.X1)
    RidimensioneOggetto(MaxOggetto).Height = Oggetto.Y2
    RidimensioneOggetto(MaxOggetto).Width = PosizioneAttuale(Oggetto.X2)
  Else
    RidimensioneOggetto(MaxOggetto).Top = Oggetto.Top
    RidimensioneOggetto(MaxOggetto).Left = PosizioneAttuale(Oggetto.Left)
    RidimensioneOggetto(MaxOggetto).Height = Oggetto.Height
    RidimensioneOggetto(MaxOggetto).Width = Oggetto.Width
  End If
  Oggetto.Integra Height = False
  On Error GoTo 0
  AggiungiOggetto = MaxOggetto
  MaxOggetto = MaxOggetto + 1
End Function
Private Function Larghezza(MiaForm As Form) As Long
  Dim i As Long
  i = TrovaForm(MiaForm)
  If i < 0 Then i = AggiungiForm(MiaForm)
  Larghezza = (MiaForm.ScaleWidth * 100) \ RidimensioneForm(i).ScaleWidth
End Function
Private Function Altezza(MiaForm As Form) As Single
  Dim i As Long
  i = TrovaForm(MiaForm)
  If i < 0 Then i = AggiungiForm(MiaForm)
  Altezza = (MiaForm.ScaleHeight * 100) \ RidimensioneForm(i).ScaleHeight
End Function
Private Sub RidimensionaOggetto(Oggetto As Control, MiaForm As Form)
  On Error Resume Next
  Dim i As Long
  Dim FattoreMinimo As Single
  Dim y As Long: Dim x As Long: Dim Top As Long: Dim Left As Long: Dim Width
As Long: Dim Height As Long
  y = Altezza(MiaForm)
  x = Larghezza(MiaForm)
  i = TrovaOggetto(Oggetto, MiaForm.Name)
  If Oggetto.Left < 0 Then
    Left = CLng(((RidimensioneOggetto(i).Left * x) \ 100) - 75000)
  Else
    Left = CLng((RidimensioneOggetto(i).Left * x) \ 100)
  End If
  Top = CLng((RidimensioneOggetto(i).Top * y) \ 100)
  Width = CLng((RidimensioneOggetto(i).Width * x) \ 100)
  Height = CLng((RidimensioneOggetto(i).Height * y) \ 100)
  If TypeOf Oggetto Is Line Then
    If Oggetto.X1 < 0 Then
      Oggetto.X1 = CLng(((RidimensioneOggetto(i).Left * x) \ 100) - 75000)
    Else
      Oggetto.X1 = CLng((RidimensioneOggetto(i).Left * x) \ 100)
    End If
    Oggetto.Y1 = CLng((RidimensioneOggetto(i).Top * y) \ 100)
    If Oggetto.X2 < 0 Then
      Oggetto.X2 = CLng(((RidimensioneOggetto(i).Width * x) \ 100) - 75000)
    Else
      Oggetto.X2 = CLng((RidimensioneOggetto(i).Width * x) \ 100)
    End If
    Oggetto.Y2 = CLng((RidimensioneOggetto(i).Height * y) \ 100)
  Else
    Oggetto.Move Left, Top, Width, Height
    Oggetto.Move Left, Top, Width
    Oggetto.Move Left, Top
  End If
End Sub
Public Sub Ridimensiona(MiaForm As Form)
  Dim FormOggetto As Control
  Dim Visibile As Boolean
  Dim x, y, MaxX, MaxY As Long
  Dim Nuovo As Boolean
  If Not Azione Then
    Azione = True
    If TrovaForm(MiaForm) < 0 Then
      Nuovo = True
    Else
      Nuovo = False
    End If
    If MiaForm.Top < 30000 Then
      Visibile = MiaForm.Visible
      On Error Resume Next
      If Not MiaForm.MDIChild Then
        On Error GoTo 0
        'MiaForm.Visible = False
      Else
        If Nuovo Then
          y = MiaForm.Height
          x = MiaForm.Width
          On Error Resume Next
          For Each FormOggetto In MiaForm
            If FormOggetto.Left + FormOggetto.Width + 200 > MaxX Then _
              MaxX = FormOggetto.Left + FormOggetto.Width + 200
            If FormOggetto.Top + FormOggetto.Height + 500 > MaxY Then _
              MaxY = FormOggetto.Top + FormOggetto.Height + 500
            If FormOggetto.X1 + 200 > MaxX Then _
              MaxX = FormOggetto.X1 + 200
            If FormOggetto.Y1 + 500 > MaxY Then _
              MaxY = FormOggetto.Y1 + 500
            If FormOggetto.X2 + 200 > MaxX Then _
              MaxX = FormOggetto.X2 + 200
            If FormOggetto.Y2 + 500 > MaxY Then _
              MaxY = FormOggetto.Y2 + 500
          Next FormOggetto
          On Error GoTo 0
          MiaForm.Height = MaxY
          MiaForm.Width = MaxX
        End If
        On Error GoTo 0
      End If
      For Each FormOggetto In MiaForm
        RidimensionaOggetto FormOggetto, MiaForm
      Next FormOggetto
      On Error Resume Next
      If Not MiaForm.MDIChild Then
        On Error GoTo 0
        MiaForm.Visible = Visibile
      Else
        If Nuovo Then
          MiaForm.Height = y
          MiaForm.Width = x
          For Each FormOggetto In MiaForm
            RidimensionaOggetto FormOggetto, MiaForm
          Next FormOggetto
        End If
      End If
      On Error GoTo 0
    End If
    Azione = False
  End If
End Sub
Public Sub SalvaPosizioneForm(MiaForm As Form)
  Dim i As Long
  If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If RidimensioneForm(i).Name = MiaForm.Name Then
        RidimensioneForm(i).Top = MiaForm.Top
        RidimensioneForm(i).Left = MiaForm.Left
        RidimensioneForm(i).Height = MiaForm.Height
        RidimensioneForm(i).Width = MiaForm.Width
        Exit Sub
      End If
    Next i
    AggiungiForm (MiaForm)
  End If
End Sub
Public Sub RipristinaForm(MiaForm As Form)
  Dim i As Long
  If MaxForm > 0 Then
    For i = 0 To (MaxForm - 1)
      If RidimensioneForm(i).Name = MiaForm.Name Then
        If RidimensioneForm(i).Top < 0 Then
          MiaForm.WindowState = 2
        ElseIf RidimensioneForm(i).Top < 30000 Then
          MiaForm.WindowState = 0
          MiaForm.Move RidimensioneForm(i).Left, RidimensioneForm(i).Top,
RidimensioneForm(i).Width, RidimensioneForm(i).Height
        Else
          MiaForm.WindowState = 1
        End If
        Exit Sub
      End If
    Next i
  End If
End Sub
(Form1)
Nell' evento Resize del vostro form :
 Ridimensiona Me
By Utente Win2k

Ho risolto cosi':
Nel programma metto questo codice
____________________________________
Option Explicit
  Private Resizer As clsResize
Private Sub Form_Load()
  Set Resizer = New clsResize
  Resizer.SourceForm = Me
  Resizer.SizeFormToScreen 75
End Sub
Private Sub Form_Resize()
  Resizer.ResizeControls
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Set Resizer = Nothing
End Sub
_________________________________________________
Poi creo un modulo di classe chiamato clsResize con il seguente codice:
Option Explicit
Private Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock
As Long) As Long
Private Type ControlPosition
  Control As Control                                 'Reference to the
control instance.
  OriginalLeft As Long                               'Original Left position
of the Control.
  OriginalTop As Long                                'Original Top position
of the Control.
  OriginalWidth As Long                              'Original Width of the
Control.
  OriginalHeight As Long                             'Original Height of the
Control.
End Type
Private m_SourceForm As Form                         'The form to be
resized.
Private m_FormWidth As Long                          'Original form width.
Private m_FormHeight As Long                         'Original form height.
Private m_Controls() As ControlPosition              'Array for storing
control information.
Private m_IsFirstResize As Boolean                   'Flag indicating first
resize.
Private Sub Class_Initialize()
  Set m_SourceForm = Nothing
  m_IsFirstResize = True
  m_FormWidth = 0
  m_FormHeight = 0
End Sub
Private Sub Class_Terminate()
  Erase m_Controls
  Set m_SourceForm = Nothing
End Sub
Public Property Get SourceForm() As Form
  Set SourceForm = m_SourceForm
End Property
Public Property Let SourceForm(New_SourceForm As Form)
  Set m_SourceForm = New_SourceForm
End Property
Private Sub SaveInitialStates()
  'Variable Declarations.
  Dim i As Integer
  'Use the form that is being resized.
  With m_SourceForm
    'Check if the form being resized is an MDI form.
    If (TypeOf m_SourceForm Is MDIForm) Then
      'Set the FormWidth and FormHeight variables to the Form's Width and
Height.
      m_FormWidth = .Width
      m_FormHeight = .Height
    Else
      'Set the FormWidth and FormHeight variables to the Form's Scale Width
and Height.
      m_FormWidth = .ScaleWidth
      m_FormHeight = .ScaleHeight
    End If
  End With
  'Frees the memory used by the dynamic array storing all control
information.
  Erase m_Controls
  'Redimension the array storing all control information to the number of
controls on the
  'form that is being resized.
  ReDim m_Controls(0 To m_SourceForm.Controls.Count - 1)
  'Iterate through each of the Controls on the form to be resized.
  For i = 0 To m_SourceForm.Controls.Count - 1
    'Use the control that is currently being referenced.
    With m_SourceForm.Controls(i)
      'Add the controls reference to the array containing all control
information.
      Set m_Controls(i).Control = m_SourceForm.Controls(i)
      'Check if the control currently being referenced is a line control.
      If (TypeOf m_SourceForm.Controls(i) Is Line) Then
        'Add a reference to the control's position into the array containing
all control
        'information.
        m_Controls(i).OriginalLeft = .X1
        m_Controls(i).OriginalTop = .Y1
        m_Controls(i).OriginalWidth = .X2
        m_Controls(i).OriginalHeight = .Y2
      Else
        'Add a reference to the control's position into the array containing
all control
        'information.
        On Error Resume Next
          m_Controls(i).OriginalLeft = .Left
          m_Controls(i).OriginalTop = .Top
          m_Controls(i).OriginalWidth = .Width
          m_Controls(i).OriginalHeight = .Height
        On Error GoTo 0
      End If
    End With
  Next
  'Notify the class that the form has been resized.
  m_IsFirstResize = False
End Sub
'
============================================================================
============ '
' Routine     : ReInitialise
Created : 01/05/1999 '
' Scope       : Public                                                Author
: A D Moss   '
' Description : Store the dimensions and positions of all controls on a
Form.              '
'
============================================================================
============ '
Public Sub ReInitialise()
  Call SaveInitialStates
End Sub
'
============================================================================
============ '
' Routine     : SizeFormToScreen
Created : 01/05/1999 '
' Scope       : Public                                                Author
: A D Moss   '
' Description : Size the Form to n Percent of the Screen.
'
'
============================================================================
============ '
Public Sub SizeFormToScreen(Optional Percent As Byte = 100)
  'Variable Declarations.
  Dim FormHeight As Long, FormWidth As Long
  'Check if the form has been resized before.
  If m_IsFirstResize Then
    Call SaveInitialStates
  End If
  'Calculate the new height and width the form needs to be resized to, based
on the current
  'screen resolution.
  FormHeight = Int(Screen.Height * (Percent / 100))
  FormWidth = Int(Screen.Width * (Percent / 100))
  'Use the Form that is to be resized.
  With m_SourceForm
    'Change the demensions and position of the form.
    .Top = (Screen.Height - FormHeight) / 2
    .Left = (Screen.Width - FormWidth) / 2
    .Height = FormHeight
    .Width = FormWidth
  End With
  'Resize all of the controls on the form.
  Call ResizeControls
End Sub
'
============================================================================
============ '
' Routine     : ResizeControls
Created : 01/05/1999 '
' Scope       : Public                                                Author
: A D Moss   '
' Description : Resize all of the Controls on a Form.
'
'
============================================================================
============ '
Public Sub ResizeControls()
  'Variable Declarations.
  Dim HeightChange As Double, WidthChange As Double
  Dim Control As Control, i As Integer
  Dim IsLineControl As Boolean, ResizeFlags As String
  'Check if the form has any controls on it.
  If m_SourceForm.Controls.Count = 0 Then Exit Sub
  'Check if the form is being minimized.
  If m_SourceForm.WindowState = vbMinimized Then Exit Sub
  'Check if it's the first time the form is to be resized.
  If m_IsFirstResize Then
    Call SaveInitialStates
    Exit Sub
  End If
  'Prevent the Window from redrawing until the user releases the mouse.
  Call LockWindowUpdate(m_SourceForm.hWnd)
  'Calculate the change in the form's size.
  HeightChange = m_SourceForm.ScaleHeight / m_FormHeight
  WidthChange = m_SourceForm.ScaleWidth / m_FormWidth
  'Iterate through the form's controls.
  For i = 0 To UBound(m_Controls)
    Set Control = m_Controls(i).Control
    'Use the Control that is currently being referenced in the array
containing all control
    'information.
    With Control
      'Check if the Control that is currently being referenced is a line
control.
      If TypeOf Control Is Line Then
        IsLineControl = True
      Else
        IsLineControl = False
      End If
      On Error GoTo Err_Resize
        'Retrieve the dimensions a control is to be resized in.
        ResizeFlags = UCase(.Tag)
        'If none are specified, assume all.
        If ResizeFlags = "" Then ResizeFlags = "@L,T,W,H"
        'If the Tag property is used for something else, assume all.
        If Left(ResizeFlags, 1) <> "@" Then ResizeFlags = "@L,T,W,H"
         'Resize / Reposition the control.
         If IsLineControl Then
           'Line control.
           If (InStr(ResizeFlags, "L")) Then .X1 =
(m_Controls(i).OriginalLeft * WidthChange)
           If (InStr(ResizeFlags, "T")) Then .Y1 =
(m_Controls(i).OriginalTop * HeightChange)
           If (InStr(ResizeFlags, "W")) Then .X2 =
(m_Controls(i).OriginalWidth * WidthChange)
           If (InStr(ResizeFlags, "H")) Then .Y2 =
(m_Controls(i).OriginalHeight * HeightChange)
         Else
           'All other controls.
           If (InStr(ResizeFlags, "L")) Then .Left =
(m_Controls(i).OriginalLeft * WidthChange)
           If (InStr(ResizeFlags, "T")) Then .Top =
(m_Controls(i).OriginalTop * HeightChange)
           If (InStr(ResizeFlags, "W")) Then .Width =
(m_Controls(i).OriginalWidth * WidthChange)
           If (InStr(ResizeFlags, "H")) Then .Height =
(m_Controls(i).OriginalHeight * HeightChange)
         End If
      On Error GoTo 0
    End With
SkipControl:
  Next i
  'Release the memory being used by the Control variable.
  Set Control = Nothing
  'Allow Windows to refresh the form's display.
  Call LockWindowUpdate(0)
  Exit Sub
Err_Resize:
  'If the Left, Top, Height or Width property are Read-Only, skip to next
property.
  'Otherwise, skip the control entirely.
  If Err.Number = 383 Or Err.Number = 387 Or Err.Number = 393 Or Err.Number
= 438 Then
    Resume Next
  End If
  Resume SkipControl
End Sub

 problema......
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG