📄 frmsplash.frm
字号:
VERSION 5.00
Begin VB.Form FrmSplash
BorderStyle = 0 'None
ClientHeight = 4815
ClientLeft = 210
ClientTop = 1365
ClientWidth = 7695
ClipControls = 0 'False
ControlBox = 0 'False
Icon = "FrmSplash.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "FrmSplash.frx":000C
ScaleHeight = 4815
ScaleWidth = 7695
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Left = 2400
Top = 1920
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Tool For SQL Server 2000"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 300
Index = 1
Left = 2145
TabIndex = 7
Top = 255
Width = 3960
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Tool For SQL Server 2000"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 300
Index = 0
Left = 2160
TabIndex = 6
Top = 240
Width = 4320
End
Begin VB.Label lblLicenseTo
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "授权"
ForeColor = &H000080FF&
Height = 180
Left = 1680
TabIndex = 5
Top = 3360
Width = 360
End
Begin VB.Label lblProductName
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "产品"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0C000&
Height = 285
Left = 1680
TabIndex = 4
Top = 1080
Width = 600
End
Begin VB.Label lblPlatform
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "平台"
ForeColor = &H000080FF&
Height = 180
Left = 1680
TabIndex = 3
Top = 1680
Width = 360
End
Begin VB.Label lblVersion
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "版本"
ForeColor = &H00C0C000&
Height = 180
Left = 4200
TabIndex = 2
Top = 1155
Width = 360
End
Begin VB.Label lblWarning
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "警告"
ForeColor = &H00C0C000&
Height = 180
Left = 1680
TabIndex = 1
Top = 4200
Width = 360
End
Begin VB.Label lblCopyright
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "版权所有"
ForeColor = &H000080FF&
Height = 180
Left = 1680
TabIndex = 0
Top = 3000
Width = 720
End
Begin VB.Image imgLogo
Height = 585
Left = 6720
Picture = "FrmSplash.frx":7A174
Stretch = -1 'True
Top = 120
Width = 615
End
Begin VB.Shape Shape1
Height = 4815
Left = 0
Top = 0
Width = 7695
End
End
Attribute VB_Name = "FrmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
'其中hwnd是透明窗体的句柄，crKey为颜色值，bAlpha是透明度，取值范围是[0,255]
'dwFlags是透明方式，可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，bAlpha参数有效；
'当取值为LWA_COLORKEY时，bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明－－这个功能很有用
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Dim rtn As Long, A As Integer
Private Sub Form_Click()
If FrmMain.Visible = True Then
Unload Me
End If
End Sub
Private Sub Timer1_Timer()
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, A, LWA_ALPHA
A = A + 15
If A > 255 Then
Timer1.Enabled = False
If FrmMain.Visible = False Then
Delay (3000)
FrmLoad.Show
Unload Me
End If
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If FrmMain.Visible = True Then
Unload Me
End If
End Sub
Private Sub Form_Load()
SetTopMostWindow Me.hwnd, True '使窗体位于最顶端
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
A = 0
Timer1.Interval = 100
Me.Caption = "关于 " & App.title
lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision
lblProductName.Caption = App.title
lblPlatform.Caption = "编程环境：Microsoft Windows XP (SP3) + VB 6.0 (版本：8176)" _
& vbCrLf & vbCrLf & "最后完成时间：2009-01-31" _
& vbCrLf & vbCrLf & "Email：mumu5602@163.com QQ：32372301"
lblCopyright.Caption = "版权所有：LiCheng 李成 (2009) 盗版打屁股"
lblLicenseTo.Caption = "已授权给：" & ComputerNameGet() & vbCrLf & vbCrLf & "当前用户：" & NTDomainUserName
lblWarning.Caption = "警告：某些功能对数据库的改变会导致其他程序不能正常访问数据库！" & vbCrLf & "请慎重使用！否则出了问题我不负责！"
End Sub
Private Sub Frame1_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -