📄 frmsplash.frm
字号:
VERSION 5.00
Begin VB.Form frmSplash
BorderStyle = 1 'Fixed Single
ClientHeight = 4290
ClientLeft = 1800
ClientTop = 2250
ClientWidth = 7035
ClipControls = 0 'False
ControlBox = 0 'False
Icon = "frmSplash.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4290
ScaleWidth = 7035
StartUpPosition = 2 '屏幕中心
Begin VB.Timer tmrUnload
Enabled = 0 'False
Interval = 10000
Left = 720
Top = 2730
End
Begin VB.Label lblCopyright
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "正在连接数据库..."
ForeColor = &H00000000&
Height = 180
Left = 2745
TabIndex = 7
Top = 3885
Width = 1530
End
Begin VB.Label lblVersion
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Version"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 210
Left = 3075
TabIndex = 6
Top = 2340
Width = 885
End
Begin VB.Label lblCustomName
Alignment = 2 'Center
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 = 1080
TabIndex = 5
Top = 1095
Width = 4875
End
Begin VB.Label lblCompany
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Company Name"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 315
Left = 2010
TabIndex = 3
Top = 3600
Width = 4605
End
Begin VB.Shape Shape1
BorderColor = &H00808080&
BorderWidth = 2
Height = 4110
Index = 1
Left = 105
Top = 105
Visible = 0 'False
Width = 6855
End
Begin VB.Shape Shape1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Height = 4110
Index = 0
Left = 135
Top = 120
Visible = 0 'False
Width = 6855
End
Begin VB.Label lblUserInfo
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "User information"
ForeColor = &H00000000&
Height = 495
Left = 3870
TabIndex = 2
Top = 630
Width = 2745
End
Begin VB.Label lblLicense
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "该软件授权:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 225
Left = 4080
TabIndex = 1
Top = 375
Width = 2745
End
Begin VB.Label lblTitle
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Application Title"
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 525
Index = 0
Left = 1080
TabIndex = 0
Top = 1485
Width = 4875
End
Begin VB.Label lblTitle
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Application Title"
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00E0E0E0&
Height = 525
Index = 1
Left = 1125
TabIndex = 4
Top = 1515
Width = 4875
End
Begin VB.Image imgLogo
Height = 4035
Left = 120
Picture = "frmSplash.frx":000C
Stretch = -1 'True
Top = 120
Width = 6810
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
' 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
'set the TOPMOST
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
' Clear the splash form icon
Me.Icon = LoadPicture()
' Get the program title
'lblTitle(0).Caption = App.Title
'lblTitle(1).Caption = App.Title
lblCustomName = CUSTOMCOMPANYNAME
lblTitle(0).Caption = PROGRAMTITLE
lblTitle(1).Caption = PROGRAMTITLE
' Get the company name
'lblCompany.Caption = App.COMPANYNAME
lblCompany.Caption = 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 = VERSIONTYPE
' 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()
' 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 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 + -