frmarskd.frm

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

         EndProperty
         BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmArSkd.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 = "frmArSkd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbArivd = 0
Const ImgArivd = 0
Const SbarArivd = 0

Const FrmArSkd = 0

Const TxtArSkdDocno = 0
Const TxtArSkdDat = 6
Const TxtArSkd_CwqjCode = 5

Const CBxArSkd_KhCode = 0
Const CBxArSkd_CwZhMc = 1
Const CBxArSkd_CwBzCode = 2

Const TxtArSkdAmt = 1
Const TxtArSkdBz = 2

Dim mCurColOldValue As String

Dim oArSkds As ArSkds
Dim oArSkd As ArSkd
Dim oArivd As Arivd

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

   Text(TxtArSkdDocno).Text = vDocno
   Text_LostFocus TxtArSkdDocno

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(TlbArivd).Tag = "" Then
      Exit Sub
   End If
   
   Select Case Index
   Case CBxArSkd_KhCode
         If Trim(Combo(CBxArSkd_KhCode).Text) <> "" Then
            oArSkd.ArSkd_KhCode = Combo(CBxArSkd_KhCode).Text
            Combo(CBxArSkd_CwBzCode).Text = oArSkd.ArSkd_CwBzCode
         End If
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

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

Private Sub Form_Load()
On Error GoTo Errorhandle
        
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbArivd), Img(ImgArivd), SBar(SbarArivd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Arivd", "TXTArSkdDOCNO", "TXTArSkdBZ"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Text(TxtArSkdDocno)
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxArSkd_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=1 ORDER BY KHCODE", "KHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxArSkd_CwZhMc), "SELECT CWZHMC,CWZHNO FROM CWZHREC ORDER BY CWZHMC", "CWZHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxArSkd_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 oArSkd = New ArSkd
   Clearcontrol
   Text(TxtArSkdDocno).SetFocus
   
   If Text(TxtArSkdDat).Text = "" Then
      Text(TxtArSkdDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oArSkd.ArSkdDat = Trim(Text(TxtArSkdDat).Text)
   Text(TxtArSkd_CwqjCode).Text = oArSkd.ArSkd_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

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

   If oArSkd.ArSkdId = -1 Then
      Clearcontrol
      Set oArSkd = Nothing
   Else
      oArSkd.Requery oArSkd.ArSkdDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtArSkdDocno).Text = ""
   Text(TxtArSkd_CwqjCode).Text = ""
   Combo(CBxArSkd_KhCode).Text = ""
   Combo(CBxArSkd_CwZhMc).Text = ""
   Combo(CBxArSkd_CwBzCode).Text = ""
   
   Text(TxtArSkdAmt).Text = ""
   Text(TxtArSkdBz).Text = ""
   
   Text(TxtArSkdDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

Private Sub SetValueToObject()
   Dim mArivd As Arivd
   Dim I As Integer
On Error GoTo Errorhandle

   oArSkd.ArSkdDocno = Trim(Text(TxtArSkdDocno).Text)
   oArSkd.ArSkdDat = gPublicFunction.ConvDateToString(Text(TxtArSkdDat).Text)
   oArSkd.ArSkd_CwQjCode = Trim(Text(TxtArSkd_CwqjCode).Text)
   oArSkd.ArSkd_KhCode = Trim(Combo(CBxArSkd_KhCode).Text)
   oArSkd.ArSkd_CwZhMc = Trim(Combo(CBxArSkd_CwZhMc).Text)
   oArSkd.ArSkd_CwBzCode = Trim(Combo(CBxArSkd_CwBzCode).Text)
   oArSkd.ArSkdAmt = Val(Text(TxtArSkdAmt).Text)
   oArSkd.ArSkdBz = Trim(Text(TxtArSkdBz).Text)
   oArSkd.ArSkdForm = 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 oArSkd Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oArSkd.Del
            Set oArSkd = 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(TxtArSkdDocno).Text = oArSkd.ArSkdDocno
   Text(TxtArSkdDat).Text = gPublicFunction.ConvStringToDate(oArSkd.ArSkdDat)
   Text(TxtArSkd_CwqjCode).Text = oArSkd.ArSkd_CwQjCode
   Combo(CBxArSkd_KhCode).Text = oArSkd.ArSkd_KhCode
   Combo(CBxArSkd_CwZhMc).Text = oArSkd.ArSkd_CwZhMc
   Combo(CBxArSkd_CwBzCode).Text = oArSkd.ArSkd_CwBzCode
   Text(TxtArSkdAmt).Text = oArSkd.ArSkdAmt
   Text(TxtArSkdBz).Text = oArSkd.ArSkdBz
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set oArSkd = 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 TxtArSkdDat
         
         If Tlbaction(TlbArivd).Tag <> "" And Trim(Text(TxtArSkdDat).Text) <> "" Then
            Text(TxtArSkdDat).Text = gPublicFunction.SetDateFormat(Text(TxtArSkdDat).Text)
            oArSkd.ArSkdDat = gPublicFunction.ConvDateToString(Text(TxtArSkdDat).Text)
            Text(TxtArSkd_CwqjCode).Text = oArSkd.ArSkd_CwQjCode
         End If
         
   Case TxtArSkdDocno
   
           If Tlbaction(TlbArivd).Tag = "" Then
               If Trim(Text(Index).Text) = "" Then
                  Exit Sub
               End If
               
               If Not oArSkd Is Nothing Then
                  If oArSkd.ArSkdDocno = Text(TxtArSkdDocno).Text Then
                     Exit Sub
                  End If
               End If
   
               Set oArSkd = New ArSkd
               If oArSkd.Requery(Text(TxtArSkdDocno).Text) = 1 Then
                   SetValueToControl
               Else
                   Set oArSkd = Nothing
                   Dim vArivddocno As String
                   vArivddocno = Text(TxtArSkdDocno).Text
                   AddRecord "ADD"
                   Text(TxtArSkdDocno).Text = vArivddocno
               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(TxtArSkdDocno).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 TlbArivd, 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(TlbArivd).Tag = "" Then
      Exit Sub
   End If
   
   If Me.ActiveControl Is Nothing Then
      Exit Sub
   End If
   
   Select Case UCase(Me.ActiveControl.Tag)
   Case "TXTCWQJCODE", "CBXKHCODE", "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