重庆分公司,新征程启航
为企业提供网站建设、域名注册、服务器等服务
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
创新互联公司2013年开创至今,是专业互联网技术服务公司,拥有项目成都网站设计、成都网站建设网站策划,项目实施与项目整合能力。我们以让每一个梦想脱颖而出为使命,1280元汾西做网站,已为上家服务,为汾西各地企业和个人服务,联系电话:13518219792
If Me.Opacity 1 Then
Me.Opacity += 0.01
Else
Timer1.Enabled = False
End If
End Sub
Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
If Me.Opacity 0 Then
Me.Opacity -= 0.01
Else
Me.Close()
End If
End Sub
用VB编程实现窗体背景由上至下的颜色逐渐变浅
很多应用程序的安装界面都采用了标准的由蓝到黑渐变的背景,你可以用如下代码实现这种效果
Sub Dither(vForm As Form)
Dim intLoop As Integer
vForm.DrawStyle = vbInsideSolid
vForm.DrawMode = vbCopyPen
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256
For intLoop = 0 To 255
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0, 255 - intLoop), B
Next intLoop
End Sub
Private Sub Form_Activate()
Dither Me
End Sub
将窗体的AutoRedraw属性设为True.
如果想得到由红到黑的渐变,只需如下改动:
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(255 - intLoop, 0, 0), B
以下是由绿到黑的渐变效果
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0,255 - intLoop, 0), B
也容易,如果是黑白三个颜色加上相同的渐变量,彩色的是起始颜色的三个分量与终止颜色的对应三个分量的差值,再除于相同的份数,就得出三原色各自的步进量。
窗体上放个图片框试试下面代码:
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
Dim startColor As Color = Color.Red
Dim endColor As Color = Color.Green
Dim s As String = "vb点虐 如何使文字能渐变颜色,就是颜色慢慢变淡然后在慢慢恢复?"
Dim Steps As Integer = s.Length \ 2
Dim StepR As Integer = (CInt(endColor.R) - startColor.R) \ Steps
Dim StepG As Integer = (CInt(endColor.G) - startColor.G) \ Steps
Dim StepB As Integer = (CInt(endColor.B) - startColor.B) \ Steps
Dim R As Integer = startColor.R
Dim G As Integer = startColor.G
Dim B As Integer = startColor.B
Dim drawFont As New System.Drawing.Font("Arial", 16)
Dim X As Integer = 50
For i As Integer = 1 To Steps
Dim drawBrush As New SolidBrush(Color.FromArgb(R, G, B))
e.Graphics.DrawString(s.Substring(i - 1, 1), drawFont, drawBrush, X, 50.0)
X += 18
R += StepR
G += StepG
B += StepB
Next
For i As Integer = 1 To Steps
Dim drawBrush As New SolidBrush(Color.FromArgb(R, G, B))
e.Graphics.DrawString(s.Substring(i + Steps - 1, 1), drawFont, drawBrush, X, 50.0)
X += 18
R -= StepR
G -= StepG
B -= StepB
Next
End Sub
首先你得有个FORM1,然后添加一个模块,写入下面:
Const GWL_WNDPROC = (-4)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Const PROP_PREVPROC = "PrevProc"
Const PROP_FORM = "FormObject"
Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Dest As Any, _
Src As Any, _
ByVal DestL As Long)
Const WM_PRINTCLIENT = H318
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" ( _
ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function apiOleTranslateColor Lib "oleaut32" Alias "OleTranslateColor" ( _
ByVal lOleColor As Long, _
ByVal lHPalette As Long, _
lColorRef As Long) As Long
Enum AnimateWindowFlags
AW_HOR_POSITIVE = H1
AW_HOR_NEGATIVE = H2
AW_VER_POSITIVE = H4
AW_VER_NEGATIVE = H8
AW_CENTER = H10
AW_HIDE = H10000
AW_ACTIVATE = H20000
AW_SLIDE = H40000
AW_BLEND = H80000
End Enum
Private Declare Function apiAnimateWindow Lib "user32" Alias "AnimateWindow" ( _
ByVal hWnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function MulDiv Lib "kernel32" ( _
ByVal Mul As Long, _
ByVal Nom As Long, _
ByVal Den As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" ( _
ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" ( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" ( _
ByVal hDC As Long) As Long
Private Declare Function FillRect Lib "user32" ( _
ByVal hDC As Long, _
lpRect As RECT, _
ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private 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
''注释:
''注释: AnimateWindow
''注释:
''注释: Wrapper for AnimateWindow api
'注释:
Sub AnimateWindow( _
ByVal Form As Form, _
ByVal dwTime As Long, _
ByVal dwFlags As AnimateWindowFlags)
'注释: Set the properties
SetProp Form.hWnd, PROP_PREVPROC, GetWindowLong(Form.hWnd, GWL_WNDPROC)
SetProp Form.hWnd, PROP_FORM, ObjPtr(Form)
'注释: Subclass the window
SetWindowLong Form.hWnd, GWL_WNDPROC, AddressOf AnimateWinProc
'注释: Call AnimateWindow API
apiAnimateWindow Form.hWnd, dwTime, dwFlags
'注释: Unsubclass the window
SetWindowLong Form.hWnd, GWL_WNDPROC, GetProp(Form.hWnd, PROP_PREVPROC)
'注释: Remove the properties
RemoveProp Form.hWnd, PROP_FORM
RemoveProp Form.hWnd, PROP_PREVPROC
'注释: Refresh the form
Form.Refresh
End Sub
'注释:
'注释: AnimateWinProc
'注释:
'注释: Window procedure for AnimateWindow
'注释:
Private Function AnimateWinProc( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim lPrevProc As Long
Dim lForm As Long
Dim oForm As Form
'注释: Get the previous WinProc pointer
lPrevProc = GetProp(hWnd, PROP_PREVPROC)
'注释: Get the form object
lForm = GetProp(hWnd, PROP_FORM)
MoveMemory oForm, lForm, 4
Select Case Msg
Case WM_PRINTCLIENT
Dim tRect As RECT
Dim hBr As Long
'注释: Get the window client size
GetClientRect hWnd, tRect
'注释: Create a brush with the
'注释: form background color
hBr = CreateSolidBrush(OleTranslateColor(oForm.BackColor))
'注释: Fill the DC with the
'注释: background Color
FillRect wParam, tRect, hBr
'注释: Delete the brush
DeleteObject hBr
If Not oForm.Picture Is Nothing Then
Dim lScrDC As Long
Dim lMemDC As Long
Dim lPrevBMP As Long
'注释: Create a compatible DC
lScrDC = GetDC(0)
lMemDC = CreateCompatibleDC(lScrDC)
ReleaseDC 0, lScrDC
'注释: Select the form picture in the DC
lPrevBMP = SelectObject(lMemDC, oForm.Picture.Handle)
'注释: Draw the picture in the DC
BitBlt wParam, _
0, 0, _
HM2Pix(oForm.Picture.Width), HM2Pix(oForm.Picture.Height), _
lMemDC, 0, 0, vbSrcCopy
'注释: Release the picture
SelectObject lMemDC, lPrevBMP
'注释: Delete the DC
DeleteDC lMemDC
End If
End Select
'注释: Release the form object
MoveMemory oForm, 0, 4
'注释: Call the original window procedure
AnimateWinProc = CallWindowProc(lPrevProc, hWnd, Msg, wParam, lParam)
End Function
'注释:
'注释: HM2Pix
'注释:
'注释: Converts HIMETRIC to Pixel
'注释:
Private Function HM2Pix(ByVal Value As Long) As Long
HM2Pix = MulDiv(Value, 1440, 2540) / Screen.TwipsPerPixelX
End Function
'注释:
'注释: OleTranslateColor
'注释:
'注释: Wrapper for OleTranslateColor API
'注释:
Private Function OleTranslateColor(ByVal Clr As Long) As Long
apiOleTranslateColor Clr, 0, OleTranslateColor
End Function
...........................................................................
在form1的unload里面写入
Private Sub Form_Unload(Cancel As Integer)
AnimateWindow Me, 1000, H80000 + H10000
Set Form1 = Nothing
End Sub
...............................运行,关闭看看特效。。窗口隐身而出。。。没有的话,联系我。。呵呵 我是KELVIN,联系我
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
其中:
hwnd只对Form有效,其他像Picture1都无法产生效果。
dwTime是动画持续的时间,默认为200。
dwFlags可取以下值:
AW_HOR_POSITIVE ( H1 ) '从左到右打开窗口
AW_HOR_NEGATIVE ( H2 ) '从右到左打开窗口
AW_VER_POSITIVE ( H4 ) '从上到下打开窗口
AW_VER_NEGATIVE ( H8 ) '从下到上打开窗口
AW_CENTER ( H10 ) '看不出任何效果
AW_HIDE (H10000) '在窗体卸载时若想使用本函数就得加上此常量
AW_ACTIVATE (H20000) '在窗体通过本函数打开后,默认情况下会失去焦点,除非加上本常量
AW_SLIDE (H40000) '看不出任何效果
AW_BLEND (H80000) '淡入淡出效果