Form Unik Lain (VB)

Components :     1. class module (class1)

Sub Command : class module (cls)
'===================================================

Public Enum ceffHideShow
ceffShow& = 0
ceffHide& = 1
End Enum
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 Const ALTERNATE& = 1
Private Declare Function CreatePolyPolygonRgn Lib "gdi32" (lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub SetWndRegion(ByVal hWnd As Long, ByVal hRgn As Long)
Call SetWindowRgn(hWnd, hRgn, True)
End Sub

Public Sub HideOrShowRect(ByVal hWnd As Long, _
ByVal wCount As Long, _
ByVal hCount As Long, _
Optional ByVal ShowOrHide As ceffHideShow = 1, _
Optional ByVal Step_ As Long = 3)
Dim vertex() As POINTAPI, Num() As Long, wRect As RECT, n As Long
Dim RetVal As Long, st As Long, en As Long
Dim i As Long, j As Long, k As Long, m As Long, hIdx As Long, wIdx As Long, coef As Single
Dim w As Long, h As Long, oldw As Long, oldh As Long
RetVal = GetWindowRect(hWnd, wRect)
With wRect
oldw = .Right - .Left
w = Int(oldw / wCount) + 1
oldh = .Bottom - .Top
h = Int(oldh / hCount) + 1
End With
Select Case ShowOrHide
Case 0
st = 0
en = w
Step_ = Abs(Step_)
Case 1
st = w
en = 0
Step_ = -Abs(Step_)
Case Else
Err.Raise 5, , "ShowOrHide argument must be 0 or 1"
End Select
coef = w / h
ReDim vertex(1 To wCount * hCount * 4)
ReDim Num(1 To wCount * hCount)
For n = st To en Step Step_
For j = 1 To hCount
For i = 1 To wCount
m = (j - 1) * wCount + i
k = (m - 1) * 4
Num(m) = 4
hIdx = (j - 1) * h
wIdx = (i - 1) * w
vertex(k + 1).X = wIdx
vertex(k + 1).Y = hIdx
vertex(k + 2).X = wIdx + n
vertex(k + 2).Y = hIdx
vertex(k + 3).X = wIdx + n
vertex(k + 3).Y = hIdx + n / coef
vertex(k + 4).X = wIdx
vertex(k + 4).Y = hIdx + n / coef
Next i
Next j
Sleep 10
hRgn = CreatePolyPolygonRgn(vertex(1), Num(1), hCount * wCount, ALTERNATE)
SetWndRegion hWnd, hRgn
DoEvents
Next n
End Sub

Public Function DeleteObj() As Long
DeleteObj = DeleteObject(hRgn)
End Function

'===================================================
Sub Command : form1
'===================================================

Private Sub Command1_Click()
Hide_
Unload Me
End Sub

Private Sub Hide_()
Dim CEff As New class1
CEff.HideOrShowRect Me.hWnd, 5, 5, ceffHide, 1
CEff.DeleteObj
End Sub

'===================================================

Semoga Bermanfaat

Penulis : Unknown ~ Sebuah blog yang menyediakan berbagai macam informasi, software, dan tutorial

Artikel Form Unik Lain (VB) ini dipublish oleh Unknown pada hari Senin, 11 Juli 2011. Semoga artikel ini dapat bermanfaat.Terimakasih atas kunjungan Anda silahkan tinggalkan komentar.sudah ada 0 komentar: di postingan Form Unik Lain (VB)