ResizeControl (2)

'in un Form

'Declare variables

Dim aResize As clsResize
Dim bResize As clsResize
Dim cResize As clsResize
Dim dResize As clsResize
Private Sub Command1_Click()
'Show a small message

MsgBox "Isn´t that COOL? Vote for me if you like it!", vbExclamation, "Resizable controls"
End Sub

Private Sub Command2_Click()
'Make the chosen control resizable

If Option1(0).Value = True Then
aResize.Attach Text1
ElseIf Option1(1).Value = True Then
bResize.Attach Command1
ElseIf Option1(2).Value = True Then
cResize.Attach Picture1
ElseIf Option1(3).Value = True Then
dResize.Attach Check1
End If
End Sub

Private Sub Command3_Click()
'Make the chosen control not resizable

If Option1(0).Value = True Then
aResize.Detach Text1
ElseIf Option1(1).Value = True Then
bResize.Detach Command1
ElseIf Option1(2).Value = True Then
cResize.Detach Picture1
ElseIf Option1(3).Value = True Then
dResize.Detach Check1
End If
End Sub

Private Sub Form_Load()
Set aResize = New clsResize
Set bResize = New clsResize
Set cResize = New clsResize
Set dResize = New clsResize
'Make all controls resizable

aResize.Attach Text1
bResize.Attach Command1
cResize.Attach Picture1
dResize.Attach Check1
'Print text into the PictureBox

Picture1.Print "This works also with PictureBoxes"
End Sub

'/* Modulo di classe

Option Explicit
'**********************

'* API Declarations *

'**********************

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
'**********************

'* Consts *

'**********************

Private Const SWP_DRAWFRAME = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_FLAGS = SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
'**********************

'* Vars *

'**********************

Dim bStyle As Long
Dim bLeft As Integer
Dim bTop As Integer
Dim bWidth As Integer
Dim bHeight As Integer
Public Sub Attach(ByVal cControl As Control)
Dim cStyle As Long
'Save the style and position of the control

bStyle& = GetWindowLong(cControl.hwnd, GWL_STYLE)
bLeft% = cControl.Left
bTop% = cControl.Top
bWidth% = cControl.Width
bHeight% = cControl.Height
If bStyle& Then
Call SetWindowLong(cControl.hwnd, GWL_STYLE, bStyle&)
Call SetWindowPos(cControl.hwnd, cControl.Parent.hwnd, 0, 0, 0, 0, SWP_FLAGS)
End If
'Get the style of the control

cStyle& = GetWindowLong(cControl.hwnd, GWL_STYLE)
''mix' this style with the WS_THICKFRAME style

cStyle& = cStyle& Or WS_THICKFRAME
'Apply the new style to the control

If cStyle& Then
Call SetWindowLong(cControl.hwnd, GWL_STYLE, cStyle&)
Call SetWindowPos(cControl.hwnd, cControl.Parent.hwnd, 0, 0, 0, 0, SWP_FLAGS)
End If
End Sub

Public Sub Detach(ByVal cControl As Control)
'Apply the saved style and position to the control

If bStyle& Then
Call SetWindowLong(cControl.hwnd, GWL_STYLE, bStyle&)
Call SetWindowPos(cControl.hwnd, cControl.Parent.hwnd, 0, 0, 0, 0, SWP_FLAGS)
End If
End Sub

Richiede una serie di controlli visualizzabili nella parte
Codice