frmtip.vb

一个用vb开发的档案管理程序

		Me._Line1_2.BackColor = System.Drawing.Color.FromARGB(224, 224, 224)
		Me._Line1_2.Visible = True
		Me._Line1_2.Location = New System.Drawing.Point(0, 213)
		Me._Line1_2.Width = 360
		Me._Line1_2.Height = 1
		Me._Line1_2.Name = "_Line1_2"
		Me._Line1_3.BackColor = System.Drawing.Color.FromARGB(128, 128, 128)
		Me._Line1_3.Visible = True
		Me._Line1_3.Location = New System.Drawing.Point(1, 212)
		Me._Line1_3.Width = 359
		Me._Line1_3.Height = 1
		Me._Line1_3.Name = "_Line1_3"
		Me._Line2_0.BackColor = System.Drawing.Color.FromARGB(128, 128, 128)
		Me._Line2_0.Visible = True
		Me._Line2_0.Location = New System.Drawing.Point(1, 0)
		Me._Line2_0.Width = 1
		Me._Line2_0.Height = 214
		Me._Line2_0.Name = "_Line2_0"
		Me._Line3_0.BackColor = System.Drawing.Color.FromARGB(224, 224, 224)
		Me._Line3_0.Visible = True
		Me._Line3_0.Location = New System.Drawing.Point(2, 1)
		Me._Line3_0.Width = 1
		Me._Line3_0.Height = 213
		Me._Line3_0.Name = "_Line3_0"
		Me._Line2_1.BackColor = System.Drawing.Color.FromARGB(128, 128, 128)
		Me._Line2_1.Visible = True
		Me._Line2_1.Location = New System.Drawing.Point(359, 0)
		Me._Line2_1.Width = 1
		Me._Line2_1.Height = 213
		Me._Line2_1.Name = "_Line2_1"
		Me._Line3_1.BackColor = System.Drawing.Color.FromARGB(224, 224, 224)
		Me._Line3_1.Visible = True
		Me._Line3_1.Location = New System.Drawing.Point(360, 0)
		Me._Line3_1.Width = 1
		Me._Line3_1.Height = 213
		Me._Line3_1.Name = "_Line3_1"
		Me.Controls.Add(cmdNextTip)
		Me.Controls.Add(Picture1)
		Me.Controls.Add(cmdOK)
		Me.Controls.Add(_Line1_0)
		Me.Controls.Add(_Line1_1)
		Me.Controls.Add(_Line1_2)
		Me.Controls.Add(_Line1_3)
		Me.Controls.Add(_Line2_0)
		Me.Controls.Add(_Line3_0)
		Me.Controls.Add(_Line2_1)
		Me.Controls.Add(_Line3_1)
		Me.Picture1.Controls.Add(chkLoadTipsAtStartup)
		Me.Picture1.Controls.Add(Line4)
		Me.Picture1.Controls.Add(Label2)
		Me.Picture1.Controls.Add(Label1)
		Me.Picture1.Controls.Add(lblTipText)
		Me.Line1.SetIndex(_Line1_0, CType(0, Short))
		Me.Line1.SetIndex(_Line1_1, CType(1, Short))
		Me.Line1.SetIndex(_Line1_2, CType(2, Short))
		Me.Line1.SetIndex(_Line1_3, CType(3, Short))
		Me.Line2.SetIndex(_Line2_0, CType(0, Short))
		Me.Line2.SetIndex(_Line2_1, CType(1, Short))
		Me.Line3.SetIndex(_Line3_0, CType(0, Short))
		Me.Line3.SetIndex(_Line3_1, CType(1, Short))
		CType(Me.Line3, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.Line2, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.Line1, System.ComponentModel.ISupportInitialize).EndInit()
	End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As frmTip
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As frmTip
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New frmTip()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	
	' 技巧的数据库。
	Dim Tips As New Collection
	
	' 技巧文件名称。
	Const TIP_FILE As String = "File.Wxy"
	
	' 当前被显示的技巧集合索引。
	Dim CurrentTip As Integer
	
	
	Private Sub DoNextTip()
		
		' 随机选择一个技巧。
		CurrentTip = Int((Tips.Count() * Rnd()) + 1)
		
		' 或者，按顺序在所有技巧中循环选择。
		
		'    CurrentTip = CurrentTip + 1
		'    If Tips.Count < CurrentTip Then
		'        CurrentTip = 1
		'    End If
		
		' 显示。
		frmTip.DefInstance.DisplayCurrentTip()
		
	End Sub
	
	Function LoadTips(ByRef sFile As String) As Boolean
		Dim NextTip As String ' 从文件读取每一个技巧。
		Dim InFile As Short ' 文件描述符。
		
		' 获得下一个空文件描述符。
		InFile = FreeFile
		
		' 确保一个文件被指定。
		If sFile = "" Then
			LoadTips = False
			Exit Function
		End If
		
		' 试图打开一个文件前，确保该文件存在。
		'UPGRADE_WARNING: Dir 有新行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1041"'
		If Dir(sFile) = "" Then
			LoadTips = False
			Exit Function
		End If
		
		' 从文本文件读取该集合。
		FileOpen(InFile, sFile, OpenMode.Input)
		While Not EOF(InFile)
			NextTip = LineInput(InFile)
			Tips.Add(NextTip)
		End While
		FileClose(InFile)
		
		' 随机显示一个技巧。
		DoNextTip()
		
		LoadTips = True
		
	End Function
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 chkLoadTipsAtStartup.CheckStateChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub chkLoadTipsAtStartup_CheckStateChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles chkLoadTipsAtStartup.CheckStateChanged
		' 保存启动时该窗体是否显示。
		SaveSetting(VB6.GetExeName(), "Options", "Show Tips at Startup", CStr(chkLoadTipsAtStartup.CheckState))
	End Sub
	
	Private Sub chkLoadTipsAtStartup_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles chkLoadTipsAtStartup.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		GetStatus("选定时,系统启动时加载,否则不加载")
	End Sub
	
	Private Sub cmdNextTip_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdNextTip.Click
		DoNextTip()
	End Sub
	
	Private Sub cmdNextTip_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles cmdNextTip.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		GetStatus("显示下一条帮助信息")
	End Sub
	
	Private Sub cmdOK_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdOK.Click
		Me.Close()
	End Sub
	
	Private Sub cmdOK_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles cmdOK.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		GetStatus("保存设置并返回")
	End Sub
	
	Private Sub frmTip_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		frmTip.DefInstance.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "Tip", "Left")))
		frmTip.DefInstance.Top = VB6.TwipsToPixelsY(Val(GetSetting(VB6.GetExeName(), "Tip", "Top")))
		
		Me.chkLoadTipsAtStartup.CheckState = System.Windows.Forms.CheckState.Checked
		' 为 Rnd 重置种子
		Randomize()
		' 读技巧文件并随机显示一个技巧。
		If LoadTips(VB6.GetPath & "\" & TIP_FILE) = False Then
			lblTipText.Text = "" & TIP_FILE & " 文件未找到？" & vbCrLf & vbCrLf & "使用记事本，创建一个名为 " & TIP_FILE & " 的文本文件，其中每行一个技巧。 " & "然后，放在应用程序所在目录下。"
		End If
		
		
	End Sub
	
	Public Sub DisplayCurrentTip()
		If Tips.Count() > 0 Then
			'UPGRADE_WARNING: 未能解析对象 Tips.Item() 的默认属性。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1037"'
			lblTipText.Text = Tips.Item(CurrentTip)
		End If
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmTip.Unload 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub frmTip_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		SaveSetting(VB6.GetExeName(), "Tip", "Left", CStr(VB6.PixelsToTwipsX(Me.Left)))
		SaveSetting(VB6.GetExeName(), "Tip", "Top", CStr(VB6.PixelsToTwipsY(Me.Top)))
		
	End Sub
	
	Private Sub Label2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Label2.Click
		Dim Rok As Double
		Rok = Shell("notepad.exe " & Browser & "Readme.txt", AppWinStyle.NormalFocus)
		If Rok = 0 Then
			MsgBox("Windows 的 Notepad 没有安装!", MsgBoxStyle.OKOnly + 16, "错误")
			Exit Sub
		End If
	End Sub
	
	Private Sub Label2_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles Label2.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		GetStatus("单击打开系统的自述文件")
	End Sub
	
	Private Sub lblTipText_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles lblTipText.MouseMove
		Dim Button As Short = eventArgs.Button \ &H100000
		Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
		Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
		Dim y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
		GetStatus("帮助信息显示处")
	End Sub
End Class