frmkfmodi.frm

此为我2001年为东莞建发楦头开发的企业管理软件他们使用至今,望斑竹指教! 其他会员最好不要随意下载,需经斑竹同意或我本人同意,谢谢!

            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   6
         Left            =   2760
         TabIndex        =   32
         Top             =   1485
         Width           =   255
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "年"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   4
         Left            =   2040
         TabIndex        =   31
         Top             =   1485
         Width           =   255
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "时"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   3
         Left            =   4560
         TabIndex        =   28
         Top             =   1050
         Width           =   255
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "日"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   2
         Left            =   3600
         TabIndex        =   26
         Top             =   1050
         Width           =   255
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "月"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   1
         Left            =   2760
         TabIndex        =   24
         Top             =   1050
         Width           =   255
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "年"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   0
         Left            =   2040
         TabIndex        =   23
         Top             =   1050
         Width           =   255
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "指令单号:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   35
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Width           =   855
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "设计师:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   34
         Left            =   120
         TabIndex        =   6
         Top             =   540
         Width           =   855
      End
      Begin VB.Label lbl 
         BackColor       =   &H80000000&
         Caption         =   "开发时间:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   61
         Left            =   120
         TabIndex        =   5
         Top             =   1035
         Width           =   975
      End
   End
End
Attribute VB_Name = "frmkfmodi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
    Dim saveno As String
    Dim SearchTb As Recordset
    Dim ModiFlag As String
    Dim ModiOrder As String
    Dim sql As String
    Dim PubDate As Variant
    
Private Sub SetTool(bVal As Boolean)
    cmdAdd.Visible = bVal
    cmdEdit.Visible = bVal
    cmdUpdate.Visible = Not bVal
    cmdcancel.Visible = Not bVal
    cmdDelete.Visible = bVal
End Sub

Private Sub SetF()
    Dim i As Integer
        
    For i = 0 To 2
        TxtOrderS(i).Enabled = True
    Next
         
    Tbar.Enabled = False
    DatOrderSRs.Enabled = False
End Sub

Private Sub SetT()
    Dim i As Integer
    
    For i = 0 To 2
        TxtOrderS(i).Enabled = False
    Next
    
    Tbar.Enabled = True
    DatOrderSRs.Enabled = True
End Sub

Private Sub SetFalse()
    Dim i As Integer
    For i = 0 To 12
        txtfields(i).Enabled = True
    Next
    CmbState.Enabled = True
    
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDelete.Enabled = False
    cmdcancel.Enabled = False
    cmdUpdate.Enabled = False
    DatOrderSRs.Enabled = False
    
End Sub

Private Sub SetTrue()
    Dim i As Integer
    For i = 0 To 12
        txtfields(i).Enabled = False
    Next
    CmbState.Enabled = False
    
    cmdAdd.Enabled = True
    cmdEdit.Enabled = True
    cmdDelete.Enabled = True
    cmdcancel.Enabled = True
    cmdUpdate.Enabled = True
    DatOrderSRs.Enabled = True
    
    ModiFlag = "n"
End Sub
Private Sub DatPrimaryRS_Validate(Action As Integer, Save As Integer)
    If Action = 11 Then Save = 0
End Sub

Private Sub cmdAdd_Click()
    If DatPrimaryRS.Recordset.RecordCount = 0 Then Exit Sub
    DatOrderSRs.Recordset.AddNew
    SetTool False
    SetF
    ModiOrder = "Y"
    
    TxtOrderS(0).SetFocus
    Exit Sub

End Sub

Private Sub cmdcancel_Click()
    If DatOrderSRs.Recordset.RecordCount = 0 Then Exit Sub
    DatOrderSRs.Recordset.CancelUpdate
    SetTool True
    SetT
    ModiOrder = "n"
    

End Sub

Private Sub cmdDelete_Click()
    
    If DatOrderSRs.Recordset.RecordCount = 0 Then Exit Sub

    '开始删除
    Dim value
    value = MsgBox("确信真的删除吗?", vbQuestion + vbYesNo + vbDefaultButton2, "单号:" & DatOrderSRs.Recordset!dinno)
    If value = 6 Then
        DatOrderSRs.Recordset.Delete
        DatOrderSRs.Recordset.UpdateBatch adAffectAllChapters
    End If
    If DatOrderSRs.Recordset.RecordCount <> 0 Then DatOrderSRs.Recordset.MoveFirst
End Sub

Private Sub cmdEdit_Click()
    If DatOrderSRs.Recordset.RecordCount = 0 Then Exit Sub
    SetTool False
    SetF
    ModiOrder = "Y"
    TxtOrderS(0).SetFocus
