Newsgroup: it.comp.lang.visual-basic
Titolo: Ridimensionamento Form & Oggetti

Volevo Dedicarla a chi ne avesse bisogno
Un pò lunghina ma funziona........... ( Ev. createvi una classe da
trasformare poi in Dll )
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
Spero vi sia Utile
By Utente Win2k


[cut]
non l'ho testata, ma... che ne dici di postarla al Sc...
ciao
ugo