读书人

用什么VB控件可以产生折叠页(folder)

发布时间: 2012-01-01 23:10:55 作者: rapoo

用什么VB控件可以产生折叠页(folder)的效果????
就是点击控件,窗体出现相应的界面

[解决办法]
打或窗口的13特效
 
'Private Sub Command1_Click()
' Call Form_Unload(True)
'End Sub

Private Sub Form_Activate()
AnimateForm Me.Hwnd, aload, eAppearFromLeft, 10
End Sub

Private Sub Form_Unload(Cancel As Integer)
AnimateForm Me.Hwnd, uload, eAppearFromLeft, 10
End Sub

'[APIs明]
Private Declare Function CreateRectRgn Lib "gdi32.dll " (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32 " (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32 " (ByVal Hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function CombineRgn Lib "gdi32.dll " (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll " (ByVal dwMilliseconds As Long)
Private Declare Function GetWindowRect Lib "user32.dll " (ByVal Hwnd As Long, ByRef lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

'[事件]
Public Enum AnimeEventEnum
aUnload = 0
Aload = 1
End Enum

'[特效]
Public Enum AnimeEffectEnum
eAppearFromLeft = 0
eAppearFromRight = 1
eAppearFromTop = 2
eAppearFromBottom = 3
eGenerateLeftTop = 4
eGenerateLeftBottom = 5
eGenerateRightTop = 6
eGenerateRightBottom = 7
eStrechHorizontally = 8
eStrechVertically = 9
eZoomOut = 10
eFoldOut = 11
eCurtonHorizontal = 12
eCurtonVertical = 13
End Enum

'[常]
Private Const RGN_AND As Long = 1
Private Const RGN_OR As Long = 2
Private Const RGN_XOR As Long = 3
Private Const RGN_COPY As Long = 5
Private Const RGN_DIFF As Long = 4

Public Function AnimateForm(Hwnd As Long, ByVal aEvent As AnimeEventEnum, _
Optional ByVal aEffect As AnimeEffectEnum = 11, _
Optional ByVal FrameTime As Long = 10, _
Optional ByVal FrameCount As Long = 33) As Boolean

On Error GoTo Handle
Dim Rct As RECT
Dim X1 As Long
Dim Y1 As Long

Dim hRgn As Long
Dim tmpRgn As Long

Dim XValue As Long
Dim YValue As Long

Dim XIncr As Double
Dim YIncr As Double

Dim wHeight As Long
Dim wWidth As Long

GetWindowRect Hwnd, Rct
wWidth = Rct.Right - Rct.Left
wHeight = Rct.Bottom - Rct.Top

Select Case aEffect
Case eAppearFromLeft
XIncr = wWidth / FrameCount
For X1 = 0 To FrameCount
'定前大小/建立
XValue = X1 * XIncr
hRgn = CreateRectRgn(0, 0, XValue, wHeight)
If aEvent = aUnload Then
tmpRgn = CreateRectRgn(0, 0, wWidth, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_XOR
DeleteObject tmpRgn
End If

'新的
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eAppearFromRight


[解决办法]
XIncr = wWidth / FrameCount
For X1 = 0 To FrameCount


XValue = wWidth - X1 * XIncr
hRgn = CreateRectRgn(XValue, 0, wWidth, wHeight)
If aEvent = aUnload Then
tmpRgn = CreateRectRgn(0, 0, wWidth, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_XOR
DeleteObject tmpRgn
End If

SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eAppearFromTop
YIncr = wHeight / FrameCount
For Y1 = 0 To FrameCount
YValue = Y1 * YIncr
hRgn = CreateRectRgn(0, 0, wWidth, YValue)
If aEvent = aUnload Then
tmpRgn = CreateRectRgn(0, 0, wWidth, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_XOR
DeleteObject tmpRgn
End If

SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next Y1
Case eAppearFromBottom
YIncr = wHeight / FrameCount
For Y1 = 0 To FrameCount
YValue = wHeight - Y1 * YIncr
hRgn = CreateRectRgn(0, YValue, wWidth, wHeight)
If aEvent = aUnload Then
tmpRgn = CreateRectRgn(0, 0, wWidth, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_XOR
DeleteObject tmpRgn
End If

SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next Y1
Case eGenerateLeftTop
XIncr = wWidth / FrameCount: YIncr = wHeight / FrameCount
For X1 = 0 To FrameCount
If aEvent = Aload Then
XValue = X1 * XIncr: YValue = X1 * YIncr
Else
XValue = wWidth - X1 * XIncr: YValue = wHeight - X1 * YIncr
End If
hRgn = CreateRectRgn(0, 0, XValue, YValue)

SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eGenerateLeftBottom
XIncr = wWidth / FrameCount: YIncr = wHeight / FrameCount
For X1 = 0 To FrameCount
'定 / 建 域
If aEvent = Aload Then
XValue = X1 * XIncr: YValue = wHeight - X1 * YIncr
Else
XValue = wWidth - X1 * XIncr: YValue = X1 * YIncr
End If
hRgn = CreateRectRgn(0, wHeight, XValue, YValue)

'窗口新域
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eGenerateRightTop
XIncr = wWidth / FrameCount: YIncr = wHeight / FrameCount
For X1 = 0 To FrameCount
If aEvent = Aload Then
XValue = wWidth - X1 * XIncr: YValue = X1 * YIncr
Else
XValue = X1 * XIncr: YValue = wHeight - X1 * YIncr
End If
hRgn = CreateRectRgn(XValue, YValue, wWidth, 0)

SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eGenerateRightBottom
XIncr = wWidth / FrameCount: YIncr = wHeight / FrameCount
For X1 = 0 To FrameCount
If aEvent = Aload Then
XValue = wWidth - X1 * XIncr: YValue = wHeight - X1 * YIncr
Else
XValue = X1 * XIncr: YValue = X1 * YIncr
End If
hRgn = CreateRectRgn(XValue, YValue, wWidth, wHeight)
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eStrechHorizontally


XIncr = wWidth / FrameCount
For X1 = 0 To FrameCount
If aEvent = Aload Then
XValue = wWidth - X1 * XIncr
Else
XValue = X1 * XIncr
End If
hRgn = CreateRectRgn(XValue / 2, 0, wWidth - XValue / 2, wHeight)
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eStrechVertically
YIncr = wHeight / FrameCount
For Y1 = 0 To FrameCount
If aEvent = Aload Then
YValue = Y1 * YIncr
Else
YValue = wHeight - Y1 * YIncr
End If
hRgn = CreateRectRgn(0, wHeight / 2 - YValue / 2, wWidth, wHeight / 2 + YValue / 2)

SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next Y1
Case eZoomOut
XIncr = wWidth / FrameCount: YIncr = wHeight / FrameCount
For X1 = 0 To FrameCount
If aEvent = Aload Then
XValue = X1 * XIncr: YValue = X1 * YIncr
Else
XValue = wWidth - X1 * XIncr: YValue = wHeight - X1 * YIncr
End If
hRgn = CreateRectRgn((wWidth - XValue) / 2, (wHeight - YValue) / 2, (wWidth + XValue) / 2, (wHeight + YValue) / 2)
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eFoldOut
If wWidth > = wHeight Then
XIncr = wWidth / FrameCount: YIncr = wWidth / FrameCount
Else
XIncr = wHeight / FrameCount: YIncr = wHeight / FrameCount
End If

For X1 = 0 To FrameCount
If aEvent = Aload Then
XValue = X1 * XIncr: YValue = X1 * YIncr
Else
XValue = wWidth - X1 * XIncr: YValue = wHeight - X1 * YIncr
End If
hRgn = CreateRectRgn((wWidth - XValue) / 2, (wHeight - YValue) / 2, (wWidth + XValue) / 2, (wHeight + YValue) / 2)
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next X1
Case eCurtonHorizontal
Dim ScanWidth As Long
ScanWidth = FrameCount / 2
For Y1 = 0 To FrameCount / 2
'初始化域
hRgn = CreateRectRgn(0, 0, 0, 0)
For X1 = 0 To wHeight / FrameCount * 2
tmpRgn = CreateRectRgn(0, X1 * ScanWidth, wWidth, X1 * ScanWidth + Y1)
CombineRgn hRgn, hRgn, tmpRgn, RGN_OR
DeleteObject tmpRgn
Next X1

If aEvent = aUnload Then
tmpRgn = CreateRectRgn(0, 0, wWidth, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_XOR
DeleteObject tmpRgn
End If
SetWindowRgn Hwnd, hRgn, True: DoEvents
Sleep FrameTime
Next Y1
Case eCurtonVertical
ScanWidth = FrameCount / 2
For X1 = 0 To FrameCount / 2
hRgn = CreateRectRgn(0, 0, 0, 0)
For Y1 = 0 To wWidth / FrameCount * 2
tmpRgn = CreateRectRgn(Y1 * ScanWidth, 0, Y1 * ScanWidth + X1, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_OR
DeleteObject tmpRgn
Next Y1

If aEvent = aUnload Then
tmpRgn = CreateRectRgn(0, 0, wWidth, wHeight)
CombineRgn hRgn, hRgn, tmpRgn, RGN_XOR
DeleteObject tmpRgn
End If

SetWindowRgn Hwnd, hRgn, True: DoEvents


Sleep FrameTime
Next X1
End Select
AnimateForm = True
Exit Function
Handle:
AnimateForm = False
End Function

读书人网 >VB

热点推荐