We help IT Professionals succeed at work.

A box with movable borders

posnorm
posnorm asked
on
Medium Priority
335 Views
Last Modified: 2008-02-20
I would like to place a rectangular object on a form which has form-like borders.  That is:  I would like the user to be able to "grab" an edge with the mouse, and move it.  This will, of course, change the width or height of the rectangle.

As far as I can tell, the only object allowing this is another form.  Is this true?

I fiddled with the picture and image controls, but they don't have this capability.  Is there any other way to provide this?

It would be nice if the rectangle was a "container", but that is not necessary.
-- Norm
Comment
Watch Question

Commented:
' Form1, add picturebox
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_THICKFRAME = &H40000
Private Const GWL_STYLE = (-16)

Private Sub Form_Click()
    Dim style As Long
    style = GetWindowLong(Me.Picture1.hwnd, GWL_STYLE)
    SetWindowLong Me.Picture1.hwnd, GWL_STYLE, style Or WS_THICKFRAME
    Picture1.Width = Picture1.Width + 30
End Sub
Commented:
' tripple-click here and copy this code:
' Form1, add picturebox
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Private Const WS_THICKFRAME = &H40000
Private Const GWL_STYLE = (-16)

Private Sub Form_Click()
    Dim style As Long
    style = GetWindowLong(Me.Picture1.hwnd, GWL_STYLE)
    SetWindowLong Me.Picture1.hwnd, GWL_STYLE, style Or WS_THICKFRAME
    Picture1.Width = Picture1.Width + 30
End Sub

Author

Commented:
Thank you!
Worked perfectly!
The picture box "edge grab and move" works exactly,
on all four edges, as I wished.  
Questions:  What is the purpose of the code line:

Picture1.Width = Picture1.Width + 30

Why is there no corresponding code for Picture1.Height?
Apparently it is not needed.  So why is the above code
line needed?

What is the significance of the "30"?

Again -- Thank you very very much -- Norm

Commented:
Thanks, Norm

>Picture1.Width = Picture1.Width + 30
The purpose is to Refresh the control, to reflect the change in window style.  VB's Refresh won't work.

' New version, allows moving the picturebox, and switching on/off
' Form1, add Picturebox, and CheckBox inside Picturebox
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
   ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
'
Private OKToMove As Boolean 'flag
Private moving As Boolean 'flag
Private startx As Single, starty As Single

Private Sub Check1_Click()
    AllowResize (Check1.Value = vbChecked)
    OKToMove = (Check1.Value = vbChecked)
End Sub

Private Sub AllowResize(Allow As Boolean)
    Dim style As Long, bdr As Single
   
    With Picture1
        style = GetWindowLong(Me.Picture1.hwnd, GWL_STYLE)
       
        ' set new style
        If Allow Then
            style = style Or WS_THICKFRAME
        Else
            style = style And (Not WS_THICKFRAME)
        End If
        SetWindowLong Me.Picture1.hwnd, GWL_STYLE, style
           
        ' refresh control
        bdr = 3 * Screen.TwipsPerPixelX
        If Not Allow Then bdr = -bdr
        .Move .Left - bdr, .Top - bdr, .Width + 2 * bdr, .Height + 2 * bdr
    End With
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = vbLeftButton And OKToMove Then
       startx = X
       starty = Y
       Picture1.ZOrder 0
       moving = True ' set flag
   End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = vbLeftButton And moving Then
       Picture1.Move Picture1.Left + X - startx, Picture1.Top + Y - starty
   End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = vbLeftButton And moving Then
       Picture1_MouseMove Button, Shift, X, Y
       moving = False ' reset flag
   End If
End Sub

Author

Commented:
Thank you again.  I really appreciate your work.
Plus -- I get to learn something!
-- Norm

Explore More ContentExplore courses, solutions, and other research materials related to this topic.