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:
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 SubAfter 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 SubDownload it! (20.2 kb)
© VB Work 2000, Last update