d_department_free.frm

来自「一个企业生产管理系统」· FRM 代码 · 共 263 行

VERSION 5.00
Begin VB.Form w_department_free 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "部门信息"
   ClientHeight    =   4125
   ClientLeft      =   1095
   ClientTop       =   330
   ClientWidth     =   5775
   Icon            =   "d_department_free.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4125
   ScaleWidth      =   5775
   Begin VB.PictureBox picButtons 
      Align           =   2  'Align Bottom
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   300
      Left            =   0
      ScaleHeight     =   300
      ScaleWidth      =   5775
      TabIndex        =   8
      Top             =   3825
      Width           =   5775
      Begin VB.CommandButton cmdClose 
         Caption         =   "关闭(&C)"
         Height          =   300
         Left            =   4675
         TabIndex        =   13
         Top             =   0
         Width           =   1095
      End
      Begin VB.CommandButton cmdRefresh 
         Caption         =   "刷新(&R)"
         Height          =   300
         Left            =   3521
         TabIndex        =   12
         Top             =   0
         Width           =   1095
      End
      Begin VB.CommandButton cmdDelete 
         Caption         =   "删除(&D)"
         Height          =   300
         Left            =   2367
         TabIndex        =   11
         Top             =   0
         Width           =   1095
      End
      Begin VB.CommandButton cmdUpdate 
         Caption         =   "更新(&U)"
         Height          =   300
         Left            =   1213
         TabIndex        =   10
         Top             =   0
         Width           =   1095
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加(&A)"
         Height          =   300
         Left            =   59
         TabIndex        =   9
         Top             =   0
         Width           =   1095
      End
   End
   Begin VB.TextBox txtFields 
      DataField       =   "main_duty"
      DataSource      =   "datPrimaryRS"
      Height          =   285
      Index           =   3
      Left            =   1920
      TabIndex        =   7
      Top             =   2700
      Width           =   2055
   End
   Begin VB.TextBox txtFields 
      DataField       =   "leader"
      DataSource      =   "datPrimaryRS"
      Height          =   285
      Index           =   2
      Left            =   1920
      TabIndex        =   5
      Top             =   2025
      Width           =   2055
   End
   Begin VB.TextBox txtFields 
      DataField       =   "department_name"
      DataSource      =   "datPrimaryRS"
      Height          =   285
      Index           =   1
      Left            =   1920
      TabIndex        =   3
      Top             =   1335
      Width           =   2055
   End
   Begin VB.TextBox txtFields 
      DataField       =   "department_id"
      DataSource      =   "datPrimaryRS"
      Height          =   285
      Index           =   0
      Left            =   1920
      TabIndex        =   1
      Top             =   660
      Width           =   2055
   End
   Begin VB.Label lblLabels 
      Caption         =   "主要职责"
      Height          =   255
      Index           =   3
      Left            =   840
      TabIndex        =   6
      Top             =   2700
      Width           =   855
   End
   Begin VB.Label lblLabels 
      Caption         =   "部门领导"
      Height          =   255
      Index           =   2
      Left            =   840
      TabIndex        =   4
      Top             =   2025
      Width           =   855
   End
   Begin VB.Label lblLabels 
      Caption         =   "部门名称"
      Height          =   255
      Index           =   1
      Left            =   840
      TabIndex        =   2
      Top             =   1335
      Width           =   855
   End
   Begin VB.Label lblLabels 
      Caption         =   "部门编号"
      Height          =   255
      Index           =   0
      Left            =   840
      TabIndex        =   0
      Top             =   660
      Width           =   855
   End
End
Attribute VB_Name = "w_department_free"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{Tab}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Activate()
txtFields(0).SetFocus
End Sub

Private Sub Form_Load()

  Dim db As Connection
  Set db = New Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=MSDASQL;driver={SQL Server};server=ht;uid=sa;pwd=;database=warehouse;"

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.RecordSource = "select department_id,department_name,leader,main_duty from department where employee_id = '" & w_employee1__wareid & "'"

  Dim oText As TextBox
  '绑定文本框到数据提供者
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next

  mbDataChanged = False

End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '错误处理程序代码置于此处
  '想要忽略错误，注释掉下一行
  '想要捕获它们，在此添加代码以处理它们
  MsgBox "Data error event hit err:" & Description
End Sub

Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  '为这个 recordset 显示当前记录位置
  datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub

Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  '验证代码置于此处
  '下列动作发生时该事件被调用
  Dim bCancel As Boolean

  Select Case adReason
  Case adRsnAddNew
  Case adRsnClose
  Case adRsnDelete
  Case adRsnFirstChange
  Case adRsnMove
  Case adRsnRequery
  Case adRsnResynch
  Case adRsnUndoAddNew
  Case adRsnUndoDelete
  Case adRsnUndoUpdate
  Case adRsnUpdate
  End Select

  If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  datPrimaryRS.Recordset.AddNew

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  With datPrimaryRS.Recordset
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub cmdRefresh_Click()
  '只有多用户应用程序需要
  On Error GoTo RefreshErr
  datPrimaryRS.Refresh
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  datPrimaryRS.Recordset.UpdateBatch adAffectAll
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub