📄 configform.frm
字号:
VERSION 5.00
Begin VB.Form ConfigForm
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "系统配置"
ClientHeight = 4500
ClientLeft = 45
ClientTop = 330
ClientWidth = 6240
ControlBox = 0 'False
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4500
ScaleWidth = 6240
ShowInTaskbar = 0 'False
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 315
Left = -1200
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 4200
Width = 1140
End
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
Height = 1275
Left = 180
ScaleHeight = 1215
ScaleWidth = 5805
TabIndex = 14
Top = 1665
Width = 5865
Begin VB.TextBox CC
Height = 270
Index = 4
Left = 1080
MaxLength = 40
TabIndex = 4
Top = 825
Width = 4560
End
Begin VB.TextBox CC
Height = 270
Index = 3
Left = 4170
MaxLength = 5
TabIndex = 3
Top = 465
Width = 1470
End
Begin VB.TextBox CC
Height = 270
Index = 2
Left = 1095
MaxLength = 40
TabIndex = 2
Top = 480
Width = 1980
End
Begin VB.TextBox CC
Height = 270
Index = 1
Left = 1095
MaxLength = 40
TabIndex = 1
Top = 135
Width = 4545
End
Begin VB.Label Label3
Caption = "负责人："
Height = 180
Index = 3
Left = 3360
TabIndex = 18
Top = 510
Width = 795
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "公司地址："
Height = 180
Index = 2
Left = 180
TabIndex = 17
Top = 840
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "公司传真："
Height = 180
Index = 1
Left = 180
TabIndex = 16
Top = 510
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "公司电话："
Height = 180
Index = 0
Left = 180
TabIndex = 15
Top = 165
Width = 900
End
End
Begin VB.CommandButton CancelExit
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 4860
TabIndex = 8
Top = 1155
Width = 1185
End
Begin VB.CommandButton OkSave
Caption = "保存(&S)"
Height = 375
Left = 4860
TabIndex = 7
Top = 750
Width = 1185
End
Begin VB.Frame Frame3
Caption = "系统桌面"
Height = 1200
Left = 195
TabIndex = 12
Top = 3090
Width = 5835
Begin VB.CommandButton Command1
Caption = "选择图片"
Height = 390
Left = 210
TabIndex = 6
Top = 720
Width = 1080
End
Begin VB.TextBox CC
Height = 300
Index = 5
Left = 210
MaxLength = 100
TabIndex = 5
Top = 345
Width = 5415
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "桌面图片文件路径及名称"
ForeColor = &H00000080&
Height = 180
Left = 1665
TabIndex = 13
Top = 825
Width = 1980
End
End
Begin VB.Frame Frame1
Caption = "公司名称"
Height = 885
Left = 180
TabIndex = 11
Top = 660
Width = 4440
Begin VB.TextBox CC
Height = 285
Index = 0
Left = 180
MaxLength = 40
TabIndex = 0
Top = 375
Width = 4140
End
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H00808000&
Height = 420
Left = -15
ScaleHeight = 360
ScaleWidth = 6210
TabIndex = 9
Top = -15
Width = 6270
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "为 了 方 便 使 用 ， 请 认 真 配 置 系 统 。"
ForeColor = &H00FFFFFF&
Height = 180
Left = 1050
TabIndex = 10
Top = 90
Width = 3960
End
End
End
Attribute VB_Name = "ConfigForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim PhotoFile As String
Private Sub CancelExit_Click()
Unload Me
End Sub
Private Sub CC_GotFocus(Index As Integer)
CC(Index).BackColor = &HFF0000
CC(Index).ForeColor = &HFFFFFF
CC(Index).SelStart = 0
CC(Index).SelLength = Len(Trim(CC(Index).Text))
End Sub
Private Sub CC_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
If Index > 0 Then
CC(Index - 1).SetFocus
End If
End If
If KeyCode = 40 Then
If Index < 5 Then
CC(Index + 1).SetFocus
End If
End If
End Sub
Private Sub CC_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
Exit Sub
End If
End Sub
Private Sub CC_LostFocus(Index As Integer)
CC(Index).BackColor = &HFFFFFF
CC(Index).ForeColor = &H0
If InStr(1, CC(Index).Text, "'", vbTextCompare) Then
MsgBox "该项目之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
CC(Index).SetFocus
End If
End Sub
Private Sub Command1_Click()
ConfigForm.MousePointer = 11
Load SelectFile
SelectFile.Show 1
ConfigForm.MousePointer = 0
End Sub
Private Sub Form_Load()
Me.Left = Val(GetSetting(App.EXEName, "ConfigForm", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "ConfigForm", "Top"))
If Dir(ConData) = "" Then
MsgBox "配置文件数据库没有找到，请与程序员联系！", vbOKOnly + 16, "配置出错"
Dim i As Integer
For i = 0 To 5
CC(i).Enabled = False
Next
OkSave.Enabled = False
Command1.Enabled = False
Exit Sub
End If
'设置原来配置
'配置
Dim DB As Database, EF As Recordset, X As Integer
Dim TempArray(5) As String
On Error GoTo NoData
'阅读配置数据
Set DB = OpenDatabase(ConData, False, False, ConStr)
Set EF = DB.OpenRecordset("Config", dbOpenDynaset)
' Ef.MoveFirst
For X = 0 To 5
If Not IsNull(EF.Fields(X).Value) Then
TempArray(X) = EF.Fields(X).Value
Else
TempArray(X) = ""
End If
Next
DB.Close
'因为字段与Index不符
For X = 0 To 5
Select Case X
Case 1
CC(1).Text = TempArray(2)
Case 2
CC(2).Text = TempArray(3)
Case 3
CC(3).Text = TempArray(4)
Case 4
CC(4).Text = TempArray(1)
Case Else
CC(X).Text = TempArray(X)
End Select
Next
PhotoFile = CC(5).Text
Exit Sub
NoData:
MsgBox "数据出错,请与设计者联系!", vbOKOnly + 16, "警告!"
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "ConfigForm", "Left", Me.Left
SaveSetting App.EXEName, "ConfigForm", "Top", Me.Top
End Sub
Private Sub OkSave_Click()
Dim OriginalFile As Boolean
OriginalFile = False
If Trim(CC(0).Text) = "" Then
CC(0).Text = "FreeLong软件开发工作室"
MsgBox "没有配置公司名称,系统将以缺省的公司名称!", vbOKOnly + 32, "没有填写公司名称"
End If
If Trim(CC(5).Text) = "" Then
MsgBox "没有配置桌面图片文件,桌面将不显示图片!", vbOKOnly + 32, "没有图片"
End If
'在这里只作简单的判断文件是否存在
If Dir(Trim(CC(5).Text)) = "" Then
MsgBox "配置的图片文件不存在,系统将以缺省的图片放置!", vbOKOnly + 48, "文件没有找到"
CC(5).Text = PhotoFile
OriginalFile = True
End If
On Error GoTo Novalib
ConfigForm.MousePointer = 11
frmMain.Picture = LoadPicture(CC(5).Text)
On Error GoTo 0
'Save data to database
Dim DB As Database, EF As Recordset, X As Integer, tempStr As String
X = 0
For X = 0 To 5
If X < 5 Then
tempStr = tempStr + "'" + CC(X).Text + "',"
Else
tempStr = tempStr + "'" + CC(X).Text + "'"
End If
Next
tempStr = " Values (" + tempStr + ")"
tempStr = "Insert into Config (公司名称,公司电话,公司传真,负责人,公司地址,桌面图片路径)" + tempStr
DBEngine.BeginTrans
Set DB = OpenDatabase(ConData, False, False, ConStr)
'Delete original config
DB.Execute "Delete * From Config"
DB.Execute tempStr
DB.Close
DBEngine.CommitTrans
'Application set value
'frmMain.Caption = CC(0).Text + "-档案管理系统"
frmMain.StatusBar.Panels.Item(6).Text = "制作单位：" + CC(0).Text
frmMain.StatusBar.Panels.Item(6).ToolTipText = "欢迎使用本软件"
ConfigForm.MousePointer = 0
Unload Me
Exit Sub
Novalib:
MsgBox "无效的图片文件,支持 BMP、WMF、ICO、JPG、GIF、" & Chr(10) & Chr(13) & Chr(13) & "EMF、RLE 文件类型!系统不能安装 " & CC(5).Text & " 图片！", vbOKOnly + 32, "图片错误"
'缺省的图片错误时，不加载
If OriginalFile = False Then
frmMain.Picture = LoadPicture(PhotoFile)
Else
frmMain.Picture = LoadPicture()
End If
CC(5).SetFocus
CC(5).SelStart = 0
CC(5).SelLength = Len(Trim(CC(5).Text))
ConfigForm.MousePointer = 0
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -