Visual Basic WorkShop

Move'n'Resize contol,

VBO Ad



     Many times the user need the possibility to move or resize the controls at run-time in the same manner like at design-time, in the simplest way possible. The best solution for this it could be a control developed in Visual Basic, which act like a container for other controls and offer a method for moving or resizing the inner control. That control should has the possibility to show some grab handles needed for moving and resizing and when this is active the actions should be made by mouse. Also, it should work with any other controls (standard or third-party) and should have at least two properties:

     The simplest solution is to use some picture-boxes as grab handles. For the simplicity sake we are using only four such cues (one for moving - yellow and three for resizing - blue).

      Let start creating a new project and add an user control named ‘MoveResize’. On this usercontrol add a picture box named picMove with BackColor property as &H00FFFF (yellow) and a picture-box array named picSize with 3 items which have their BackColor as &H0000FF (blue). All those picture-boxes have Appearance as 0-Flat and ScaleMode as 3-Pixels. For all picture we have appropriate mouse pointers (15-Size All for moving and Size NS, Size NE SW and Size WE for resizing). Finally, the control looks like this:

      For displaying the control we need some settings of Windows configuration like the size of the caption bars of the windows or the margins of windows. This could depend on the client computer and could be retrieved by using GetSystemMetrics function and some constants declared as below:
Private Declare Function GetSystemMetrics Lib "user32" _
	(ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4
Private Const SM_CXEDGE = 45
Private Const SM_CYEDGE = 46

	Also, we are using the simplest way for getting dimensions and moving a window by GetWindowRect and MoveWindow API functions, like this:

Private Declare Function MoveWindow Lib "user32" _	
	(ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, _
	ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
	(ByVal hwnd As Long, lpRect As RECT) As Long

	Now, we declare the two properties, public available: AllowDrag and AllowResize.
	Finally this is the code used for the control:

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

Private Declare Function GetSystemMetrics Lib "user32" _
	(ByVal nIndex As Long) As Long
Private Declare Function MoveWindow Lib "user32" _	
	(ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, _
	ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
	(ByVal hwnd As Long, lpRect As RECT) As Long

Private Const SM_CYCAPTION = 4
Private Const SM_CXEDGE = 45
Private Const SM_CYEDGE = 46

Public AllowMove As Boolean
Public AllowResize As Boolean

Dim ix As Long
Dim iy As Long
Dim bx As Long, by As Long

Dim r As RECT
Dim r_par As RECT

Private Sub picMove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ix = X
iy = Y
GetWindowRect UserControl.hwnd, r
GetWindowRect UserControl.Parent.hwnd, r_par
End Sub

Private Sub picMove_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MoveWindow UserControl.hwnd, X + r.Left - r_par.Left - ix - bx, Y + r.Top - r_par.Top - by - iy, r.Right - r.Left, r.Bottom - r.Top, 1
End Sub

Private Sub picSize_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
ix = X
iy = Y
GetWindowRect UserControl.hwnd, r
GetWindowRect UserControl.Parent.hwnd, r_par
End Sub

Private Sub picSize_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0
    MoveWindow UserControl.hwnd, r.Left - r_par.Left - bx, r.Top - r_par.Top - by, r.Right - r.Left + X, r.Bottom - r.Top, 1
Case 1
    MoveWindow UserControl.hwnd, r.Left - r_par.Left - bx, r.Top - r_par.Top - by, r.Right - r.Left + X, r.Bottom - r.Top + Y, 1
Case 2
    MoveWindow UserControl.hwnd, r.Left - r_par.Left - bx, r.Top - r_par.Top - by, r.Right - r.Left, r.Bottom - r.Top + Y, 1
End Select
UserControl.Refresh
End Sub

Private Sub UserControl_Initialize()
bx = 2 * GetSystemMetrics(SM_CXEDGE)
by = 2 * GetSystemMetrics(SM_CYEDGE) + GetSystemMetrics(SM_CYCAPTION)
End Sub

Private Sub UserControl_Paint()
On Error Resume Next
Dim i As Long
Dim c As Control
For Each c In UserControl.ContainedControls
If c.Name <> "picMove" And c.Name <> "picSize" Then
    c.Left = 0
    c.Top = 0
    c.Width = UserControl.Width
    c.Height = UserControl.Height
End If
Next
picSize(0).Left = UserControl.Width \ Screen.TwipsPerPixelX - 9
picSize(1).Left = UserControl.Width \ Screen.TwipsPerPixelX - 9
picSize(2).Left = (UserControl.Width \ Screen.TwipsPerPixelX - 9) \ 2
picSize(0).Top = (UserControl.Height \ Screen.TwipsPerPixelY - 9) \ 2
picSize(1).Top = UserControl.Height \ Screen.TwipsPerPixelY - 9
picSize(2).Top = UserControl.Height \ Screen.TwipsPerPixelY - 9
picMove.Visible = (AllowMove Or (Not Ambient.UserMode))
picMove.ZOrder
If AllowResize Or (Not Ambient.UserMode) Then
    For i = 0 To 2
        picSize(i).Visible = True
        picSize(i).ZOrder
    Next
Else
    For i = 0 To 2
        picSize(i).Visible = False
    Next
End If
End Sub

Public Sub Refresh()
UserControl.Refresh
End Sub
      After we developed the control let use it into a program. So, add a new array of three such controls to a form (called MoveResize1, in our example) and add other controls on every MoveResize control (let say we are using a command-button, a rich text control and a picture box). Also add two arrays of check-boxes for setting AllowDrag (chkMove) and AllowResize (chkResize) properties for every item in the MoveResize1 array. The form should looks like this:

     The code for the form is the following:

Private Sub chkMove_Click(Index As Integer)
MoveResize1(Index).AllowMove = Not MoveResize1(Index).AllowMove
MoveResize1(Index).Refresh
End Sub

Private Sub chkResize_Click(Index As Integer)
MoveResize1(Index).AllowResize = Not MoveResize1(Index).AllowResize
MoveResize1(Index).Refresh
End Sub

Private Sub Command1_Click()
MsgBox "Hello"
End Sub

Private Sub Picture1_Paint()
Picture1.Print "Text"
End Sub
Download it! (20.2 kb)

© VB Work 2000, Last update