7,763
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
happywqw 2004-06-30
- 打赏
- 举报
差点忘了，还有一点就是设置工程的启动对象为：Sub Main 哦！
happywqw 2004-06-30
- 打赏
- 举报
to northwolves(狼行天下) :
这样的闪屏效果恐怕不行吧！呵呵
如果在2000以上操作系统上，可以使用下列代码达到美观的窗体渐显特效：
先创建一个窗体frmSplash，上面放一个Timer控件TimerFirst，Interval设置为1；
另外就是一个美观的图片框了！位置自己调整，窗体最好是没有边框的。
frmSplash的代码：
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
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
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
On Error Resume Next
Unload Me
End Sub
Public Sub SetOpacityForm(obj As Object, Opacity As Byte)
On Error Resume Next
Dim ret As Long
'Set the window style to 'Layered'
ret = GetWindowLong(obj.hwnd, GWL_EXSTYLE)
ret = ret Or WS_EX_LAYERED
SetWindowLong obj.hwnd, GWL_EXSTYLE, ret
'Set the opacity of the layered window to 128
SetLayeredWindowAttributes obj.hwnd, 0, Opacity, LWA_ALPHA
End Sub
Private Sub TimerFirst_Timer()
On Error Resume Next
TimerFirst.Tag = TimerFirst.Tag + 4
If TimerFirst.Tag >= 250 Then TimerFirst.Enabled = False
SetOpacityForm Me, CByte(TimerFirst.Tag)
End Sub
'//////////////////////////////////////////////////////////
另外创建一个启动模块.
以下是模块代码：
sub Main()
Load frmSplash
frmSplash.SetOpacityForm frmLogo, 0
frmSplash.Show 1
end Sub
这样的闪屏效果恐怕不行吧！呵呵
如果在2000以上操作系统上，可以使用下列代码达到美观的窗体渐显特效：
先创建一个窗体frmSplash，上面放一个Timer控件TimerFirst，Interval设置为1；
另外就是一个美观的图片框了！位置自己调整，窗体最好是没有边框的。
frmSplash的代码：
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
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
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
On Error Resume Next
Unload Me
End Sub
Public Sub SetOpacityForm(obj As Object, Opacity As Byte)
On Error Resume Next
Dim ret As Long
'Set the window style to 'Layered'
ret = GetWindowLong(obj.hwnd, GWL_EXSTYLE)
ret = ret Or WS_EX_LAYERED
SetWindowLong obj.hwnd, GWL_EXSTYLE, ret
'Set the opacity of the layered window to 128
SetLayeredWindowAttributes obj.hwnd, 0, Opacity, LWA_ALPHA
End Sub
Private Sub TimerFirst_Timer()
On Error Resume Next
TimerFirst.Tag = TimerFirst.Tag + 4
If TimerFirst.Tag >= 250 Then TimerFirst.Enabled = False
SetOpacityForm Me, CByte(TimerFirst.Tag)
End Sub
'//////////////////////////////////////////////////////////
另外创建一个启动模块.
以下是模块代码：
sub Main()
Load frmSplash
frmSplash.SetOpacityForm frmLogo, 0
frmSplash.Show 1
end Sub
射天狼 2004-06-30
- 打赏
- 举报
Private Sub Form_Load()
frmSplash.Show
DoEvents
'你自己的操作
doevnts
Unload frmSplash
End Sub
frmSplash就是展示屏幕,漂不漂亮就看你的美术功底了!!
frmSplash.Show
DoEvents
'你自己的操作
doevnts
Unload frmSplash
End Sub
frmSplash就是展示屏幕,漂不漂亮就看你的美术功底了!!
northwolves 2004-06-30
- 打赏
- 举报
闪屏代码：
Const FLASHW_STOP = 0 'Stop flashing. The system restores the window to its original state.
Const FLASHW_CAPTION = &H1 'Flash the window caption.
Const FLASHW_TRAY = &H2 'Flash the taskbar button.
Const FLASHW_ALL = (FLASHW_CAPTION Or FLASHW_TRAY) 'Flash both the window caption and taskbar button. This is equivalent to setting the FLASHW_CAPTION Or FLASHW_TRAY flags.
Const FLASHW_TIMER = &H4 'Flash continuously, until the FLASHW_STOP flag is set.
Const FLASHW_TIMERNOFG = &HC 'Flash continuously until the window comes to the foreground.
Private Type FLASHWINFO
cbSize As Long
hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long
End Type
Private Declare Function FlashWindowEx Lib "user32" (pfwi As FLASHWINFO) As Boolean
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim FlashInfo As FLASHWINFO
'Specifies the size of the structure.
FlashInfo.cbSize = Len(FlashInfo)
'Specifies the flash status
FlashInfo.dwFlags = FLASHW_ALL Or FLASHW_TIMER
'Specifies the rate, in milliseconds, at which the window will be flashed. If dwTimeout is zero, the function uses the default cursor blink rate.
FlashInfo.dwTimeout = 0
'Handle to the window to be flashed. The window can be either opened or minimized.
FlashInfo.hwnd = Me.hwnd
'Specifies the number of times to flash the window.
FlashInfo.uCount = 0
FlashWindowEx FlashInfo
End Sub
Private Sub Form_Paint()
Me.CurrentX = 0
Me.CurrentY = 0
Me.Print "Click me !"
End Sub
Const FLASHW_STOP = 0 'Stop flashing. The system restores the window to its original state.
Const FLASHW_CAPTION = &H1 'Flash the window caption.
Const FLASHW_TRAY = &H2 'Flash the taskbar button.
Const FLASHW_ALL = (FLASHW_CAPTION Or FLASHW_TRAY) 'Flash both the window caption and taskbar button. This is equivalent to setting the FLASHW_CAPTION Or FLASHW_TRAY flags.
Const FLASHW_TIMER = &H4 'Flash continuously, until the FLASHW_STOP flag is set.
Const FLASHW_TIMERNOFG = &HC 'Flash continuously until the window comes to the foreground.
Private Type FLASHWINFO
cbSize As Long
hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long
End Type
Private Declare Function FlashWindowEx Lib "user32" (pfwi As FLASHWINFO) As Boolean
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim FlashInfo As FLASHWINFO
'Specifies the size of the structure.
FlashInfo.cbSize = Len(FlashInfo)
'Specifies the flash status
FlashInfo.dwFlags = FLASHW_ALL Or FLASHW_TIMER
'Specifies the rate, in milliseconds, at which the window will be flashed. If dwTimeout is zero, the function uses the default cursor blink rate.
FlashInfo.dwTimeout = 0
'Handle to the window to be flashed. The window can be either opened or minimized.
FlashInfo.hwnd = Me.hwnd
'Specifies the number of times to flash the window.
FlashInfo.uCount = 0
FlashWindowEx FlashInfo
End Sub
Private Sub Form_Paint()
Me.CurrentX = 0
Me.CurrentY = 0
Me.Print "Click me !"
End Sub
