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

解决方案 »

  1.   

    给你一个做《东方快车》悬浮窗体的例子。如果看不明白,可以将原程序代码发给你。'获得鼠标指针在屏幕坐标上的位置
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    '获得窗口在屏幕坐标中的位置
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    '判断指定的点是否在指定的巨型内部
    Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty 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
    '用来移动窗体
    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 LongConst HWND_TOPMOST = -1
     
    Private Type POINTAPI
            X As Long
            Y As Long
    End Type
    Private Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
    Private Is_Move_B As Boolean '判断指针是否位于移动栏(本例中移动栏位于窗体的侧一小地方)
    Private Is_Movestar_B As Boolean '判断移动是否开始
    Private MyRect As RECT
    Private MyPoint As POINTAPI
    Private Movex As Long, Movey As Long  '记录窗体移动前,窗体左上角与鼠标指针位置间的纵横距离
    Private max As Long   '窗口变长以后的尺寸(用户可随意改动)Private Sub Command1_Click(Index As Integer)
      Form1.SetFocus
      Select Case Index
         Case 0
             Form1.PopupMenu Form2.mnu_file, vbPopupMenuLeftAlign, 240, max - 30
         Case 1
         Case 7
             Command1(8).Enabled = Not Command1(8).Enabled
             If Command1(8).Enabled = True Then
                 Command1(7).Picture = Image2(1).Picture
                 Picture1.Width = 4455
                 Form1.Width = Form1.Width + 1820
             Else
                 Command1(7).Picture = Image2(0).Picture
                 Picture1.Width = 2645
                 Form1.Width = Form1.Width - 1820
             End If
             Line (0, 0)-(Form1.Width, Form1.Height), vbBlue, BF
             Get_Windows_Rect
         '......
         Case 13
             End
         '  .....
      End Select
    End SubPrivate Sub Form_Load()
            Timer1.Interval = 50: Timer2.Interval = 1000
            Form1.BackColor = vbBlue
            Get_Windows_Rect
    End Sub
    Sub Get_Windows_Rect()
            Dim dl&
            max = 390: Form1.Height = max
            Form1.Top = 0       '窗体始终放在屏幕顶部
            dl& = GetWindowRect(Form1.hwnd, MyRect)
    End Sub
    Private Sub Form_Paint()
            '使窗体始终置于最前面
            If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
                 SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
                      Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
                      Form1.Height \ Screen.TwipsPerPixelY, 0
            End If
    End SubPrivate Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Is_Move_B Then
         Movex = MyPoint.X - MyRect.Left
         Movey = MyPoint.Y - MyRect.Top
         Is_Movestar_B = True
    End If
    End SubPrivate Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
           Dim dl&
           If Is_Movestar_B Then
                dl& = MoveWindow(Form1.hwnd, MyPoint.X - Movex, MyPoint.Y - Movey, _
                              MyRect.Right - MyRect.Left, MyRect.Bottom, -1)
           End If
    End SubPrivate Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Get_Windows_Rect
        Is_Movestar_B = False
    End SubPrivate Sub Timer1_Timer()
           Dim dl&
           dl& = GetCursorPos(MyPoint)
                If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
                         Form1.Height = max) Or MyPoint.Y <= 3 Then
               '  If MyPoint.Y <= 3 Then
                    Form1.BackColor = vbBlue     '窗体背景颜色(用户可随意改动)
                    Form1.Height = max
                         '判断鼠标指针是否位于窗体拖动区
                    If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
                       Screen.MousePointer = 15
                       Is_Move_B = True
                    Else
                       Screen.MousePointer = 0
                       Is_Move_B = False
                    End If
                Else
                   If Not Is_Movestar_B Then
                      Form1.Height = 30   '窗体变小
                   End If
                End If
    End SubPrivate Sub Timer2_Timer()
        Static color As Integer
        If color > 64 Then color = 0
        Line (0, 0)-(Form1.Width, Form1.Height), QBColor(color Mod 16), BF
        color = color + 15
    End Sub
      

  2.   

    但是如何使一个from总是在最前面,且可以对后面的from操作???
      

  3.   

    声明: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 LongPrivate Const SWP_NOSIZE = &H1
    Private Const SWP_NOMOVE = &H2
    Private Const HWND_TOPMOST = -1
    Private Const HWND_NOTOPMOST = -2
    程序:'设为最前面
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE'恢复正常
    SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
      

  4.   

    不好意思,只能怪小弟愚昧,有什么办法可以同时对这两个from都可以操作,比如说鼠标
    移到(或点击)最前面的from,则最前面的from可以响应,鼠标移开下面的from就可以响应,
    谢谢楼上几位提供的办法,我已经有一些收获,一定会给你们分的。
      

  5.   

    Jneu(沧海桑田) 我不明白,说清楚一些好吗,小弟谢过了