frmproduse.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmProduse 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "产品信息"
   ClientHeight    =   3732
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   7128
   Icon            =   "frmProduse.frx":0000
   LinkTopic       =   "Form2"
   MDIChild        =   -1  'True
   ScaleHeight     =   3732
   ScaleWidth      =   7128
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdPDelete 
      Caption         =   "删除"
      Height          =   255
      Left            =   2520
      TabIndex        =   18
      ToolTipText     =   "Delete curent record"
      Top             =   3360
      Width           =   1215
   End
   Begin VB.CommandButton cmdPExit 
      Caption         =   "退出"
      Height          =   255
      Left            =   3720
      TabIndex        =   17
      Top             =   3360
      Width           =   855
   End
   Begin VB.CommandButton cmdPAdd 
      Caption         =   "添加"
      Height          =   255
      Left            =   1560
      Style           =   1  'Graphical
      TabIndex        =   16
      ToolTipText     =   "Add a new record"
      Top             =   3360
      Width           =   972
   End
   Begin VB.CommandButton cmdPLast 
      Height          =   255
      Left            =   4920
      Picture         =   "frmProduse.frx":000C
      Style           =   1  'Graphical
      TabIndex        =   15
      ToolTipText     =   "Moves to last record"
      Top             =   2760
      Width           =   255
   End
   Begin VB.CommandButton cmdPFirst 
      Height          =   255
      Left            =   1560
      Picture         =   "frmProduse.frx":010E
      Style           =   1  'Graphical
      TabIndex        =   14
      ToolTipText     =   "Moves to first record"
      Top             =   2760
      Width           =   255
   End
   Begin VB.CommandButton cmdPNext 
      Height          =   255
      Left            =   4680
      Picture         =   "frmProduse.frx":0210
      Style           =   1  'Graphical
      TabIndex        =   13
      ToolTipText     =   "Moves to next record"
      Top             =   2760
      Width           =   255
   End
   Begin VB.CommandButton cmdPPrev 
      Height          =   255
      Left            =   1800
      Picture         =   "frmProduse.frx":0312
      Style           =   1  'Graphical
      TabIndex        =   12
      ToolTipText     =   "Moves to previous record"
      Top             =   2760
      Width           =   255
   End
   Begin VB.TextBox txtPCurent 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   2160
      TabIndex        =   11
      Top             =   2760
      Width           =   2415
   End
   Begin VB.ListBox lstProduse 
      Height          =   1308
      Left            =   360
      TabIndex        =   10
      Top             =   1200
      Width           =   6492
   End
   Begin VB.ComboBox cmbG 
      Height          =   276
      Left            =   4200
      TabIndex        =   9
      Top             =   480
      Width           =   2655
   End
   Begin VB.ComboBox cmbD 
      Height          =   276
      Left            =   4200
      TabIndex        =   8
      Top             =   120
      Width           =   2655
   End
   Begin VB.TextBox txtCodP 
      Height          =   285
      Left            =   1200
      TabIndex        =   7
      Top             =   840
      Width           =   1935
   End
   Begin VB.TextBox txtDenP 
      Height          =   285
      Left            =   4200
      TabIndex        =   2
      Top             =   840
      Width           =   2652
   End
   Begin VB.TextBox txtCodG 
      Height          =   285
      Left            =   1200
      TabIndex        =   1
      Top             =   480
      Width           =   1935
   End
   Begin VB.TextBox txtCodD 
      Height          =   285
      Left            =   1200
      TabIndex        =   0
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label lblGrupa 
      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            =   3240
      TabIndex        =   20
      Top             =   480
      Width           =   852
   End
   Begin VB.Label lblDomeniu 
      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            =   3240
      TabIndex        =   19
      Top             =   120
      Width           =   1092
   End
   Begin VB.Label lblDenP 
      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            =   3240
      TabIndex        =   6
      Top             =   840
      Width           =   972
   End
   Begin VB.Label lblCodP 
      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        =   5
      Top             =   840
      Width           =   852
   End
   Begin VB.Label lblCodG 
      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             =   480
      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             =   120
      Width           =   852
   End
End
Attribute VB_Name = "frmProduse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As Recordset
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim bookm As String
Dim nr_inreg As Long
Dim savemode As Boolean
Dim setdeschis As Boolean


Private Sub cmbD_Click()
Dim sir As String
Dim cd As Long 'codul domeniului
cmbG.Clear 'Sterge eventualul continut anterior al controlului Combo
sir = cmbD.Text
On Error Resume Next
Set rs = db.OpenRecordset("SELECT * FROM domenii " & "WHERE den_dom = " & "'" & sir & "'", dbOpenDynaset)
cd = rs("cod_dom")
Set rs1 = db.OpenRecordset("SELECT * FROM grupe " & "WHERE cod_dom = " & cd & " ORDER BY den_gr", dbOpenDynaset)
txtCodD.Text = rs("cod_dom")
Call ClearControls
Call DisableControls
txtCodG.Text = ""
txtPCurent.Text = ""
lstProduse.Clear
Do While Not rs1.EOF
 cmbG.AddItem rs1("den_gr")
 rs1.MoveNext
Loop
End Sub



Private Sub cmbG_Click()
Dim sir As String
Dim cg As Long 'codul grupei
lstProduse.Clear
sir = cmbG.Text
On Error Resume Next
Set rs1 = db.OpenRecordset("SELECT * FROM grupe " & "WHERE den_gr = " & "'" & sir & "'", dbOpenDynaset)
cg = rs1("cod_gr")
Set rs2 = db.OpenRecordset("SELECT * FROM produse " & "WHERE cod_gr = " & cg & " ORDER BY den_pr", dbOpenDynaset)
txtCodG.Text = rs1("cod_gr")

''''In cazul in care nu avem inreg. intr-un anumit domeniu
''''va fi nevoie de introducerea unei prime inregistari
If (rs2.EOF = True And rs2.BOF = True) Then
  Call ClearControls
  Call DisableControls
  
  txtCodP.SetFocus
  lstProduse.Clear
  txtPCurent.Text = ""
  cmdPDelete.Enabled = False 'nu avem ce sterge deocamdata
  savemode = True
  Exit Sub
End If
''''''
txtCodP.Text = rs2("cod_pr")
txtDenP.Text = rs2("den_pr")
Do While Not rs2.EOF
  lstProduse.AddItem rs2("den_pr")
  rs2.MoveNext
Loop
'''''
nr_inreg = rs2.RecordCount
rs2.MoveFirst
bookm = rs2.Bookmark
Call EnableControls
txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
lstProduse.Selected(rs.AbsolutePosition) = True
cmdPDelete.Enabled = True
setdeschis = True
End Sub

Private Sub cmdPAdd_Click()
Call ClearControls
Call DisableControls
txtCodP.SetFocus
savemode = True
End Sub

Private Sub cmdPDelete_Click()
If rs2.RecordCount = 1 Then
   Call DisableControls
   savemode = True
End If
If rs2.EOF = True And rs2.BOF = True Then
 MsgBox "No current record !", vbCritical + vbOKOnly
 Exit Sub
End If
On Error Resume Next
rs2.Delete
Call ClearControls 'stergem continutul controalelor
rs2.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 lstProduse
If lstProduse.ListIndex = 0 Then bookm = rs2.Bookmark

lstProduse.RemoveItem (lstProduse.ListIndex) 'Stergem articolul din lista

lstProduse.Refresh
lstProduse.Selected(rs2.AbsolutePosition) = True
txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
End Sub

Private Sub cmdPExit_Click()
If setdeschis = True Then
  rs2.Close
  Set rs2 = Nothing
  Unload Me
End If
Unload Me
End Sub

Private Sub cmdPFirst_Click()
rs2.MoveFirst
  txtCodP.Text = rs2("cod_pr")
  txtDenP.Text = rs2("den_pr")
  lstProduse.Selected(rs2.AbsolutePosition) = True 'indexul prop. Selected porneste de la 0 !
  txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
End Sub

Private Sub cmdPLast_Click()
rs2.MoveLast
  txtCodP.Text = rs2("cod_pr")
  txtDenP.Text = rs2("den_pr")
  lstProduse.Selected(rs2.AbsolutePosition) = True 'indexul prop. Selected porneste de la 0 !
  txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
End Sub

Private Sub cmdPNext_Click()
If Not rs2.EOF Then
  rs2.MoveNext
 If rs2.EOF Then Exit Sub
  txtCodP.Text = rs2("cod_pr")
  txtDenP.Text = rs2("den_pr")
  lstProduse.Selected(rs2.AbsolutePosition) = True 'indexul prop. Selected porneste de la 0 !
  txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
End If
End Sub

Private Sub cmdPPrev_Click()
If Not rs2.BOF Then
 rs2.MovePrevious
 If rs2.BOF Then Exit Sub
 txtCodP.Text = rs2("cod_pr")
 txtDenP.Text = rs2("den_pr")
 lstProduse.Selected(rs2.AbsolutePosition) = True
 txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
End If
End Sub

Private Sub Form_Load()
Set rs = db.OpenRecordset("domenii", dbOpenDynaset)
Set rs1 = db.OpenRecordset("grupe", dbOpenDynaset)
Do While Not rs.EOF 'Populam domeniile
 cmbD.AddItem rs("den_dom")
 rs.MoveNext
Loop
Call DisableControls
txtCodD.Locked = True
txtCodG.Locked = True
setdeschis = False
cmdPDelete.Enabled = False
End Sub


Private Sub lstProduse_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 = lstProduse.ListIndex
sir = lstProduse.List(ind)
'''''''''
rs2.Move ind, bookm

txtCodP.Text = rs2("cod_pr")
txtDenP.Text = rs2("den_pr")
txtPCurent.Text = "编号 " & ind + 1 & " 总计 " & rs2.RecordCount

End Sub


Private Sub DisableControls()
cmdPFirst.Enabled = False
cmdPPrev.Enabled = False
cmdPNext.Enabled = False
cmdPLast.Enabled = False
cmdPAdd.Enabled = False
End Sub


Private Sub EnableControls()
cmdPFirst.Enabled = True
cmdPPrev.Enabled = True
cmdPNext.Enabled = True
cmdPLast.Enabled = True
cmdPAdd.Enabled = True
End Sub

Private Sub ClearControls()
txtCodP.Text = ""
txtDenP.Text = ""
End Sub

Private Sub txtCodP_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then Call Save
End Sub

Private Sub txtCodP_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 txtDenP_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then Call Save
End Sub


Private Sub Save()
If savemode = True Then
  rs2.AddNew 'adaugam o inregistrare
  Else: rs2.Edit 'modificam o inregistrare
End If
'''''''''
If (Len(Trim(txtCodP.Text)) <> 0 And (Len(Trim(txtDenP.Text)) <> 0)) Then
    On Error GoTo ERR
    rs2("cod_dom") = CLng(txtCodD.Text)
    rs2("cod_gr") = CLng(txtCodG.Text)
    rs2("cod_pr") = CLng(txtCodP.Text)
    rs2("den_pr") = txtDenP.Text
    rs2.Update
    rs2.Bookmark = rs2.LastModified
    ''''
    If savemode = True Then
      lstProduse.AddItem rs2("den_pr") 'adaugam in ListView ultima inreg. adaugata
      Else: lstProduse.List(lstProduse.ListIndex) = rs2("den_pr")
    End If
    '''''''
    lstProduse.Refresh
    ''''
    rs2.MoveFirst
    bookm = rs2.Bookmark
    lstProduse.Selected(rs2.AbsolutePosition) = True
    nr_inreg = rs2.RecordCount
    txtPCurent.Text = "编号 " & rs2.AbsolutePosition + 1 & " 总计 " & rs2.RecordCount
    Call EnableControls
    savemode = False
    cmdPDelete.Enabled = True
 Else: Exit Sub
End If

ERR:
 If ERR.Number = 3022 Then  'Duplicate record !
  MsgBox "Duplicate record", vbCritical + vbOKOnly
  Exit Sub
 End If
End Sub