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

📄 frmaddress.vb

📁 Online Telephone Directory in Visual Basic
💻 VB
字号:
Option Strict Off
Option Explicit On
Friend Class Form14
	Inherits System.Windows.Forms.Form
	'UPGRADE_WARNING: Arrays in structure rs may need to be initialized before they can be used. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="814DF224-76BD-4BB4-BFFB-EA359CB9FC48"'
	Dim db As DAO.Database
	Dim rs As DAO.Recordset
	Dim bt As Short
	
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		bt = 1
		Frame1.Visible = False
		Frame2.Visible = True
		Text1.Text = ""
		Text2.Text = ""
		Text3.Text = ""
		Label3.Text = "Add Record"
		HScroll1.Visible = False
	End Sub
	
	Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click
		bt = 2
		Frame1.Visible = False
		Frame2.Visible = True
		Label3.Text = "Edit Record"
		HScroll1.Visible = False
		
	End Sub
	
	Private Sub Command3_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command3.Click
		Dim X As Object
		'UPGRADE_WARNING: Couldn't resolve default property of object X. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		X = MsgBox("Are you confirm to delete?", MsgBoxStyle.YesNo + MsgBoxStyle.Question)
		If X = MsgBoxResult.Yes Then
			rs.Delete()
			MsgBox("Removed Successfully", MsgBoxStyle.Critical)
			Form14_Load(Me, New System.EventArgs())
		End If
	End Sub
	
	Private Sub Command4_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command4.Click
		Me.Close()
	End Sub
	
	Private Sub Command5_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command5.Click
		Dim sr As Object
		'UPGRADE_WARNING: Couldn't resolve default property of object sr. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		sr = InputBox("Enter the Column name to sort (Name or Address or Phone) : ")
		'UPGRADE_WARNING: Couldn't resolve default property of object sr. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		If sr <> "Name" And sr <> "Address" And sr <> "Phone" Then
			MsgBox("Invalid Column", MsgBoxStyle.Critical)
			Exit Sub
		End If
		
		'UPGRADE_WARNING: Couldn't resolve default property of object sr. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		rs = db.OpenRecordset("Select * from Subscriber order by " & sr)
		rs.MoveFirst()
		disp()
		
	End Sub
	
	Private Sub Command6_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command6.Click
		
		If bt = 1 Then
			rs.AddNew()
		ElseIf bt = 2 Then 
			rs.Edit()
		End If
		rs.Fields(0).Value = Text1.Text
		rs.Fields(1).Value = Text2.Text
		rs.Fields(2).Value = Text3.Text
		rs.Update()
		Form14_Load(Me, New System.EventArgs())
		
	End Sub
	
	Private Sub Command7_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command7.Click
		Dim X As Object
		'UPGRADE_WARNING: Couldn't resolve default property of object X. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		X = InputBox("Enter number of rows to  move" & vbCrLf & " (Enter negative values for move back")
		On Error Resume Next
		'UPGRADE_WARNING: Couldn't resolve default property of object X. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		HScroll1.Value = HScroll1.Value + X
	End Sub
	
	Private Sub Form14_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		db = DAODBEngine_definst.OpenDatabase(My.Application.Info.DirectoryPath & "\Database\DirDB.mdb")
		rs = db.OpenRecordset("Subscriber")
		
		If rs.RecordCount <> 0 Then
			HScroll1.Maximum = (rs.RecordCount - 1 + HScroll1.LargeChange - 1)
			Label3.Text = 1 & "/" & rs.RecordCount
			rs.MoveFirst()
			disp()
			HScroll1.Value = 0
			
			Frame2.Visible = False
			Frame1.Visible = True
			HScroll1.Visible = True
		End If
	End Sub
	
	'UPGRADE_NOTE: HScroll1.Change was changed from an event to a procedure. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="4E2DC008-5EDA-4547-8317-C9316952674F"'
	'UPGRADE_WARNING: HScrollBar event HScroll1.Change has a new behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"'
	Private Sub HScroll1_Change(ByVal newScrollValue As Integer)
		rs.MoveFirst()
		rs.Move(newScrollValue)
		Label3.Text = newScrollValue + 1 & "/" & rs.RecordCount
		disp()
	End Sub
	Sub disp()
		Text1.Text = rs.Fields(0).Value
		Text2.Text = rs.Fields(1).Value
		Text3.Text = rs.Fields(2).Value
	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
End Class

⌨️ 快捷键说明

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