📄 frmaddress.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 + -