📄 frmsplash.frm
字号:
VERSION 5.00
Begin VB.Form frmSplash
BorderStyle = 1 'Fixed Single
ClientHeight = 4440
ClientLeft = 1830
ClientTop = 2280
ClientWidth = 7035
ClipControls = 0 'False
ControlBox = 0 'False
Icon = "frmSplash.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "frmSplash.frx":000C
ScaleHeight = 4440
ScaleWidth = 7035
StartUpPosition = 2 'CenterScreen
Begin VB.Timer tmrUnload
Enabled = 0 'False
Interval = 10000
Left = 720
Top = 2730
End
Begin VB.Label lblAction
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Left = 3480
TabIndex = 6
Top = 2670
Width = 60
End
Begin VB.Label lblVersion
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Version 1.0"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 210
Left = 2850
TabIndex = 5
Top = 2190
Width = 1335
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "档案管理系统"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 285
Left = 2280
TabIndex = 4
Top = 780
Width = 1800
End
Begin VB.Label lblUserInfo
BackStyle = 0 'Transparent
Caption = "User information"
ForeColor = &H00800000&
Height = 495
Left = 1500
TabIndex = 2
Top = 3630
Width = 2745
End
Begin VB.Label lblLicense
BackStyle = 0 'Transparent
Caption = "该软件授权:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 225
Left = 1500
TabIndex = 1
Top = 3345
Width = 2745
End
Begin VB.Label lblTitle
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 36
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 720
Index = 0
Left = 3315
TabIndex = 0
Top = 1215
Width = 405
End
Begin VB.Label lblTitle
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 36
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00E0E0E0&
Height = 720
Index = 1
Left = 3375
TabIndex = 3
Top = 1245
Width = 405
End
Begin VB.Image imgLogo
Height = 4575
Left = 0
Picture = "frmSplash.frx":199E
Stretch = -1 'True
Top = 0
Width = 7185
End
End
Attribute VB_Name = "frmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Private variables to store property values
Private mlDelay As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const API_SUCCESS = 0
Const KEY_QUERY_VALUE = &H1
Const REG_SZ = 1
Private Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByVal lpData As String, _
ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" _
(ByVal hKey As Long) As Long
Private Sub Form_Click()
Call tmrUnload_Timer
End Sub
Private Sub Form_Load()
Dim tTempStr As String
' Clear the splash form icon
Me.Icon = LoadPicture()
' Get the program title
'lblTitle(0).Caption = App.Title
'lblTitle(1).Caption = App.Title
' Get the company name
'lblCompany.Caption = App.CompanyName
' Get the version information
'If App.Revision = 0 Then
' lblVersion.Caption = "版 本: " & App.Major & _
' "." & App.Minor
' Else
' lblVersion.Caption = "Version " & App.Major & _
' "." & App.Minor & _
' "." & App.Revision
'End If
'XC ADDED
'lblVersion.Caption = "Version " & App.Major & _
"." & App.Minor & _
"." & App.Revision
' Load the license caption with the name of the registered
' user and company for this copy of the operating system
' Get the user name
tTempStr = GetRegString(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion", _
"RegisteredOwner")
'If Len(tTempStr) <> 0 Then
'lblUserInfo.Caption = tTempStr & vbCrLf
'Else
'lblUserInfo.Caption = "No user name available" & vbCrLf
'End If
' Get the company name
tTempStr = GetRegString(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion", _
"RegisteredOrganization")
If Len(tTempStr) <> 0 Then
'lblUserInfo.Caption = lblUserInfo.Caption & tTempStr
End If
End Sub
Private Function GetRegString _
(lRegRoot As Long, _
sRegKey As String, _
sSubKey As String) As String
Dim hRegKey As Long
Dim lResult As Long
Dim lValueSize As Long
Dim lValueType As Long
Dim tTempStr As String
Const REG_SZ = 1
GetRegString = ""
' Open the registry key we want to check
lResult = RegOpenKeyEx(lRegRoot, _
sRegKey, _
0&, _
KEY_QUERY_VALUE, _
hRegKey)
' Make sure we did not get an error
If lResult = API_SUCCESS Then
' Get the length of the value string
lResult = RegQueryValueEx(hRegKey, _
sSubKey, _
0&, _
lValueType, _
ByVal 0&, _
lValueSize)
' Make sure it is a string value type
If lValueType = REG_SZ Then
' Initialize the variable to hold the string
tTempStr = String(lValueSize, " ")
' Get the value from the registry
lResult = RegQueryValueEx(hRegKey, _
sSubKey, _
0&, 0&, _
ByVal tTempStr, _
lValueSize)
If lResult = API_SUCCESS Then
GetRegString = Left$(tTempStr, _
InStr(tTempStr, vbNullChar) - 1)
End If
End If
' Close the registry key
lResult = RegCloseKey(hRegKey)
End If
End Function
Private Sub Form_Paint()
Dim lReturn As Long
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
' Set this form to stay on top of the other
' forms in the program
lReturn = SetWindowPos(frmSplash.hwnd, _
HWND_TOPMOST, _
0, 0, 0, 0, _
FLAGS)
' Enable the timer now, so that it only starts
' counting down the time while the form is visible
If tmrUnload.Enabled = False Then
tmrUnload.Enabled = True
End If
End Sub
Private Sub imgLogo_Click()
Call tmrUnload_Timer
End Sub
Private Sub lblCompany_Click()
Call tmrUnload_Timer
End Sub
Private Sub lblCopyright_Click()
Call tmrUnload_Timer
End Sub
Private Sub lblLicense_Click()
Call tmrUnload_Timer
End Sub
Private Sub lblTitle_Click(Index As Integer)
Call tmrUnload_Timer
End Sub
Private Sub lblUserInfo_Click()
Call tmrUnload_Timer
End Sub
Private Sub lblVersion_Click()
Call tmrUnload_Timer
End Sub
Private Sub tmrUnload_Timer()
Unload frmSplash
End Sub
Public Property Get Delay() As Long
Delay = mlDelay
End Property
Public Property Let Delay(ByVal lDelay As Long)
' Save the property value
mlDelay = lDelay
' Perform a range check on the lower limit
If mlDelay < 1000 Then
mlDelay = 1000
End If
' Perform a range check on the upper limit
If mlDelay > 60000 Then
mlDelay = 60000
End If
' Set the timer interval from the property
tmrUnload.Interval = mlDelay
End Property
Public Property Let LogoPicture(ByVal sLogoPicture As String)
' If the picture files exists, load it
If Dir$(sLogoPicture) <> "" Then
imgLogo.Picture = LoadPicture(sLogoPicture)
End If
End Property
Public Property Let BackPicture(ByVal sBackPicture As String)
' If the picture files exists, load it
If Dir$(sBackPicture) <> "" Then
frmSplash.Picture = LoadPicture(sBackPicture)
End If
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -