📄 frmdomenii.frm
字号:
VERSION 5.00
Begin VB.Form frmDomenii
BorderStyle = 3 'Fixed Dialog
Caption = "类别信息"
ClientHeight = 4500
ClientLeft = 48
ClientTop = 336
ClientWidth = 4152
Icon = "frmDomenii.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4500
ScaleWidth = 4152
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdDDelete
Caption = "删除"
Height = 255
Left = 1320
TabIndex = 12
Top = 4080
Width = 1095
End
Begin VB.CommandButton cmdDExit
Caption = "退出"
Height = 255
Left = 2400
TabIndex = 11
Top = 4080
Width = 1095
End
Begin VB.CommandButton cmdAdd
Caption = "添加"
Height = 255
Left = 240
Style = 1 'Graphical
TabIndex = 10
Top = 4080
Width = 1092
End
Begin VB.CommandButton cmdLast
Height = 255
Left = 3240
Picture = "frmDomenii.frx":000C
Style = 1 'Graphical
TabIndex = 9
Top = 3600
Width = 255
End
Begin VB.CommandButton cmdFirst
Height = 255
Left = 360
Picture = "frmDomenii.frx":010E
Style = 1 'Graphical
TabIndex = 8
Top = 3600
Width = 255
End
Begin VB.CommandButton cmdDNext
Height = 255
Left = 2880
Picture = "frmDomenii.frx":0210
Style = 1 'Graphical
TabIndex = 7
Top = 3600
Width = 255
End
Begin VB.CommandButton cmdDPrevious
Height = 255
Left = 720
Picture = "frmDomenii.frx":0312
Style = 1 'Graphical
TabIndex = 6
Top = 3600
Width = 255
End
Begin VB.TextBox txtDCurent
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1080
TabIndex = 5
Top = 3600
Width = 1695
End
Begin VB.TextBox txtDenD
Height = 285
Left = 1080
TabIndex = 2
Top = 720
Width = 2775
End
Begin VB.TextBox txtCodD
Height = 285
Left = 1080
TabIndex = 1
Top = 240
Width = 2775
End
Begin VB.ListBox lstD
Height = 2388
Left = 240
TabIndex = 0
Top = 1080
Width = 3612
End
Begin VB.Label lblDenD
Caption = "类别名称"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 240
TabIndex = 4
Top = 720
Width = 852
End
Begin VB.Label lblCodD
Caption = "类别编号"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 240
TabIndex = 3
Top = 240
Width = 972
End
End
Attribute VB_Name = "frmDomenii"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim nr_inreg As Long
Dim bookm As String
Dim clicnext As Boolean
Dim savemode As Boolean
Private Sub cmdAdd_Click()
Call ClearControls
Call DisableControls
txtCodD.SetFocus
savemode = True
End Sub
Private Sub cmdDDelete_Click()
If rs.RecordCount = 1 Then
Call DisableControls
savemode = True
End If
If rs.EOF = True And rs.BOF = True Then
savemode = True
MsgBox "No current record !", vbCritical + vbOKOnly
Exit Sub
End If
'''''''
On Error Resume Next
rs.Delete
Call ClearControls 'stergem continutul controalelor
rs.MoveFirst
'''''''''''''''
'''''In cazul in care dorim sa stergem prima inregistrare in Recordset
'''''vom atribui variabilei bookm, Bookmark-ul inreg. urmatoare
'''''pentru a putea folosi drept index de pornire pentru lstD
If lstD.ListIndex = 0 Then bookm = rs.Bookmark
lstD.RemoveItem (lstD.ListIndex) 'Stergem articolul din lista
lstD.Refresh
lstD.Selected(rs.AbsolutePosition) = True
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
End Sub
Private Sub cmdDExit_Click()
rs.Close
Set rs = Nothing
Unload Me
End Sub
Private Sub cmdDNext_Click()
If Not rs.EOF Then
rs.MoveNext
If rs.EOF Then Exit Sub
txtCodD.Text = rs("cod_dom")
txtDenD.Text = rs("den_dom")
lstD.Selected(rs.AbsolutePosition) = True 'indexul prop. Selected porneste de la 0 !
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
End If
End Sub
Private Sub cmdDPrevious_Click()
If Not rs.BOF Then
rs.MovePrevious
If rs.BOF Then Exit Sub
txtCodD.Text = rs("cod_dom")
txtDenD.Text = rs("den_dom")
lstD.Selected(rs.AbsolutePosition) = True
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
End If
End Sub
Private Sub cmdFirst_Click()
rs.MoveFirst
txtCodD.Text = rs("cod_dom")
txtDenD.Text = rs("den_dom")
lstD.Selected(rs.AbsolutePosition) = True
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
End Sub
Private Sub cmdLast_Click()
rs.MoveLast
txtCodD.Text = rs("cod_dom")
txtDenD.Text = rs("den_dom")
lstD.Selected(rs.AbsolutePosition) = True
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
End Sub
Private Sub Form_Load()
Set rs = db.OpenRecordset("domenii", dbOpenDynaset) 'Trebuie specificat tipul Dynaset (implicit, setul de inreg. foloseste dbOpenTabel), deoarece proprietatea AbsolutePosition a obiectului rs nu ar merge altfel !!!
rs.Sort = "den_dom"
txtCodD.Text = rs("cod_dom")
txtDenD.Text = rs("den_dom")
Do While Not rs.EOF
lstD.AddItem rs("den_dom")
rs.MoveNext
Loop
nr_inreg = rs.RecordCount 'tinem minte numarul inital de inregistrari
rs.MoveFirst
bookm = rs.Bookmark 'foloseste ca inreg. de pornire pt. metoda Move din even. click al control. ListView
lstD.Selected(rs.AbsolutePosition) = True
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
savemode = False
End Sub
Private Sub lstD_Click()
Dim sir As String
Dim ind As Integer
If savemode = True Then 'in cazul in care renuntam sa mai
savemode = False 'adaugam o noua inreg., mutaindu-ne
Call EnableControls 'pe o alta inreg, facem savemode=False
End If
ind = lstD.ListIndex
sir = lstD.List(ind)
'Set rs = db.OpenRecordset("SELECT * FROM domenii " & "WHERE den_dom = " & "'" & sir & "'", dbOpenDynaset)
rs.Move ind, bookm
txtCodD.Text = rs("cod_dom")
txtDenD.Text = rs("den_dom")
txtDCurent.Text = "编号 " & ind + 1 & " 总计 " & rs.RecordCount
End Sub
Private Sub ClearControls()
txtCodD.Text = ""
txtDenD.Text = ""
End Sub
Private Sub DisableControls()
cmdFirst.Enabled = False
cmdDPrevious.Enabled = False
cmdDNext.Enabled = False
cmdLast.Enabled = False
cmdAdd.Enabled = False
End Sub
Private Sub Save()
If savemode = True Then
rs.AddNew 'adaugam o inregistrare
Else: rs.Edit 'modificam o inregistrare
End If
If (Len(Trim(txtCodD.Text)) <> 0 And (Len(Trim(txtDenD.Text)) <> 0)) Then
On Error GoTo ERR
rs("cod_dom") = CLng(txtCodD.Text)
rs("den_dom") = txtDenD.Text
rs.Update
rs.Bookmark = rs.LastModified
'''''
If savemode = True Then
lstD.AddItem rs("den_dom") 'adaugam in ListView ultima inreg. adaugata
Else: lstD.List(lstD.ListIndex) = rs("den_dom")
End If
''''
lstD.Refresh
''''
rs.MoveFirst
bookm = rs.Bookmark
lstD.Selected(rs.AbsolutePosition) = True
nr_inreg = rs.RecordCount
txtDCurent.Text = "编号 " & rs.AbsolutePosition + 1 & " 总计 " & rs.RecordCount
Call EnableControls
savemode = False
Else: Exit Sub
End If
ERR:
If ERR.Number = 3022 Then
MsgBox "Duplicate record !", vbCritical + vbOKOnly
Exit Sub
End If
End Sub
Private Sub EnableControls()
cmdFirst.Enabled = True
cmdDPrevious.Enabled = True
cmdDNext.Enabled = True
cmdLast.Enabled = True
cmdAdd.Enabled = True
End Sub
Private Sub txtCodD_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Call Save
End Sub
Private Sub txtCodD_KeyPress(KeyAscii As Integer)
Dim strValid As String
strValid = "0123456789"
If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub
Private Sub txtDenD_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Call Save
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -