vb6.0窗体上如何添加伸拉框？
在这个伸拉框上我要加一些按钮
http://www.bokeo.net/attachments/2007/02/36935_200702251237411.jpg
[解决办法]
Dim pMove As Long, MovSeed As Long
Private Sub Form_Load()
Me.WindowState = vbMaximized
Picture1.BackColor = 16761024
Picture1.Width = Me.ScaleWidth / 3
Picture1.Left = -Picture1.Width
Picture1.Height = Me.Height
pMove = Picture1.Left
Timer1.Enabled = False
Timer1.Interval = 10
MovSeed = 100
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X < 100 And Picture1.Left < 0 Then Timer1.Enabled = True: MovSeed = 100
If X > Picture1.Width Then Timer1.Enabled = True: MovSeed = -100
End Sub
Private Sub Timer1_Timer()
pMove = pMove + MovSeed
Picture1.Left = pMove
If pMove > 0 Or pMove < -Picture1.Width Then Timer1.Enabled = False: MovSeed = -MovSeed
End Sub
从哪里出来也可以看看我的一个程序lockTfs右键点击托盘红色叉号绿色边框的哪个图标
选择FTP窗口，就会拉出一个类似QQ消息提示的窗口。你去下载看看。
http://download.csdn.net/user/xx22nn
[解决办法]
用这个试试:
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 Long
Const 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()
Load 窗体名 '要打开的窗体
窗体名.Show
End Sub
Private Sub Form_Load()
Timer1.Interval = 50: Timer2.Interval = 1000
Form1.BackColor = vbBlue
Get_Windows_Rect
Picture1.Width = 10745
Form1.Width = 10770
End Sub
Sub Get_Windows_Rect()
Dim dl&
max = 2200: 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 Sub
Private Sub Timer1_Timer()
Dim dl&
dl& = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
Form1.Height = max) Or MyPoint.Y <= 30 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 Sub
[解决办法]
那就用这个吧,别忘了窗体上要拖个timer,属性interval设50
如果还有问题,可以到下面地址,偶的窗体关闭问题的附件中都有了(因本论坛无法上传附件)
http://www.vbgood.com/viewthread.php?tid=50045&extra=page%3D1
Option Explicit
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_nomove = &H2
Private Const Swp_nosize = &H1
Private Const HWND_NOTOPMOST = -2
Private Const hwnd_topmost = -1
Private Declare Function GetCursorPos Lib "USER32 " (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "USER32 " (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetParent Lib "USER32 " (ByVal hWnd As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function FindWindow Lib "USER32 " Alias "FindWindowA " (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32 " (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "USER32 " (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32 " (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1
Private Sub Form_Load() '悬浮窗体置前和靠左用的
SetWindowPos Me.hWnd, hwnd_topmost, 0, 0, 0, 0, Swp_nomove Or Swp_nosize
Move 0, Top
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\aa.exe ", vbMaximizedFocus
End Sub
Private Sub Timer1_Timer() '悬浮窗体用的时钟设置
Dim i As Long
Dim iPos As POINTAPI
GetCursorPos iPos
i = WindowFromPoint(iPos.x, iPos.y)
If i = hWnd Then
Move 0, Top
ElseIf GetParent(i) = hWnd Or GetParent(GetParent(i)) = hWnd Then Move 0, Top: Exit Sub
Else: Move 0 - (Me.Width - 98), Top
End If
End Sub