End Sub

Private Sub cmdUpdate_Click()
   On Error GoTo err
   Dim Stb As Recordset
   
   For i = 0 To 2
      TxtOrderS(i).Text = Trim(TxtOrderS(i).Text)
   Next
   
   If Len(Trim(TxtOrderS(0).Text)) = 0 Then
       MsgBox "修改日期不能为空！！！", vbCritical, MSG2
       Exit Sub
   End If
     
     
   If Len(Trim(TxtOrderS(1).Text)) = 0 Then
      MsgBox "修改内容不能为空！！！", vbCritical, MSG2
      Exit Sub
   End If
     
   If IsDate(TxtOrderS(0).Text) = False And Len(TxtOrderS(0).Text) <> 0 Then
        MsgBox "日期格式非法", vbCritical, MSG2
        TxtOrderS(0).SetFocus
        Exit Sub
   End If
    
    If DatOrderSRs.Recordset.EditMode = 2 Then '如果在增加状态下则执行
        DatOrderSRs.Recordset!dinno = txtfields(0).Text
    End If
       
    DatOrderSRs.Recordset.Update
    
    SetTool True
    SetT
    ModiOrder = "n"
    cmdAdd.SetFocus
    Exit Sub
err:
    ShowError
End Sub

Private Sub Form_Load()
    frmkfmodi.Height = 6345
    frmkfmodi.Width = 7140
    Me.Left = 1500
    Me.Top = 1800
    
    Select Case ChAddflag
        Case "MODI"
            sql = "select * from tap where dinno=" & "'" & ChFindflag & "'"
    End Select
     
    Set SearchTb = New Recordset
    SearchTb.Open sql, db, adOpenStatic, adLockOptimistic
    Set DatPrimaryRS.Recordset = SearchTb
    
    Select Case ChAddflag
        Case "MODI"
            sql = "select * from tap_detail where dinno=" & "'" & ChFindflag & "'"
    End Select
    
    Set SearchTb = New Recordset
    SearchTb.Open sql, db, adOpenStatic, adLockOptimistic
    Set DatOrderSRs.Recordset = SearchTb
    
End Sub
Private Sub Edit()
    If DatPrimaryRS.Recordset.RecordCount = 0 Then Exit Sub
    ModiFlag = "y"
    SetButtons False
    SetFalse
    saveno = txtfields(0).Text
    txtfields(0).SetFocus
End Sub
Private Sub Cancel()
    On Error GoTo err
    SetButtons True
    DatPrimaryRS.Recordset.CancelUpdate
    SetTrue
    Exit Sub
err:
 ShowError
End Sub


Private Sub SetButtons(bVal As Boolean)
    Tbar.Buttons(1).Visible = bVal
    Tbar.Buttons(2).Visible = bVal
    Tbar.Buttons(3).Visible = Not bVal
    Tbar.Buttons(4).Visible = Not bVal
End Sub

Private Sub Form_Resize()
'On Error Resume Next
'Me.Top = 0
'Me.Left = 50
End Sub

Private Sub Tbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
        Case 1
            Call Edit
        Case 2
            Unload Me
        Case 3
            Call Save
        Case 4
            Call Cancel
    End Select
End Sub


Private Sub txtfields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode = 13 Then
         If Index < 12 Then
            txtfields(Index + 1).SetFocus
         Else
         End If
    End If
End Sub

Private Sub txtfields_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
   If DatPrimaryRS.Recordset.EditMode <> dbEditAdd Then Exit Sub
    Call focusSet(KeyCode, txtfields, Index)
End Sub

Public Sub DBrefresh()
  On Error GoTo err
    DatPrimaryRS.Recordset.Find "dinno=" & "'" & number & "'"
    Exit Sub
err:
    Exit Sub
End Sub

Private Sub Save()
  On Error GoTo UpdateErr
    
    
    If Len(Trim(txtfields(1).Text)) = 0 Then
        MsgBox "开发师不能为空！！！", vbCritical, MSG2
        Exit Sub
     End If
    
    CmbState.Text = Trim(CmbState.Text)
    DatPrimaryRS.Recordset.Update
    SetTrue
    SetButtons True
    Exit Sub
UpdateErr:
    ShowError
End Sub

Private Sub TxtOrderS_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode <> 13 Then Exit Sub
  If Index < 2 Then
       If Index <> 1 Then
          TxtOrderS(Index + 1).SetFocus
       End If
  End If

End Sub