Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0317: Steuerelemente markieren, beliebig dehnen und verschieben

VB 5/6-Tipp 0317: Steuerelemente markieren, beliebig dehnen und verschieben

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetWindowPlacement, SetWindowPlacement

Download: Download des Beispielprojektes [4,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 PROJECT1.VBP -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1" (Index von 0 bis 7)
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Declare Function GetWindowPlacement Lib "user32" _
        (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As _
        Long

Private Declare Function SetWindowPlacement Lib _
        "user32" (ByVal hwnd As Long, lpwndpl _
        As WINDOWPLACEMENT) As Long

Private Type POINTAPI
  x As Long
  Y As Long
End Type

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type WINDOWPLACEMENT
  Length As Long
  flags As Long
  showCmd As Long
  ptMinPosition As POINTAPI
  ptMaxPosition As POINTAPI
  rcNormalPosition As RECT
End Type



'Konfiguration
'------------------------------------------------
'Abstand der Markierungskästchen vom Control
Const Sp = 1&

'Minimale & Maximale Abmaße des Controls
Const Wmin = 6&
Const Wmax = 350&
Const Hmin = 19&
Const Hmax = 250&

'Eckerkoordinaten des erlaubten Bewegungsraumes
Const LimX1 = 10&
Const LimY1 = 10&
Const LimX2 = 500&
Const LimY2 = 300&
'------------------------------------------------

Dim DragFlag As Boolean, MoveFlag As Boolean
Dim Fetched As Boolean
Dim StartX&, Starty&
Dim MCtrl As Control

Private Sub Form_Load()
  Dim TPX&, TPY&
  
    'Begrenzungsrahmen zeichnen
    Me.AutoRedraw = True
    TPX = Screen.TwipsPerPixelX
    TPY = Screen.TwipsPerPixelY
    Me.Line (LimX1 * TPX, LimY1 * TPY)-(LimX2 * TPX, LimY2 _
                                        * TPY), 0, B
    Me.AutoRedraw = False
End Sub

Private Sub Form_Click()
  Dim x%
    
    For x = 0 To 7
      Picture1(x).Visible = False
    Next x
    If Fetched Then
      MCtrl.MousePointer = vbDefault
      Fetched = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Unload Me
End Sub

Private Sub Text1_Click()
  Set MCtrl = Text1
  Text1.MousePointer = vbSizeAll
  Call DrawPics
  Fetched = True
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, _
                            x As Single, Y As Single)
  MoveFlag = True
  StartX = x
  Starty = Y
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, _
                          x As Single, Y As Single)
  MoveFlag = False
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, _
                            x As Single, Y As Single)
  Dim xD&, yD&, TPX&, TPY&
  Static Doing As Boolean
  
    If Doing Or Not Fetched Then Exit Sub
    
    Doing = True
    If MoveFlag Then
      TPX = Screen.TwipsPerPixelX
      TPY = Screen.TwipsPerPixelY
      
      xD = Text1.Left + (x - StartX)
      If xD + Text1.Width > LimX2 * TPX Then
        xD = LimX2 * TPX - Text1.Width
      ElseIf xD < LimX1 * TPX Then
        xD = LimX1 * TPX
      End If
      
      yD = Text1.Top + (Y - Starty)
      If yD + Text1.Height > LimY2 * TPY Then
        yD = LimY2 * TPY - Text1.Height
      ElseIf yD < LimY1 * TPY Then
        yD = LimY1 * TPY
      End If
      
      Text1.Left = xD
      Text1.Top = yD
      Call DrawPics
    End If
    Doing = False
End Sub

Private Sub Picture1_MouseDown(Index As Integer, Button As _
                               Integer, Shift As Integer, x _
                               As Single, Y As Single)
  DragFlag = True
End Sub

Private Sub Picture1_MouseUp(Index As Integer, Button As _
                             Integer, Shift As Integer, x _
                             As Single, Y As Single)
  DragFlag = False
End Sub

