类似窗体的收缩和伸展问题...

Question

现在想做这样一个效果
a窗体启动后停放在屏幕上，
当启动b窗体后，b窗体会自动适应a窗体的宽度，停放在a窗体底部如果改变a的宽度，b会自动适应，改变a的高度，b会自动往下移或上移.请问各位大侠  这个问题怎么解决啊???
急啊...在线等...

Answer 1

Private Sub Command1_Click()
    Form2.Show
    Call Form_Resize
End SubPrivate Sub Form_Resize()
    Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End Sub

Answer 2

这个只是实现了  a窗体改变宽度 b就随着改变
a上下移动，b没有移动啊

Answer 3

Private Sub Command1_Click()
    Form2.Show
    Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End Sub
Private Sub Command2_Click()
Static i As Integer
Me.Height = Me.Height - 100
Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End Sub

Answer 4

Private Sub Command1_Click()
  Me.Height = Me.Height + 100
End Sub
Private Sub Command2_Click()
Me.Height = Me.Height - 100
End SubPrivate Sub Form_Load()
  Form2.Show
End SubPrivate Sub Form_Resize()
Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End Sub

Answer 5

form1:
Private Sub Command1_Click()
Form2.Show
End SubPrivate Sub Form_Resize()
If Form2.Visible Then
    Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End If
End Subform2:
Private Sub Form_Load()
    Me.Top = Form1.Top + Form1.Height
    Me.Left = Form1.Left
    Me.Width = Form1.Width
End Sub

Answer 6

我的代码是：Option ExplicitPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As RECT) As LongPrivate Type RECT
    Left   As Long
    Top   As Long
    Right   As Long
    Bottom   As Long
End Type
Private Sub Form_Load()
    
    Dim hand, rt As Long
    Dim rc As RECT
    
    hand = FindWindow(vbNullString, "加载图片")
    If hand Then
        rt = GetWindowRect(hand, rc)
        If rt > 0 Then
            form2.Move rc.Left, rc.Top + rc.Right - rc.Left, rc.Bottom - rc.Top
        End If
    End If
    
End Sub
"加载图片"为form1的标题
怎么不能实现啊？？？
急啊...

Answer 7

Private Sub Form_Load()
    
    Dim hand, rt As Long
    Dim rc As RECT
    
    hand = FindWindow(vbNullString, "ISO8583包分解")
    If hand Then
        rt = GetWindowRect(hand, rc)
        rc.Left = rc.Left * Screen.TwipsPerPixelX
        rc.Right = rc.Right * Screen.TwipsPerPixelX
        rc.Top = rc.Top * Screen.TwipsPerPixelY
        rc.Bottom = rc.Bottom * Screen.TwipsPerPixelY
        If rt > 0 Then
            Me.Move rc.Left, rc.Bottom, rc.Right - rc.Left
        End If
    End If
    
End Sub

Answer 8

Private Sub Command1_Click()
  Me.Height = Me.Height + 100
End Sub
Private Sub Command2_Click()
Me.Height = Me.Height - 100
End SubPrivate Sub Command3_Click()
Me.Left = Me.Left + 100
Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End Sub
Private Sub Command4_Click()
Me.Left = Me.Left - 100
Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End SubPrivate Sub Form_Load()
Command1.Caption = "下"
Command2.Caption = "上"
Command3.Caption = "右"
Command4.Caption = "左"
 Form2.Show
End SubPrivate Sub Form_Resize()
Form2.Move Me.Left, Me.Top + Me.Height, Me.Width
End Sub

Answer 9

主窗体frmMain,附属窗体frmFollow,一个模块
主窗体代码Option ExplicitPrivate Sub Form_Load()
    'frmFollow添加为frmMain子窗体，始终处于frmMain上方并随主窗体最小化而最小化。
     '也可以使用SetWindowLong frmFollow.hWnd,GWL_HWNDPARENT,frmMain.hWnd来实现同样的效果。
    frmFollow.Show , frmMain
    defWindowProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, defWindowProc
End Sub
模块代码Option ExplicitPublic Const SWP_NOZORDER = &H4
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const GWL_WNDPROC = (-4)
Public Const WM_WINDOWPOSCHANGED = &H47
Public Type WINDOWPOS
        hwnd As Long
        hWndInsertAfter As Long
        'PIXELS
        x As Long '窗体左上角x坐标
        y As Long '窗体左上角y坐标
        cx As Long '窗体宽
        cy As Long '窗体高
        flags As Long
End Type
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public defWindowProc As LongPublic bMove As BooleanPublic Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Dim wPos As WINDOWPOS
    
    If uMsg = WM_WINDOWPOSCHANGED Then
        CopyMemory wPos, ByVal lParam, Len(wPos)
        '这里修改第三、四个参数可以改变子窗体frmFollow相对于主窗体frmMain的位置，如果想实现TTPlayer类似的效果还需要记录单独移动子窗体时相对于主窗体产生的位移量。
        SetWindowPos frmFollow.hwnd, 0, wPos.x + wPos.cx, wPos.y, 0, 0, SWP_NOSIZE + SWP_NOZORDER + SWP_NOACTIVATE
    End If
    WindowProc = CallWindowProc(defWindowProc, hwnd, uMsg, wParam, lParam)
End Function