Este truco está en http://www.ethek.com/lenguajes/vb/trucos/trucos_vb.htm , la página de trucos que el Guille (http://guille.costasol.net) publica en el web de Ethek & Friends (http://www.ethek.com). No te pierdas ninguna de estas páginas.
Cualquier control que tenga un Hwnd puede hacerse "redimensionable", es decir que cuando esté en ejecución se pueda cambiar el tamaño, para ello hay que usar una serie de llamadas del API.
Veamos las declaraciones del API, así como un procedimiento genérico para hacerlo redimensionable.
Este procedimiento espera un parámetro que será el control al que se le quiere dar esa característica, en el procedimiento he puesto una rutina de detección de errores por si el control que se le pasa no soporta esta característica.
'Declaraciones del API para 32 bits
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cX As Long, ByVal cY As Long, _
ByVal wFlags As Long) As Long
Const GWL_STYLE = (-16)
Const WS_THICKFRAME = &H40000
Const WS_CHILD = &H40000000
Const SWP_DRAWFRAME = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Private Sub Dimensionable(ByVal elControl As Control)
Dim Style As Long
'Por si el control pasado no se puede redimensionar
On Local Error Resume Next
Style = GetWindowLong(elControl.hWnd, GWL_STYLE)
Style = Style Or WS_THICKFRAME
Style = SetWindowLong(elControl.hWnd, GWL_STYLE, Style)
Style = SetWindowPos(elControl.hWnd, Me.hWnd, 0, 0, 0, 0, _
SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME)
Err = 0
On Local Error GoTo 0
End Sub
'Para usarlo, se haría así:
Private Sub Form_Load()
Dimensionable Picture1
Dimensionable Text1
End Sub
Basándonos en el ejemplo anterior podemos modificar la función para que una llamada haga el control redimensionable y otra lo vuelva a dejar "normal" :
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cX As Long, ByVal cY As Long, _
ByVal wFlags As Long) As Long
Const GWL_STYLE = (-16)
Const WS_THICKFRAME = &H40000
Const WS_CHILD = &H40000000
Const SWP_DRAWFRAME = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Sub Dimensionable2(ByVal elControl As Control)
Dim Style As Long
'Por si el control pasado no se puede redimensionar
On Local Error Resume Next
Style = GetWindowLong(elControl.hWnd, GWL_STYLE)
Style = Style Xor WS_THICKFRAME
Style = SetWindowLong(elControl.hWnd, GWL_STYLE, Style)
Style = SetWindowPos(elControl.hWnd, Me.hWnd, 0, 0, 0, 0, _
SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Xor SWP_DRAWFRAME)
Err = 0
On Local Error GoTo 0
End Sub
Podemos permitir a los usuarios que modifiquen el tamaño de un control (como hace VB en modo diseño) usando un par de sencillas llamadas al api. Podemos cambiar el tamaño a izquierda, derecha, arriba, abajo y en las diagonales. Cuando haces rangos para las coordendas del ratón (como x>0 and x<150), el evento MouseDown activa las funciones del API y cambia el tamaño del control mientras mueves el ratón. Este código asume que tienes un picturebox en el formulartio :
Private Declare Function ReleaseCapture Lib _
"user32" () As Long
Private Declare Function SendMessage Lib _
"user32" Alias "SendMessageA" (ByVal hWnd _
As Long, ByVal wMsg As Long, ByVal wParam _
As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
' Puedes encontrar más constantes en el visor de API
' Aquí vamos a usar sólo el cambio de tamaño a izquierda y derecha
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Sub Picture1_MouseDown(Button As _
Integer, Shift As Integer, X As Single, Y As Single)
Dim nParam As Long
With Picture1
' Puedes cambiar estas coordenadas lo que quieras
If (X > 0 And X < 150) Then
nParam = HTLEFT
ElseIf (X > .Width - 150 And X < .Width) Then
' estas también
nParam = HTRIGHT
End If
If nParam Then
Call ReleaseCapture
Call SendMessage(.hWnd, _
WM_NCLBUTTONDOWN, nParam, 0)
End If
End With
End Sub
Private Sub Picture1_MouseMove(Button As _
Integer, Shift As Integer, X As Single, Y As Single)
Dim NewPointer As MousePointerConstants
' Puedes cambiar estas coordenadas lo que quieras
If (X > 0 And X < 150) Then
NewPointer = vbSizeWE
ElseIf (X > Picture1.Width - 150 And X < _
Picture1.Width) Then ' estas también
NewPointer = vbSizeWE
Else
NewPointer = vbDefault
End If
If NewPointer <> Picture1.MousePointer Then
Picture1.MousePointer = NewPointer
End If
End Sub
-Fran Pregernik, Zagreb, Croatia