Private Sub Picture1_MouseMove(Index As Integer, Button As _
                               Integer, Shift As Integer, x _
                               As Single, Y As Single)
                               
  Dim xP&, yP&, x1&, x2&, y1&, y2&, WPM As WINDOWPLACEMENT
  Dim TPX%, TPY&, XNoSize As Boolean, YNoSize As Boolean
  Static MemX1&, MemX2&, MemY1&, Memy2&
  Static Doing As Boolean
    
    If Doing Then Exit Sub
    Doing = True
     
    If DragFlag Then
      TPX = Screen.TwipsPerPixelX
      TPY = Screen.TwipsPerPixelY
      xP = x / TPX
      yP = Y / TPY
      
      WPM.Length = Len(WPM)
      Call GetWindowPlacement(MCtrl.hwnd, WPM)
      x1 = WPM.rcNormalPosition.Left
      x2 = WPM.rcNormalPosition.Right
      y1 = WPM.rcNormalPosition.Top
      y2 = WPM.rcNormalPosition.Bottom
    
      With Picture1(Index)
            
        If Index = 0 Or Index = 1 Or Index = 2 Then
          If x1 + xP > x2 - Wmin Then
            XNoSize = True
            x1 = x2 - Wmin
          ElseIf x2 - (x1 + xP) > Wmax Then
            XNoSize = True
            x1 = x2 - Wmax
          Else
            x1 = x1 + xP
          End If
          If x1 <= LimX1 Then
            XNoSize = True
            x1 = LimX1
          End If
        End If
        
        If Index = 4 Or Index = 5 Or Index = 3 Then
          If x2 + xP < x1 + Wmin Then
            XNoSize = True
            x2 = x1 + Wmin
          ElseIf x2 + xP - x1 > Wmax Then
            XNoSize = True
            x2 = x1 + Wmax
          Else
            x2 = x2 + xP
          End If
          
          If x2 > LimX2 Then
            XNoSize = True
            x2 = LimX2
          End If
        End If
        
        If Index = 0 Or Index = 6 Or Index = 3 Then
          If y1 + yP > y2 - Hmin Then
            YNoSize = True
            y1 = y2 - Hmin
          ElseIf y2 - (y1 + yP) > Hmax Then
            YNoSize = True
            y1 = y2 - Hmax
          Else
            y1 = y1 + yP
          End If
          
          If y1 <= LimY1 Then
            YNoSize = True
            y1 = LimY1
          End If
        End If
         
        If Index = 7 Or Index = 2 Or Index = 5 Then
          If y2 + yP < y1 + Hmin Then
            YNoSize = True
            y2 = y1 + Hmin
          ElseIf y2 + yP - y1 > Hmax Then
            YNoSize = True
            y2 = y1 + Hmax
          Else
            y2 = y2 + yP
          End If
          
          If y2 > LimY2 Then
            YNoSize = True
            y2 = LimY2
          End If
        End If
    
      Select Case Index
        Case 0, 2, 3, 5: Y = Y + .Top
                         x = x + .Left
                        
        Case 1, 4:       x = x + .Left
                         Y = .Top
               
        Case 6, 7:       Y = Y + .Top
                         x = .Left
      End Select
      
      If Not YNoSize Then .Top = Y
      If Not XNoSize Then .Left = x
    End With

    If MemX1 <> x1 Or MemX2 <> x2 Or MemY1 <> y1 _
                   Or Memy2 <> y2 Then
      If TypeOf MCtrl Is ListBox Or TypeOf MCtrl Is ComboBox Then
        '...
      Else
        WPM.rcNormalPosition.Left = x1
        WPM.rcNormalPosition.Top = y1
        WPM.rcNormalPosition.Right = x2
        WPM.rcNormalPosition.Bottom = y2
        Call SetWindowPlacement(MCtrl.hwnd, WPM)
        Call DrawPics
      End If
    End If
    
    MemX1 = x1
    MemX2 = x2
    MemY1 = y1
    Memy2 = y2
  End If
  
  Doing = False
End Sub

Private Sub DrawPics()
  Dim TPX%, TPY&, x%
     
     TPX = Screen.TwipsPerPixelX
     TPY = Screen.TwipsPerPixelY
     
     With MCtrl
       Picture1(0).Left = .Left - Sp * TPX - Picture1(0).Width
       Picture1(1).Left = .Left - Sp * TPX - Picture1(1).Width
       Picture1(2).Left = .Left - Sp * TPX - Picture1(2).Width
       Picture1(0).Top = .Top - Sp * TPY - Picture1(0).Height
       Picture1(1).Top = .Top + (.Height - Picture1(1).Height) / 2
       Picture1(2).Top = .Top + .Height + Sp * TPY
       
       Picture1(3).Left = .Left + .Width + Sp * TPX
       Picture1(4).Left = .Left + .Width + Sp * TPX
       Picture1(5).Left = .Left + .Width + Sp * TPX
       Picture1(3).Top = .Top - Sp * TPY - Picture1(0).Height
       Picture1(4).Top = .Top + (.Height - Picture1(1).Height) / 2
       Picture1(5).Top = .Top + .Height + Sp * TPY
       
       Picture1(6).Left = .Left + (.Width - Picture1(6).Width) / 2
       Picture1(7).Left = .Left + (.Width - Picture1(6).Width) / 2
       
       Picture1(6).Top = .Top - Sp * TPY - Picture1(0).Height
       Picture1(7).Top = .Top + .Height + Sp * TPY
     End With
     
    If Not Picture1(0).Visible Then
      For x = 0 To 7
        Picture1(x).Visible = True
      Next x
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei PROJECT1.VBP --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 6 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.