Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0591: Anwendung mit verschiebbaren Frames, wie eine Website

 von 

Beschreibung 

Der Internet-Explorer bietet die Möglichkeit, sogenannte "Frames" anzuzeigen. Diese könnte man als verschiebbare MDI Childs ohne Border bezeichnen. Dieser Tipp zeigt, wie sich sowas auch mit VB-Anwendungen realisieren lässt.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [6,16 KB]

'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 MDI_Frames.vbp ------------
'------- Anfang Formular "Uebersicht" alias Form1.frm -------
'-------- Ende Formular "Uebersicht" alias Form1.frm --------
'-------- Anfang Formular "Vorschau" alias Form2.frm --------
' Steuerelement: Textfeld "Text1"
Private Sub Form_Resize()
    'Steuerelement neu positionieren
    
    With Text1
          .Top = 0
          .Left = 0
          .Width = Me.ScaleWidth
          .Height = Me.ScaleHeight
    End With
End Sub
'--------- Ende Formular "Vorschau" alias Form2.frm ---------
'--------- Anfang Formular "Haupt" alias Haupt.frm  ---------
'
' Copyright © 2003 by Hans H. Klein (hexerei@handshake.de)

Option Explicit

Private Sub MDIForm_Load()
    Me.WindowState = vbMaximized
End Sub

Private Sub MDIForm_Resize()
    'Anmerkung von Jochen Wierum (JoWi@ActiveVB.de):
    'Die Größenänderung des Formulars setzt die Proportionen
    'der Frames wieder zurück. Idealerweise müssten die width
    'und height Werte vorher gespeichert und im Anschluss
    'umgerechnet und neu gesetzt werden.
    
    With Uebersicht
          'Startposition oberes rechts Fenster festlegen
          'alle anderen Fenster wereen daran ausgerichtet
          .Width = Haupt.ScaleWidth / 3 * 2
          .Height = Haupt.ScaleHeight / 2
          .Top = 0
          .Left = Me.ScaleWidth - .Width
          .Show
    End With
    
    With Horizontal1
          .Left = Uebersicht.Left
          .Width = Uebersicht.Width
          .Height = 100
          .Top = Uebersicht.Top + Uebersicht.Height
          .MousePointer = vbSizeNS
          .Show
    End With
    
    With Vorschau
          .Left = Uebersicht.Left
          .Width = Uebersicht.Width
          .Top = Horizontal1.Top + Horizontal1.Height
          .Height = Haupt.ScaleHeight - .Top
          .Show
    End With
    
    With Vertical1
          .Top = 0
          .Height = Haupt.ScaleHeight
          .Width = 100
          .Left = Uebersicht.Left - 100
          .MousePointer = vbSizeWE
          .Show
    End With
    
    With Menue
          .Top = 0
          .Left = 0
          .Width = Vertical1.Left
          .Height = Haupt.ScaleHeight
          .Show
    End With
End Sub
'---------- Ende Formular "Haupt" alias Haupt.frm  ----------
'------ Anfang Formular "Horizontal1" alias Form3.frm  ------
Option Explicit

Dim HDragNDrop As Boolean
Dim OriginalY As Single

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Begin Drag& Drop
    HDragNDrop = True
    
    'aktuelle Y-Position  merken
    OriginalY = Y
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim NewTop As Long
    Static Scrollauf As Boolean
    
    If HDragNDrop Then
        If Y <> OriginalY Then
            If Not Scrollauf Then
                Scrollauf = True
                
                'neue Y-Position berechnen
                If Y > OriginalY Then
                    NewTop = Me.Top + (Y - OriginalY)
                    If NewTop < Haupt.ScaleHeight - Me.Height Then Me.Top = NewTop
                Else
                    NewTop = Me.Top - Abs(Y)
                    If NewTop > 0 Then Me.Top = NewTop
                End If
                
                'betroffene Formen korrigieren
                Uebersicht.Height = Me.Top
                Vorschau.Top = Me.Top + Me.Height
                Vorschau.Height = Haupt.ScaleHeight - Vorschau.Top
                DoEvents
                Scrollauf = False
            End If
        End If
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Drag&Drop Ende
    HDragNDrop = False
End Sub
'------- Ende Formular "Horizontal1" alias Form3.frm  -------
'------- Anfang Formular "Vertical1" alias Form4.frm  -------
Option Explicit

Dim VDragNDrop As Boolean
Dim OriginalX As Single

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   'Begin Drag&Drop
   VDragNDrop = True
   
   'derzeitige X-Position merken
   OriginalX = X
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim NewLeft As Long
   Static Scrollauf As Boolean
   
   If VDragNDrop Then
      If X <> OriginalX Then
         If Not Scrollauf Then
            Scrollauf = True
            
            'Neue X-Position berechnen
            If X > OriginalX Then
               NewLeft = Me.Left + (X - OriginalX)
               If NewLeft > Haupt.ScaleWidth - 100 Then Me.Left = Haupt.ScaleWidth - 100
            Else
               NewLeft = Me.Left - Abs(X)
               If NewLeft < 0 Then NewLeft = 0
            End If
            
            'alle verbundenen Formen anpassen
            Me.Left = NewLeft
            Menue.Width = Me.Left
            Uebersicht.Left = Me.Left + Me.Width
            Uebersicht.Width = Haupt.ScaleWidth - Uebersicht.Left
            Horizontal1.Left = Uebersicht.Left
            Horizontal1.Width = Uebersicht.Width
            Vorschau.Left = Uebersicht.Left
            Vorschau.Width = Uebersicht.Width
            DoEvents
            Scrollauf = False
         End If
      End If
   End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   'Ende Drag & Drop
   VDragNDrop = False
End Sub


'-------- Ende Formular "Vertical1" alias Form4.frm  --------
'--------- Anfang Formular "Menue" alias Form5.frm  ---------
'---------- Ende Formular "Menue" alias Form5.frm  ----------
'------------- Ende Projektdatei MDI_Frames.vbp -------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Stefan am 16.08.2005 um 12:49

Leider gibt es zwei Fehler in diesem Code, die zum Absturz führen:
1.: Beim Minimieren
2.: Beim verschieben des vertikalen Balkens über das Fensterende hinaus

zu 1.:
in Haupt:

With Vertical1
.Top = 0
.Height = Haupt.ScaleHeight
'----- Anstatt .width = 100 --------------
If Haupt.WindowState = 1 Then
.Width = 0
Else
.Width = 100
End If
'-----------------------------------------
.Left = Uebersicht.Left - .Width
.MousePointer = vbSizeWE
.Show
End With

With Horizontal1
.Left = Uebersicht.Left
.Width = Uebersicht.Width
'----- Anstatt .Height = 100 -------------
If Haupt.WindowState = 1 Then
.Height = 0
Else
.Height = 100
End If
'-----------------------------------------
.Top = Uebersicht.Top + Uebersicht.Height
.MousePointer = vbSizeNS
.Show
End With


zu 2.:
in Vertical 1:

'--- Anstatt Uebersicht.Width = Haupt.ScaleWidth - Uebersicht.Left ---
If (Uebersicht.Left > Haupt.ScaleWidth) Then
Uebersicht.Width = Uebersicht.Left
Else
Uebersicht.Width = Haupt.ScaleWidth - Uebersicht.Left
End If
'-------------------------------------------------

Kommentar von Timo am 16.02.2005 um 10:45

Ich habs ähnlich umgesetzt. Ich berechne das Verhältnis. Somit bleibt die Ansicht immer gleich. Ausserdem find ichs etwas schneller.

Private DragAktiv As Boolean
Private DragY As Single


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
DragAktiv = True
DragY = X
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And DragAktiv = True And Y <> DragY Then
Dim Verh As Byte
Dim NewTop As Long

NewTop = frmH.Top + Y
Debug.Print "NewTop: " & NewTop

If NewTop < 0 Then NewTop = 0
If NewTop > MDIMain.ScaleHeight Then NewTop = MDIMain.ScaleHeight
Verh = NewTop / MDIMain.ScaleHeight * 100
If Verh < 1 Then Verh = 1
If Verh > 99 Then Verh = 99
frmH.Tag = Verh
MDIMain.OrdneFenster
Debug.Print "Verh: " & Verh
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then DragAktiv = False
End Sub



Public Sub OrdneFenster()

frmH.Left = 0
frmH.Width = MDIMain.ScaleWidth
frmH.Height = 100
frmH.Top = (MDIMain.ScaleHeight - frmH.Height) / 100 * Val(frmH.Tag)

frmVideo.Left = frmH.Left
frmVideo.Width = frmH.Width
frmVideo.Top = 0
frmVideo.Height = frmH.Top

frmPicture.Left = frmH.Left
frmPicture.Width = frmH.Width
frmPicture.Top = frmH.Top + frmH.Height
frmPicture.Height = MDIMain.ScaleHeight - frmPicture.Top
End Sub

Kommentar von am 08.07.2003 um 15:58

klasse