frmapfkd.frm

制造业产供销与往来系统源码,包括进销存及全部控件！

         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmApFkd.frx":3504
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu muFile 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu muEdit 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mView 
      Caption         =   "查看(&V)"
      Begin VB.Menu muView 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu muHelp 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmApFkd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbApivd = 0
Const ImgApivd = 0
Const SbarApivd = 0

Const FrmApFkd = 0

Const TxtApFkdDocno = 0
Const TxtApFkdDat = 6
Const TxtApFkd_CwqjCode = 5

Const CBxApFkd_KhCode = 0
Const CBxApFkd_CwZhMc = 1
Const CBxApFkd_CwBzCode = 2

Const TxtApFkdAmt = 1
Const TxtApFkdBz = 2

Dim mCurColOldValue As String

Dim oApFkds As ApFkds
Dim oApFkd As ApFkd
Dim oApivd As Apivd

Public Sub LetDocno(vDocno As String)
On Error GoTo Errorhandle

   Text(TxtApFkdDocno).Text = vDocno
   Text_LostFocus TxtApFkdDocno

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Combo_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle

   gPublicFunction.FormKeyDown Me, KeyCode, Shift, Combo(Index)

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Combo_LostFocus(Index As Integer)
On Error GoTo Errorhandle
   
   If Tlbaction(TlbApivd).Tag = "" Then
      Exit Sub
   End If
   
   Select Case Index
   Case CBxApFkd_KhCode
         If Trim(Combo(CBxApFkd_KhCode).Text) <> "" Then
            oApFkd.ApFkd_KhCode = Combo(CBxApFkd_KhCode).Text
            Combo(CBxApFkd_CwBzCode).Text = oApFkd.ApFkd_CwBzCode
         End If
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Activate()
On Error GoTo Errorhandle
  
  Text(TxtApFkdDocno).SetFocus
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
        
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbApivd), Img(ImgApivd), SBar(SbarApivd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Apivd", "TXTAPFKDDOCNO", "TXTAPFKDBZ"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Text(TxtApFkdDocno)
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxApFkd_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=2 ORDER BY KHCODE", "KHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxApFkd_CwZhMc), "SELECT CWZHMC,CWZHNO FROM CWZHREC ORDER BY CWZHMC", "CWZHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxApFkd_CwBzCode), "SELECT CwBzCODE,CwBzNO FROM CwBzREC ORDER BY CwBzCODE", "CwBzNO", 0
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub


Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle

   Set oApFkd = New ApFkd
   Clearcontrol
   Text(TxtApFkdDocno).SetFocus
   
   If Text(TxtApFkdDat).Text = "" Then
      Text(TxtApFkdDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oApFkd.ApFkdDat = Trim(Text(TxtApFkdDat).Text)
   Text(TxtApFkd_CwqjCode).Text = oApFkd.ApFkd_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
   If oApFkd Is Nothing Then
      Exit Sub
   End If

   Text(TxtApFkdDocno).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), RecordName
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle

   If oApFkd.ApFkdId = -1 Then
      Clearcontrol
      Set oApFkd = Nothing
   Else
      oApFkd.Requery oApFkd.ApFkdDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtApFkdDocno).Text = ""
   Text(TxtApFkd_CwqjCode).Text = ""
   Combo(CBxApFkd_KhCode).Text = ""
   Combo(CBxApFkd_CwZhMc).Text = ""
   Combo(CBxApFkd_CwBzCode).Text = ""
   
   Text(TxtApFkdAmt).Text = ""
   Text(TxtApFkdBz).Text = ""
   
   Text(TxtApFkdDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
   
   SetValueToObject
   oApFkd.Save
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), RecordName

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
   Dim mApivd As Apivd
   Dim I As Integer
On Error GoTo Errorhandle

   oApFkd.ApFkdDocno = Trim(Text(TxtApFkdDocno).Text)
   oApFkd.ApFkdDat = gPublicFunction.ConvDateToString(Text(TxtApFkdDat).Text)
   oApFkd.ApFkd_CwQjCode = Trim(Text(TxtApFkd_CwqjCode).Text)
   oApFkd.ApFkd_KhCode = Trim(Combo(CBxApFkd_KhCode).Text)
   oApFkd.ApFkd_CwZhMc = Trim(Combo(CBxApFkd_CwZhMc).Text)
   oApFkd.ApFkd_CwBzCode = Trim(Combo(CBxApFkd_CwBzCode).Text)
   oApFkd.ApFkdAmt = Val(Text(TxtApFkdAmt).Text)
   oApFkd.ApFkdBz = Trim(Text(TxtApFkdBz).Text)
   oApFkd.ApFkdForm = UCase(Me.Name)
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub DelRecord(RecordName As String)
On Error GoTo Errorhandle


   Select Case UCase(RecordName)
   Case "DEL"
   
         If oApFkd Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oApFkd.Del
            Set oApFkd = Nothing
            Clearcontrol
         End If
      
   End Select
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtApFkdDocno).Text = oApFkd.ApFkdDocno
   Text(TxtApFkdDat).Text = gPublicFunction.ConvStringToDate(oApFkd.ApFkdDat)
   Text(TxtApFkd_CwqjCode).Text = oApFkd.ApFkd_CwQjCode
   Combo(CBxApFkd_KhCode).Text = oApFkd.ApFkd_KhCode
   Combo(CBxApFkd_CwZhMc).Text = oApFkd.ApFkd_CwZhMc
   Combo(CBxApFkd_CwBzCode).Text = oApFkd.ApFkd_CwBzCode
   Text(TxtApFkdAmt).Text = oApFkd.ApFkdAmt
   Text(TxtApFkdBz).Text = oApFkd.ApFkdBz
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle

   Set oApFkd = Nothing
  
   gPublicFunction.SaveFormSet Me
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub muEdit_Click(Index As Integer)
On Error GoTo Errorhandle

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle

   gPublicFunction.FormKeyDown Me, KeyCode, Shift, Text(Index)

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo Errorhandle

   gPublicFunction.InputCheck Me, Text(Index), KeyAscii

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Resize()
On Error GoTo Errorhandle
   gPublicFunction.ResizeForm Me
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Text_LostFocus(Index As Integer)
On Error GoTo Errorhandle

   Select Case Index
   Case TxtApFkdDat
         
         If Tlbaction(TlbApivd).Tag <> "" And Trim(Text(TxtApFkdDat).Text) <> "" Then
            Text(TxtApFkdDat).Text = gPublicFunction.SetDateFormat(Text(TxtApFkdDat).Text)
            oApFkd.ApFkdDat = gPublicFunction.ConvDateToString(Text(TxtApFkdDat).Text)
            Text(TxtApFkd_CwqjCode).Text = oApFkd.ApFkd_CwQjCode
         End If
         
   Case TxtApFkdDocno
   
           If Tlbaction(TlbApivd).Tag = "" Then
               If Trim(Text(Index).Text) = "" Then
                  Exit Sub
               End If
               
               If Not oApFkd Is Nothing Then
                  If oApFkd.ApFkdDocno = Text(TxtApFkdDocno).Text Then
                     Exit Sub
                  End If
               End If
   
               Set oApFkd = New ApFkd
               If oApFkd.Requery(Text(TxtApFkdDocno).Text) = 1 Then
                   SetValueToControl
               Else
                   Set oApFkd = Nothing
                   Dim vApivddocno As String
                   vApivddocno = Text(TxtApFkdDocno).Text
                   AddRecord "ADD"
                   Text(TxtApFkdDocno).Text = vApivddocno
               End If
        End If

   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Tlbaction_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    Dim Action, RecordName As String
On Error GoTo Errorhandle

   Action = (Mid(Button.Key, 1, 3))
   RecordName = Button.Key

   If Action = "SAV" Then
      Text(TxtApFkdDocno).SetFocus
   End If
   
   Select Case Action
   Case "ADD"
        AddRecord RecordName
   Case "CHG"
        ChgRecord RecordName
   Case "CAN"
        CancelRecord RecordName
   Case "SAV"
        SaveRecord RecordName
   Case "DEL", "DEF"
        DelRecord RecordName
   Case "EXI"
        Unload Me
   Case "FIN"
        ShowBmQuery
   Case Else
   
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim mButton As Button
On Error GoTo Errorhandle

   Set mButton = gPublicFunction.GetToolBarButton(Me, KeyCode)
   
   If Not mButton Is Nothing Then
      Tlbaction_ButtonClick TlbApivd, mButton
   End If
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub ShowBmQuery()
   Dim mCodeType As String
   Dim mQueryValue As String
On Error GoTo Errorhandle

   If Tlbaction(TlbApivd).Tag = "" Then
      Exit Sub
   End If
   
   If Me.ActiveControl Is Nothing Then
      Exit Sub
   End If
   
   Select Case UCase(Me.ActiveControl.Tag)
   Case "TXTCWQJCODE", "CBXGYSCODE|KHCODE", "CBXCWZHMC", "CBXCWBZCODE"
         mCodeType = Mid(UCase(Me.ActiveControl.Tag), 4)
   End Select
   
   If mCodeType <> "" Then
      mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
      If mQueryValue <> "" Then
         Me.ActiveControl.Text = mQueryValue
      End If
   End If
  
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub