vb6运行时想像设计时一样自由调整控件大小位置
如题，大家有好例子请提供下，谢谢
[解决办法]
要达到VB窗体设计器那种效果（包括所有ActiveX控件）的缩放很麻烦，需要实现一大堆的接口，如果只想对窗口控件实现运行时缩放，可比较简单，具体代码如下：
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 Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
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
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_FRAMECHANGED = &H20
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Sub AllowSizeControl(allowSize As Boolean)
Dim ctl As Control
For Each ctl In Me.Controls
If IsWindowControl(ctl) Then
If allowSize Then
SetWindowLong ctl.hwnd, GWL_STYLE, GetWindowLong(ctl.hwnd, GWL_STYLE) Or WS_THICKFRAME
Else
SetWindowLong ctl.hwnd, GWL_STYLE, GetWindowLong(ctl.hwnd, GWL_STYLE) And Not WS_THICKFRAME
End If
SetWindowPos ctl.hwnd, 0, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End If
Next
End Sub
Function IsWindowControl(ctl As Control) As Boolean
Dim hwndCtrl As Long
On Error Resume Next
hwndCtrl = ctl.hwnd
If Err.Number <> 0 Then
Err.Clear
IsWindowControl = False
Else
IsWindowControl = IsWindow(hwndCtrl)
End If
End Function
Private Sub Command1_Click()
AllowSizeControl True '允许调整控件大小
End Sub
Private Sub Command2_Click()
AllowSizeControl False '禁止调整控件大小
End Sub
'* *********************************************** *
'* 编码：lyserver
'* 联系方式：http://blog.csdn.net/lyserver
'* *********************************************** *
Option Explicit
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 Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
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
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_FRAMECHANGED = &H20
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
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
Private Const HTCAPTION = 2
Private WithEvents m_TextBox1 As VB.TextBox
Private WithEvents m_Button1 As VB.CommandButton
Private WithEvents m_Picture1 As VB.PictureBox
Private Sub Form_Load()
Set m_TextBox1 = Me.Controls.Add("VB.TextBox", "m_TextBox1")
m_TextBox1.Visible = True
SetWindowLong m_TextBox1.hwnd, GWL_STYLE, GetWindowLong(m_TextBox1.hwnd, GWL_STYLE) Or WS_THICKFRAME
SetWindowPos m_TextBox1.hwnd, 0, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
Set m_Button1 = Me.Controls.Add("VB.CommandButton", "m_Button1")
m_Button1.Visible = True
m_Button1.Move m_TextBox1.Width
SetWindowLong m_Button1.hwnd, GWL_STYLE, GetWindowLong(m_Button1.hwnd, GWL_STYLE) Or WS_THICKFRAME
SetWindowPos m_Button1.hwnd, 0, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
Set m_Picture1 = Me.Controls.Add("VB.PictureBox", "m_Picture1")
m_Picture1.Visible = True
m_Picture1.Move m_Button1.Left + m_Button1.Width
SetWindowLong m_Picture1.hwnd, GWL_STYLE, GetWindowLong(m_Picture1.hwnd, GWL_STYLE) Or WS_THICKFRAME
SetWindowPos m_Picture1.hwnd, 0, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_FRAMECHANGED
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print Button
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Controls.Remove ("m_TextBox1")
Me.Controls.Remove ("m_Button1")
Me.Controls.Remove ("m_Picture1")
End Sub
Private Sub m_Button1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage m_Button1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
Private Sub m_Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage m_Picture1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
Private Sub m_TextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage m_TextBox1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End If
End Sub
