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

📄 selectfile.vb

📁 一个用vb开发的档案管理程序
💻 VB
📖 第 1 页 / 共 3 页
字号:
🔍
123 
				DisplayPicture.SizeMode = System.Windows.Forms.PictureBoxSizeMode.Normal
				HScroll1.Value = 0
				VScroll1.Value = 0
				HScroll1.Maximum = (VB6.PixelsToTwipsX(DisplayPicture.Width) - VB6.PixelsToTwipsX(Picture1.Width) + 280 + HScroll1.LargeChange - 1)
				VScroll1.Maximum = (VB6.PixelsToTwipsY(DisplayPicture.Height) - VB6.PixelsToTwipsY(Picture1.Height) + 280 + VScroll1.LargeChange - 1)
				VScroll1.Visible = VB6.PixelsToTwipsY(Picture1.Height) < VB6.PixelsToTwipsY(DisplayPicture.Height)
				HScroll1.Visible = VB6.PixelsToTwipsX(Picture1.Width) < VB6.PixelsToTwipsX(DisplayPicture.Width)
				If HScroll1.Visible Or VScroll1.Visible Then
					Command3.Visible = True
				Else
					Command3.Visible = False
				End If
			Else
				DisplayPicture.Height = VB6.TwipsToPixelsY(3645)
				DisplayPicture.Width = VB6.TwipsToPixelsX(2925)
				DisplayPicture.SizeMode = System.Windows.Forms.PictureBoxSizeMode.StretchImage
				DisplayPicture.SetBounds(0, 0, 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
				VScroll1.Visible = False
				HScroll1.Visible = False
				Command3.Visible = False
			End If
		End If
	End Sub
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		
		ConfigForm.DefInstance.CC(5).Text = Text1.Text
		Me.Close()
		
	End Sub
	
	Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click
		Me.Close()
	End Sub
	
	Private Sub Command3_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command3.Click
		If HScroll1.Value < (HScroll1.Maximum - HScroll1.LargeChange + 1) - 100 Then
			HScroll1.Value = HScroll1.Value + 100
		End If
		If VScroll1.Value < (VScroll1.Maximum - VScroll1.LargeChange + 1) - 100 Then
			VScroll1.Value = VScroll1.Value + 100
		End If
	End Sub
	
	Public Sub DelFile_Popup(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles DelFile.Popup
		DelFile_Click(eventSender, eventArgs)
	End Sub
	Public Sub DelFile_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles DelFile.Click
		Dim DelOk As Short
		DelOk = MsgBox("真的要删除文件：(Y/N) " & Chr(10) & Chr(13) & Text1.Text, MsgBoxStyle.YesNo + 16, "删除文件")
		If DelOk = 6 Then
			On Error GoTo KillErr
			Kill(Text1.Text)
			Text1.Text = ""
			If Check1.CheckState = 1 Then
				DisplayPicture.Image = Nothing
			End If
			File1.Refresh()
		Else
			Exit Sub
		End If
		Exit Sub
KillErr: 
		MsgBox("删除文件错误，文件被打开或共享", MsgBoxStyle.OKOnly + 16, "警告")
		Exit Sub
	End Sub
	
	Private Sub Dir1_Change(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Dir1.Change
		File1.Path = Dir1.Path
		Select Case SelectType.Text
			Case "位图文件|*.BMP"
				File1.Pattern = "*.bmp"
			Case "压缩文件|*.JPG"
				File1.Pattern = "*.jpg"
			Case "GIF文件|*.GIF"
				File1.Pattern = "*.gif"
			Case "图标文件|*.ICO"
				File1.Pattern = "*.ico"
			Case "WMF|*.WMF"
				File1.Pattern = "*.wmf"
			Case "EMF|*.EMF"
				File1.Pattern = "*.emf"
			Case "RLE|*.RLE"
				File1.Pattern = "*.rle"
		End Select
		Text1.Text = ""
	End Sub
	
	Private Sub DisplayPicture_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles DisplayPicture.DoubleClick
		
		If Command1.Enabled = True Then
			Call Command1_Click(Command1, New System.EventArgs())
		End If
		
	End Sub
	
	Private Sub DisplayPicture_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles DisplayPicture.MouseDown
		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)
		
		LB = True
		Sx = X
		Sy = Y
		'UPGRADE_ISSUE: Image 属性 DisplayPicture.MouseIcon 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
		DisplayPicture.MouseIcon = picDown.Image
		
	End Sub
	
	Private Sub DisplayPicture_MouseMove(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles DisplayPicture.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)
		
		If HScroll1.Visible = True Or VScroll1.Visible = True Then
			If LB = True Then
				Mx = X
				My = Y
				If HScroll1.Value + (Mx - Sx) / 50 <= (HScroll1.Maximum - HScroll1.LargeChange + 1) And HScroll1.Value + (Mx - Sx) / 50 > 0 Then
					HScroll1.Value = HScroll1.Value + (Mx - Sx) / 50
				End If
				If VScroll1.Value + (My - Sy) / 50 <= (VScroll1.Maximum - VScroll1.LargeChange + 1) And VScroll1.Value + (My - Sy) / 50 > 0 Then
					VScroll1.Value = VScroll1.Value + (My - Sy) / 50
				End If
			End If
		End If
		If Text1.Text = "" Then
			ToolTip1.SetToolTip(DisplayPicture, "没有图片装载")
		ElseIf Check2.CheckState = 1 Then 
			ToolTip1.SetToolTip(DisplayPicture, "图片：宽 " & VB6.PixelsToTwipsX(DisplayPicture.Width) / 15 & " 点、高 " & VB6.PixelsToTwipsY(DisplayPicture.Height) / 15 & " 点")
		Else
			ToolTip1.SetToolTip(DisplayPicture, "要想显示图片大小，选取自动大小！")
		End If
		
	End Sub
	
	Private Sub DisplayPicture_MouseUp(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles DisplayPicture.MouseUp
		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)
		
		LB = False
		'UPGRADE_ISSUE: Image 属性 DisplayPicture.MouseIcon 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
		DisplayPicture.MouseIcon = picUP.Image
		
	End Sub
	
	Private Sub Drive1_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Drive1.SelectedIndexChanged
		On Error GoTo Noread
		Dir1.Path = Drive1.Drive
		Text1.Text = ""
		Exit Sub
Noread: 
		Dim Okread As Short
		Okread = MsgBox("" & Drive1.Drive & " 驱动器没有准备好！", MsgBoxStyle.RetryCancel + 16, "驱动器没有准备好！")
		If Okread = 4 Then
			Call Drive1_SelectedIndexChanged(Drive1, New System.EventArgs())
		Else
			Drive1.Drive = Dir1.Path
			Text1.Text = ""
		End If
	End Sub
	
	Private Sub File1_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles File1.SelectedIndexChanged
		Dim DirStr As String
		DirStr = Dir1.Path
		If VB.Right(DirStr, 1) <> "\" Then
			DirStr = DirStr & "\"
		End If
		DirStr = DirStr & File1.FileName
		Text1.Text = DirStr
		If Check1.CheckState = 1 Then
			On Error GoTo PictureErr
			SelectFile.DefInstance.Cursor = System.Windows.Forms.Cursors.WaitCursor
			If Check2.CheckState = 1 Then
				DisplayPicture.SizeMode = System.Windows.Forms.PictureBoxSizeMode.Normal
			Else
				DisplayPicture.Height = VB6.TwipsToPixelsY(3645)
				DisplayPicture.Width = VB6.TwipsToPixelsX(2925)
				DisplayPicture.SizeMode = System.Windows.Forms.PictureBoxSizeMode.StretchImage
			End If
			DisplayPicture.Image = System.Drawing.Image.FromFile(Text1.Text)
			'Large photo display
			If Check2.CheckState = 1 Then
				HScroll1.Value = 0
				VScroll1.Value = 0
				HScroll1.Maximum = (VB6.PixelsToTwipsX(DisplayPicture.Width) - VB6.PixelsToTwipsX(Picture1.Width) + 280 + HScroll1.LargeChange - 1)
				VScroll1.Maximum = (VB6.PixelsToTwipsY(DisplayPicture.Height) - VB6.PixelsToTwipsY(Picture1.Height) + 280 + VScroll1.LargeChange - 1)
				VScroll1.Visible = VB6.PixelsToTwipsY(Picture1.Height) < VB6.PixelsToTwipsY(DisplayPicture.Height)
				HScroll1.Visible = VB6.PixelsToTwipsX(Picture1.Width) < VB6.PixelsToTwipsX(DisplayPicture.Width)
				If HScroll1.Visible Or VScroll1.Visible Then
					Command3.Visible = True
				Else
					Command3.Visible = False
				End If
			Else
				VScroll1.Visible = False
				HScroll1.Visible = False
				Command3.Visible = False
			End If
		End If
		SelectFile.DefInstance.Cursor = System.Windows.Forms.Cursors.Default
		Exit Sub
PictureErr: 
		MsgBox("图片出错，不能浏览！", MsgBoxStyle.OKOnly + 16, "图片不能安装")
		DisplayPicture.Image = Nothing
		SelectFile.DefInstance.Cursor = System.Windows.Forms.Cursors.Default
		Exit Sub
	End Sub
	
	Private Sub File1_DoubleClick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles File1.DoubleClick
		Call Command1_Click(Command1, New System.EventArgs())
	End Sub
	
	Private Sub File1_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles File1.MouseDown
		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)
		If Button = 2 Then
			If File1.SelectedIndex >= 0 Then
				DelFile.Enabled = True
			Else
				DelFile.Enabled = False
			End If
			'UPGRADE_ISSUE: Form 方法 SelectFile.PopupMenu 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
			PopupMenu(MenuEdit)
		End If
	End Sub
	
	Private Sub SelectFile_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		Me.Left = VB6.TwipsToPixelsX(Val(GetSetting(VB6.GetExeName(), "SelectPhoto", "Left")))
		Me.Top = VB6.TwipsToPixelsY(Val(GetSetting(VB6.GetExeName(), "SelectPhoto", "Top")))
		
		MenuEdit.Visible = False
		SelectFile.DefInstance.Width = VB6.TwipsToPixelsX(5355)
		SelectType.Items.Insert(0, "所有图片文件(*.*)")
		SelectType.Items.Insert(1, "位图文件|*.BMP")
		SelectType.Items.Insert(2, "压缩文件|*.JPG")
		SelectType.Items.Insert(3, "GIF文件|*.GIF")
		SelectType.Items.Insert(4, "图标文件|*.ICO")
		SelectType.Items.Insert(5, "WMF|*.WMF")
		SelectType.Items.Insert(6, "EMF|*.EMF")
		SelectType.Items.Insert(7, "RLE|*.RLE")
		SelectType.SelectedIndex = 0
		File1.Pattern = "*.bmp;*.jpg;*.gif;*.ico;*.wmf;*.emf;*.rle"
		'UPGRADE_ISSUE: Image 属性 DisplayPicture.MousePointer 不支持自定义鼠标指针。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2036"'
		DisplayPicture.Cursor = vbCustom
		'UPGRADE_ISSUE: Image 属性 DisplayPicture.MouseIcon 未升级。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2064"'
		DisplayPicture.MouseIcon = picUP.Image
		
	End Sub
	
	
	'UPGRADE_WARNING: Form 事件 SelectFile.Unload 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub SelectFile_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		
		SaveSetting(VB6.GetExeName(), "SelectPhoto", "Left", CStr(VB6.PixelsToTwipsX(Me.Left)))
		SaveSetting(VB6.GetExeName(), "SelectPhoto", "Top", CStr(VB6.PixelsToTwipsY(Me.Top)))
		
	End Sub
	
	'UPGRADE_NOTE: HScroll1.Change 已由事件更改为过程。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2010"'
	'UPGRADE_WARNING: HScrollBar 事件 HScroll1.Change 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub HScroll1_Change(ByVal newScrollValue As Integer)
		DisplayPicture.Left = VB6.TwipsToPixelsX(-newScrollValue)
	End Sub
	
	Private Sub PastFile_Click()
		
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 SelectType.SelectedIndexChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub SelectType_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles SelectType.SelectedIndexChanged
		Text1.Text = ""
		Select Case SelectType.Text
			Case "所有图片文件(*.*)"
				File1.Pattern = "*.bmp;*.jpg;*.gif;*.ico;*.wmf;*.emf;*.rle"
			Case "位图文件|*.BMP"
				File1.Pattern = "*.bmp"
			Case "压缩文件|*.JPG"
				File1.Pattern = "*.jpg"
			Case "GIF文件|*.GIF"
				File1.Pattern = "*.gif"
			Case "图标文件|*.ICO"
				File1.Pattern = "*.ico"
			Case "WMF|*.WMF"
				File1.Pattern = "*.wmf"
			Case "EMF|*.EMF"
				File1.Pattern = "*.emf"
			Case "RLE|*.RLE"
				File1.Pattern = "*.rle"
		End Select
		File1.Refresh()
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 Text1.TextChanged。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2075"'
	Private Sub Text1_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Text1.TextChanged
		If Trim(Text1.Text) = "" Then
			Command1.Enabled = False
			DisplayPicture.Image = Nothing
			Check2.Enabled = False
		Else
			Command1.Enabled = True
			Check2.Enabled = True
		End If
	End Sub
	
	'UPGRADE_NOTE: VScroll1.Change 已由事件更改为过程。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2010"'
	'UPGRADE_WARNING: VScrollBar 事件 VScroll1.Change 具有新的行为。 单击以获得更多信息：'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup2065"'
	Private Sub VScroll1_Change(ByVal newScrollValue As Integer)
		DisplayPicture.Top = VB6.TwipsToPixelsY(-newScrollValue)
	End Sub
	Private Sub HScroll1_Scroll(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.ScrollEventArgs) Handles HScroll1.Scroll
		Select Case eventArgs.type
			Case System.Windows.Forms.ScrollEventType.EndScroll
				HScroll1_Change(eventArgs.newValue)
		End Select
	End Sub
	Private Sub VScroll1_Scroll(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.ScrollEventArgs) Handles VScroll1.Scroll
		Select Case eventArgs.type
			Case System.Windows.Forms.ScrollEventType.EndScroll
				VScroll1_Change(eventArgs.newValue)
		End Select
	End Sub
End Class
123

⌨️ 快捷键说明

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