VB 5/6-Tipp 0486: Steuerelemente auf Formular der Formgröße anpassen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (mscomctl.ocx)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Toolbar "Toolbar1"
' Steuerelement: Bilderlistenelement "ImageList1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit
Dim cResize As New FormResize

Private Sub Form_Load()
     cResize.Form = Me
End Sub

Private Sub Form_Resize()
     cResize.Resize
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'----- Anfang Klasse "FormResize" alias FormResize.cls  -----

Option Explicit

Private Type Rect
     WidthP As Single
     HeigthP As Single
     TopP As Single
     LeftP As Single
End Type

Private Type ControlInfo
     Cont As Control
     measures As Rect
End Type

Dim fForm As Form
Dim AllControls() As ControlInfo

Public Property Let Form(F As Form)
     Set fForm = F
     Call GetAllPositions
End Property

Public Property Get Form() As Form
     Set Form = fForm
End Property

Public Sub Resize()
     Dim SW As Single
     Dim SH As Single
     SW = Me.Form.ScaleWidth
     SH = Me.Form.ScaleHeight
     
     Dim i As Integer
     For i = 0 To UBound(AllControls)
          With AllControls(i)
               .Cont.Left = (SW * .measures.LeftP) / 100
               .Cont.Top = (SH * .measures.TopP) / 100
               .Cont.Width = (SW * .measures.WidthP) / 100
               .Cont.Height = (SH * .measures.HeigthP) / 100
          End With
     Next i
End Sub

Private Sub GetAllPositions()
    Dim c As Control
    For Each c In Me.Form.Controls
        If Not (TypeOf c Is Toolbar Or TypeOf c Is ImageList) Then
            Call AddControl(c, c.Left, c.Top, c.Width, c.Height)
        End If
    Next c
End Sub

Private Sub AddControl(ByRef Cont As Control, ByVal X As Single, _
    ByVal Y As Single, ByVal W As Single, ByVal H As Single)
    
     Dim pos As Integer
     On Error Resume Next
     pos = UBound(AllControls) + 1
     If Err Then pos = 0
     On Error Goto 0
     
     ReDim Preserve AllControls(pos)
     
     Dim SW As Single
     Dim SH As Single
     SW = Me.Form.ScaleWidth
     SH = Me.Form.ScaleHeight
     
     With AllControls(pos)
          Set .Cont = Cont
          With .measures
               .LeftP = (X * 100) / SW
               .TopP = (Y * 100) / SH
               .WidthP = (W * 100) / SW
               .HeigthP = (H * 100) / SH
          End With
     End With
End Sub
'------ Ende Klasse "FormResize" alias FormResize.cls  ------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Lesombra am 13.02.2009 um 10:33

Der Laufzeitfehler 9 kann noch besser umgangen werden mit folgendem Code:

Public Property Let Form(F As Form)
     Set fForm = F
     ReDim AllControls(fForm.Controls.Count)
     Call GetAllPositions
End Property

Damit wird dann das Array gleich mit der richtigen Anzahl von Elementen gefüllt.

Kommentar von Tom137 am 27.08.2008 um 22:28

"Von Küde am 18.04.2008 um 17:44
bei pos = UBound(AllControls) + 1 wird immer Laufzeitfehler 9 aufgerufen.Index ausserhalb des gültigen Bereichs. Warum?"

AllControls wurde als dynamisches Datenfeld deklariert aber nicht dimensioniert, ich habe bei Property Let als erste Zeile ReDim AllControls(0) eingefügt. Dann erscheint der Laufzeitfehler 9 nicht mehr.

seltsam alle loben die Classe (sie ist ja auch gut) aber keiner kann (will) eine Auskunft über den Fehler geben.

mfg
Thomas

Kommentar von Raimund Wille am 11.07.2008 um 17:06

Public Property Let Form(F As Form)
     Set fForm = F
     Call GetAllPositions
End Property

Public Property Get Form() As Form
     Set Form = fForm
End Property

für zu einer Fehlermeldung bei der Compilierung.
Die Definitione "as Form" müssen ersetzt werden durch "as Object", dann lässt sich der Code als Klasssenmodul übersetzen und ist funktionsfähig.

Kommentar von Schulz Horst Dieter am 11.06.2008 um 07:29

Noch ein kleiner Hinweis...

In der Get all positions fehlen noch ein paar Controls die nicht mitspielen wollen... hier meine Lösung für mein Problem -->

Private Sub GetAllPositions()
Dim c As Control
For Each c In Me.Form.Controls
If Not (TypeOf c Is ToolBar Or TypeOf c Is ImageList Or TypeOf c Is CommonDialog Or TypeOf c Is Menu) Then
Call AddControl(c, c.Left, c.Top, c.Width, c.Height)
End If
Next c
End Sub

LG
HD

Kommentar von Küde am 18.04.2008 um 17:44

bei pos = UBound(AllControls) + 1 wird immer Laufzeitfehler 9 aufgerufen.Index ausserhalb des gültigen Bereichs. Warum?
Dies wurde schon 19.11.2004 von Dorp angefragt, aber keine Antwort erhalten.

Für eine Antwort danke ich euch im voraus
Küde

Kommentar von Roland am 10.03.2008 um 02:19

Hallo,

erst mal Lob für Klasse. Mir als Anfänger in VB ist das eine Riesenhilfe. Ich habe jedoch ein Problem. Wenn ich ein Formular öffne schreibe ich die gewünschte (beim letzten Schließen gespeicherte) Positions und Größe in die entsprechenden Eigenschaften des Formulars. Das funktioniert prroblemlos. Schließe ich das Formular (mit Unload) und öffne es mit Load erneut so gibt es meistens (nicht immer) eine Fehlermeldung des "340" Element "X" existiert nicht.

Hat da irgendwer eine Idee? Muss ich vielleicht beim unloaden des Forms etwas besonderes beachten?

MfG

Roland

Kommentar von James am 13.01.2008 um 16:58

Guten Tag,

das ist echt klasse. Vielen Dank.

Benutze den Code in Access. Leider komme ich nicht weiter bei "Unterformularen" wenn die über die SourceObject Änderung ein anderes Formular angezeigt werden soll.

Gibt es da irgendeinen Trick wie das neue Formular gleich vergrößert geladen werden kann?

Danke.

Kommentar von Dirk Nestl am 02.05.2007 um 23:02

Noch ein Tipp, wenn's nicht funktioniert:
Ist zwar ziemlich unprofessionell, aber wenn man in
'Resize' und 'GetAllPositions' einfach je ein 'On Error Resume Next' eingibt, werden alle Elemente, bei denen Fehler auftreten, einfach übersprungen...

Kommentar von Thorsten Hilgendorf am 06.07.2006 um 00:25

Help! Kann mir einer sagen warum dies mit dynamisch erstellten Controls nicht funktioniert. Verzweifel :(

{
Load Frame1(1)
Frame1(1).Visible = True
}

Kommentar von Gerd Kuhlmann am 28.10.2005 um 10:04

Das Klassenmodul funktioniert wirklich gut. Damit keine unnötigen Fehler entstehen müssten aber auch die folgenden Controls ausgenommen werden: Timer, CommonDialog, DriveListBox und Line.
Im Zusammenhang mit dem Control SSTAB funktioniert das Ganze allerdings nicht mit den auf den Tabs platzierten Controls! Es wäre schön, wenn auch das klappen würde.
Ansonsten vielen Dank für dieses sinnvolle Klassenmodul. Es erspart einem wirklich eine Menge Programmieraufwand.

Kommentar von Marco Menzel am 02.03.2005 um 17:07

@Joe:
Schau Dir mal den Tipp von Wolfang vom 09.08.2004 an. Das müsste schon die Lösung für Dein Problem sein. Menüs haben keine Position: also weder .Left, .Top, noch .Width oder .Height. Da das aber alles Properties sind, die von der Klasse angesprochen werden...

So long,
/\\arco

Kommentar von Joe am 26.02.2005 um 15:42

Hi all,

erstmal danke für den von euch zur Verfügung gestellten Code.
Ich habe ihn bei mir in mein Program eingebunden und er hat super funktioniert bis....

...bis ich ein Menü Feld über den Menü Editor hinzufügte. Beim Ausführen des Programms erscheint dann die folgende Fehlermeldung:

Laufzeitfehler 438 Objekt unterstützt diese Eigenschaft oder Methode nicht..

Ist wirklich schade..

Gibt es hierzu inzwischen schon eine Lösung?

Wäre sehr dankbar..

Grüße von Joe

Kommentar von René am 21.01.2005 um 14:18

Schade das es mit dem sstab nicht geht, ansonsten eine sehr gute klasse!

Hoffe jemand kann dies noch lösen
René

Kommentar von vom Dorp am 19.11.2004 um 14:44

Warum kommt die Fehlermeldung:
Index außerhalb des gültigen Bereiches, wenn ich das Besipielprojekt ausprobieren will?
In der Zeile :
pos = UBound(AllControls)+1

Kommentar von Wolfgang Uhr am 09.08.2004 um 12:12

Die Klasse ist prima ...
Die Zahl der nicht veränderbaren Controls ist doch etwas größer. Ich schlage vor:

If Not (TypeOf c Is Toolbar Or TypeOf c Is ImageList Or _
TypeOf c Is Timer Or TypeOf c Is ScriptControl _
Or TypeOf c Is Menu) Then

Gruß
Wolfgang

Kommentar von Marco Menzel am 25.09.2003 um 14:43

Die Idee ist gut, funzt vielleicht auch fuer einfache Forms, aber bei komplexen Forms mit mehreren SSTabs drauf, erscheint nach dem Resize auf den Tabs 2ff immer der Inhalt des ersten Tabs.

Das liegt daran, dass der SSTab die Tab-Funktionalität durch Verschieben der Controls in einen nicht sichtbaren Bereich erreicht.

Schade, schade

Wenn ich eine Lösung dazu habe, poste ich das mal hier.

Gruesse aus Andernach,
/\\arco

Kommentar von Konrad Rudolph am 28.10.2002 um 11:51

Wow, ein echtes Lob!
Die Klasse ist eine echt gute Idee und mit der Ergänzung von Jost und einem gesubclassten Resize-Event echt unschlagbar!
Auf die Idee wäre ich nie gekommen, ich resize immer alles umständlich 'per Hand'.

Nur eines fehlt dann noch: wenn z.B. ein Control unabhängig von der Auflösung 10px vom linken Rand sitzen soll gib's hier Probleme. Läßt sich aber recht einfach erledigen.

Kommentar von marco am 17.06.2002 um 16:15

Funktioniert einwandfrei.
Klasse!

Kommentar von Jost Schwider am 30.04.2002 um 07:54

In GetAllPositions sollte man ein
On Error Resume Next
verwenden, um Controls ohne Left/Top/Height/Width-Eigenschaften zumindest zu ignorieren.
Ähnliches gilt für die Resize-Methode, da z.B. ComboBox.Height nicht gesetzt werden kann.