⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 configform.vb

📁 一个用vb开发的档案管理程序
💻 VB
📖 第 1 页 / 共 2 页
字号:
		Me._CC_5.HideSelection = True
		Me._CC_5.ReadOnly = False
		Me._CC_5.Cursor = System.Windows.Forms.Cursors.IBeam
		Me._CC_5.MultiLine = False
		Me._CC_5.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me._CC_5.ScrollBars = System.Windows.Forms.ScrollBars.None
		Me._CC_5.TabStop = True
		Me._CC_5.Visible = True
		Me._CC_5.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
		Me._CC_5.Name = "_CC_5"
		Me.Label2.Text = "桌面图片文件路径及名称"
		Me.Label2.ForeColor = System.Drawing.Color.FromARGB(128, 0, 0)
		Me.Label2.Size = New System.Drawing.Size(132, 12)
		Me.Label2.Location = New System.Drawing.Point(111, 55)
		Me.Label2.TabIndex = 13
		Me.Label2.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label2.BackColor = System.Drawing.SystemColors.Control
		Me.Label2.Enabled = True
		Me.Label2.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label2.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label2.UseMnemonic = True
		Me.Label2.Visible = True
		Me.Label2.AutoSize = True
		Me.Label2.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label2.Name = "Label2"
		Me.Frame1.Text = "公司名称"
		Me.Frame1.Size = New System.Drawing.Size(296, 59)
		Me.Frame1.Location = New System.Drawing.Point(12, 44)
		Me.Frame1.TabIndex = 11
		Me.Frame1.BackColor = System.Drawing.SystemColors.Control
		Me.Frame1.Enabled = True
		Me.Frame1.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Frame1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Frame1.Visible = True
		Me.Frame1.Name = "Frame1"
		Me._CC_0.AutoSize = False
		Me._CC_0.Size = New System.Drawing.Size(276, 19)
		Me._CC_0.Location = New System.Drawing.Point(12, 25)
		Me._CC_0.Maxlength = 40
		Me._CC_0.TabIndex = 0
		Me._CC_0.AcceptsReturn = True
		Me._CC_0.TextAlign = System.Windows.Forms.HorizontalAlignment.Left
		Me._CC_0.BackColor = System.Drawing.SystemColors.Window
		Me._CC_0.CausesValidation = True
		Me._CC_0.Enabled = True
		Me._CC_0.ForeColor = System.Drawing.SystemColors.WindowText
		Me._CC_0.HideSelection = True
		Me._CC_0.ReadOnly = False
		Me._CC_0.Cursor = System.Windows.Forms.Cursors.IBeam
		Me._CC_0.MultiLine = False
		Me._CC_0.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me._CC_0.ScrollBars = System.Windows.Forms.ScrollBars.None
		Me._CC_0.TabStop = True
		Me._CC_0.Visible = True
		Me._CC_0.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
		Me._CC_0.Name = "_CC_0"
		Me.Picture1.BackColor = System.Drawing.Color.FromARGB(0, 128, 128)
		Me.Picture1.Size = New System.Drawing.Size(418, 28)
		Me.Picture1.Location = New System.Drawing.Point(-1, -1)
		Me.Picture1.TabIndex = 9
		Me.Picture1.Dock = System.Windows.Forms.DockStyle.None
		Me.Picture1.CausesValidation = True
		Me.Picture1.Enabled = True
		Me.Picture1.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Picture1.Cursor = System.Windows.Forms.Cursors.Default
		Me.Picture1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Picture1.TabStop = True
		Me.Picture1.Visible = True
		Me.Picture1.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
		Me.Picture1.Name = "Picture1"
		Me.Label1.Text = "为 了 方 便 使 用 , 请 认 真 配 置 系 统 。"
		Me.Label1.ForeColor = System.Drawing.Color.White
		Me.Label1.Size = New System.Drawing.Size(264, 12)
		Me.Label1.Location = New System.Drawing.Point(70, 6)
		Me.Label1.TabIndex = 10
		Me.Label1.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label1.BackColor = System.Drawing.Color.Transparent
		Me.Label1.Enabled = True
		Me.Label1.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label1.UseMnemonic = True
		Me.Label1.Visible = True
		Me.Label1.AutoSize = True
		Me.Label1.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label1.Name = "Label1"
		Me.Controls.Add(Data1)
		Me.Controls.Add(Picture2)
		Me.Controls.Add(CancelExit)
		Me.Controls.Add(OkSave)
		Me.Controls.Add(Frame3)
		Me.Controls.Add(Frame1)
		Me.Controls.Add(Picture1)
		Me.Picture2.Controls.Add(_CC_4)
		Me.Picture2.Controls.Add(_CC_3)
		Me.Picture2.Controls.Add(_CC_2)
		Me.Picture2.Controls.Add(_CC_1)
		Me.Picture2.Controls.Add(_Label3_3)
		Me.Picture2.Controls.Add(_Label3_2)
		Me.Picture2.Controls.Add(_Label3_1)
		Me.Picture2.Controls.Add(_Label3_0)
		Me.Frame3.Controls.Add(Command1)
		Me.Frame3.Controls.Add(_CC_5)
		Me.Frame3.Controls.Add(Label2)
		Me.Frame1.Controls.Add(_CC_0)
		Me.Picture1.Controls.Add(Label1)
		Me.CC.SetIndex(_CC_4, CType(4, Short))
		Me.CC.SetIndex(_CC_3, CType(3, Short))
		Me.CC.SetIndex(_CC_2, CType(2, Short))
		Me.CC.SetIndex(_CC_1, CType(1, Short))
		Me.CC.SetIndex(_CC_5, CType(5, Short))
		Me.CC.SetIndex(_CC_0, CType(0, Short))
		Me.Label3.SetIndex(_Label3_3, CType(3, Short))
		Me.Label3.SetIndex(_Label3_2, CType(2, Short))
		Me.Label3.SetIndex(_Label3_1, CType(1, Short))
		Me.Label3.SetIndex(_Label3_0, CType(0, Short))
		CType(Me.Label3, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.CC, System.ComponentModel.ISupportInitialize).EndInit()
	End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As ConfigForm
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As ConfigForm
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New ConfigForm()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	Dim PhotoFile As String
	
	Private Sub CancelExit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CancelExit.Click
		
		Me.Close()
		
	End Sub
	
	Private Sub CC_Enter(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CC.Enter
		Dim Index As Short = CC.GetIndex(eventSender)
		
		CC(Index).BackColor = System.Drawing.ColorTranslator.FromOle(&HFF0000)
		CC(Index).ForeColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		CC(Index).SelectionStart = 0
		CC(Index).SelectionLength = Len(Trim(CC(Index).Text))
		
	End Sub
	
	Private Sub CC_KeyDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyEventArgs) Handles CC.KeyDown
		Dim KeyCode As Short = eventArgs.KeyCode
		Dim Shift As Short = eventArgs.KeyData \ &H10000
		Dim Index As Short = CC.GetIndex(eventSender)
		
		If KeyCode = 38 Then
			If Index > 0 Then
				CC(Index - 1).Focus()
			End If
		End If
		If KeyCode = 40 Then
			If Index < 5 Then
				CC(Index + 1).Focus()
			End If
		End If
		
	End Sub
	
	Private Sub CC_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles CC.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		Dim Index As Short = CC.GetIndex(eventSender)
		
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{tab}")
			GoTo EventExitSub
		End If
		
EventExitSub: 
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub CC_Leave(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles CC.Leave
		Dim Index As Short = CC.GetIndex(eventSender)
		
		CC(Index).BackColor = System.Drawing.ColorTranslator.FromOle(&HFFFFFF)
		CC(Index).ForeColor = System.Drawing.ColorTranslator.FromOle(&H0s)
		If InStr(1, CC(Index).Text, "'", CompareMethod.Text) Then
			MsgBox("该项目之中有特殊字符" & "<'>,请删除。", MsgBoxStyle.OKOnly + 48, "提示:")
			CC(Index).Focus()
		End If
		
	End Sub
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		
		ConfigForm.DefInstance.Cursor = System.Windows.Forms.Cursors.WaitCursor
		'UPGRADE_ISSUE: 不支持 Load 语句。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1039"'
		Load(SelectFile)
		SelectFile.DefInstance.ShowDialog()
		ConfigForm.DefInstance.Cursor = System.Windows.Forms.Cursors.Default
		
	End Sub
	
	Private Sub ConfigForm_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		Me.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "ConfigForm", "Left")))
		Me.Top = VB6.TwipsToPixelsY(Val(GetSetting(VB6.GetExeName(), "ConfigForm", "Top")))
		
		'UPGRADE_WARNING: Dir 有新行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1041"'
		Dim i As Short
		If Dir(ConData) = "" Then
			MsgBox("配置文件数据库没有找到,请与程序员联系!", MsgBoxStyle.OKOnly + 16, "配置出错")
			For i = 0 To 5
				CC(i).Enabled = False
			Next 
			OkSave.Enabled = False
			Command1.Enabled = False
			Exit Sub
		End If
		'设置原来配置
		'配置
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		Dim X As Short
		Dim TempArray(5) As String
		On Error GoTo NoData
		'阅读配置数据
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		EF = DB.OpenRecordset("Config", DAO.RecordsetTypeEnum.dbOpenDynaset)
		' Ef.MoveFirst
		For X = 0 To 5
			'UPGRADE_WARNING: 检测到使用了 Null/IsNull()。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1049"'
			If Not IsDbNull(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("数据出错,请与设计者联系!", MsgBoxStyle.OKOnly + 16, "警告!")
	End Sub
	
	'UPGRADE_WARNING: Form 事件 ConfigForm.Unload 具有新的行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub ConfigForm_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		SaveSetting(VB6.GetExeName(), "ConfigForm", "Left", CStr(VB6.PixelsToTwipsX(Me.Left)))
		SaveSetting(VB6.GetExeName(), "ConfigForm", "Top", CStr(VB6.PixelsToTwipsY(Me.Top)))
		
	End Sub
	
	Private Sub OkSave_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles OkSave.Click
		
		Dim OriginalFile As Boolean
		OriginalFile = False
		If Trim(CC(0).Text) = "" Then
			CC(0).Text = "FreeLong软件开发工作室"
			MsgBox("没有配置公司名称,系统将以缺省的公司名称!", MsgBoxStyle.OKOnly + 32, "没有填写公司名称")
		End If
		If Trim(CC(5).Text) = "" Then
			MsgBox("没有配置桌面图片文件,桌面将不显示图片!", MsgBoxStyle.OKOnly + 32, "没有图片")
		End If
		
		'在这里只作简单的判断文件是否存在
		'UPGRADE_WARNING: Dir 有新行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1041"'
		If Dir(Trim(CC(5).Text)) = "" Then
			MsgBox("配置的图片文件不存在,系统将以缺省的图片放置!", MsgBoxStyle.OKOnly + 48, "文件没有找到")
			CC(5).Text = PhotoFile
			OriginalFile = True
		End If
		On Error GoTo Novalib
		ConfigForm.DefInstance.Cursor = System.Windows.Forms.Cursors.WaitCursor
		'UPGRADE_WARNING: MDIForm 属性 frmMain.Picture 具有新的行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
		frmMain.DefInstance.BackgroundImage = System.Drawing.Image.FromFile(CC(5).Text)
		On Error GoTo 0
		'Save data to database
		Dim DB As DAO.Database
		Dim EF As DAO.Recordset
		Dim X As Short
		Dim 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
		
		DAODBEngine_definst.BeginTrans()
		DB = DAODBEngine_definst.OpenDatabase(ConData, False, False, ConStr)
		'Delete original config
		DB.Execute("Delete * From Config")
		DB.Execute(tempStr)
		DB.Close()
		DAODBEngine_definst.CommitTrans()
		'Application set value
		'frmMain.Caption = CC(0).Text + "-档案管理系统"
		frmMain.DefInstance.StatusBar.Panels.Item(6).Text = "制作单位:" & CC(0).Text
		frmMain.DefInstance.StatusBar.Panels.Item(6).ToolTipText = "欢迎使用本软件"
		ConfigForm.DefInstance.Cursor = System.Windows.Forms.Cursors.Default
		Me.Close()
		Exit Sub
		
Novalib: 
		MsgBox("无效的图片文件,支持 BMP、WMF、ICO、JPG、GIF、" & Chr(10) & Chr(13) & Chr(13) & "EMF、RLE 文件类型!系统不能安装 " & CC(5).Text & " 图片!", MsgBoxStyle.OKOnly + 32, "图片错误")
		
		'缺省的图片错误时,不加载
		If OriginalFile = False Then
			'UPGRADE_WARNING: MDIForm 属性 frmMain.Picture 具有新的行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
			frmMain.DefInstance.BackgroundImage = System.Drawing.Image.FromFile(PhotoFile)
		Else
			'UPGRADE_WARNING: MDIForm 属性 frmMain.Picture 具有新的行为。 单击以获得更多信息:'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
			frmMain.DefInstance.BackgroundImage = Nothing
		End If
		CC(5).Focus()
		CC(5).SelectionStart = 0
		CC(5).SelectionLength = Len(Trim(CC(5).Text))
		ConfigForm.DefInstance.Cursor = System.Windows.Forms.Cursors.Default
		Exit Sub
	End Sub
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -