frmxskh.frm

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

Const ImgKh = 0
Const SbarKh = 0

Const FlexKh = 0

Const TxtKhCode = 0
Const TxtKhMc = 1
Const TxtKhTel = 2
Const TxtKhFax = 3
Const TxtKhEmail = 4
Const TxtKhWww = 5
Const TxtKhAdd = 6
Const TxtKhPCode = 7
Const TxtKhLinkMan = 8

Const CbxKh_CwBzCode = 2
Const CbxKh_CwSmCode = 0

Const ChkKhIsStop = 0

Dim OKh As Kh
Dim OKhs As Khs

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

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

Exit Sub
Errorhandle:
   MsgBox 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 Form_Load()
On Error GoTo Errorhandle

   Flex(FlexKh).ColKey(1) = "KHCODE"
   Flex(FlexKh).ColKey(2) = "KHMC"
    
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbKh), Img(ImgKh), SBar(SbarKh)
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "KH", "TXTKHCODE", "CHKKHISSTOP"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexKh)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Flex(FlexKh)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Flex(FlexKh)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CbxKh_CwBzCode), "SELECT CWBZCODE FROM CWBZREC ORDER BY CWBZCODE", , 0
   gPublicFunction.FillComboWithSql Me, Combo(CbxKh_CwSmCode), "SELECT CWSMCODE FROM CWSMREC ORDER BY CWSMCODE", , 0
   
   LoadDataIntoGrid
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim ItemStr As String
   Dim mKh As Kh
On Error GoTo Errorhandle

   Flex(FlexKh).Rows = 1
   
   Set OKhs = New Khs
   OKhs.FillbyDb "KHTYPE=1"
      
   For Each mKh In OKhs
      ItemStr = vbTab & mKh.KhCode & vbTab & mKh.KhMc
      Flex(FlexKh).AddItem ItemStr
      Flex(FlexKh).RowData(Flex(FlexKh).Rows - 1) = mKh.KhKey
   Next
   If Flex(FlexKh).Rows > 1 Then
      Flex(FlexKh).Row = 1
      Set OKh = OKhs(CStr(Flex(FlexKh).RowData(1)))
      SetValueToControl
   Else
      Set OKh = Nothing
      Clearcontrol
   End If

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

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

   Set OKh = New Kh
   Clearcontrol
   Text(TxtKhCode).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbKh), RecordName
   
Exit Sub
Errorhandle:
   Set OKh = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
   If OKh Is Nothing Then
      Exit Sub
   End If
   
   Text(TxtKhCode).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbKh), RecordName
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If Flex(FlexKh).Rows = 1 Then
      Set OKh = Nothing
      Clearcontrol
   Else
      Set OKh = OKhs(CStr(Flex(FlexKh).RowData(Flex(FlexKh).Row)))
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbKh), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtKhCode).Text = ""
   Text(TxtKhMc).Text = ""
   Text(TxtKhTel).Text = ""
   Text(TxtKhFax).Text = ""
   Text(TxtKhEmail).Text = ""
   Text(TxtKhWww).Text = ""
   Text(TxtKhAdd).Text = ""
   Text(TxtKhPCode).Text = ""
   Text(TxtKhLinkMan).Text = ""
   Combo(CbxKh_CwBzCode).Text = ""
   Combo(CbxKh_CwSmCode).Text = ""
   Check(ChkKhIsStop).Value = vbUnchecked
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
  
   SetValueToObject

   If OKh.KhId = -1 Then
      OKhs.Add OKh
      ChgGrid "ADD"
   Else
      OKh.Save
      ChgGrid "CHG"
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbKh), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
On Error GoTo Errorhandle
   
   OKh.KhType = 1
   OKh.KhCode = Trim(Text(TxtKhCode).Text)
   OKh.KhMc = Trim(Text(TxtKhMc).Text)
   OKh.KhTel = Trim(Text(TxtKhTel).Text)
   OKh.KhFax = Trim(Text(TxtKhFax).Text)
   OKh.KhEmail = Trim(Text(TxtKhEmail).Text)
   OKh.KhWww = Trim(Text(TxtKhWww).Text)
   OKh.KhAdd = Trim(Text(TxtKhAdd).Text)
   OKh.KhPCode = Trim(Text(TxtKhPCode).Text)
   OKh.KhLinkMan = Trim(Text(TxtKhLinkMan).Text)
   OKh.Kh_CwBzCode = Trim(Combo(CbxKh_CwBzCode).Text)
   OKh.Kh_CwSmCode = Trim(Combo(CbxKh_CwSmCode).Text)
   OKh.KhIsStop = Check(ChkKhIsStop)
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgGrid(RecordName As String)
   Dim ItemStr As String
On Error GoTo Errorhandle

   If RecordName = "ADD" Then
      ItemStr = vbTab & OKh.KhCode & vbTab & OKh.KhMc
      Flex(FlexKh).AddItem ItemStr
      Flex(FlexKh).RowData(Flex(FlexKh).Rows - 1) = OKh.KhKey
      Flex(FlexKh).Row = Flex(FlexKh).Rows - 1
   Else
      Flex(FlexKh).TextMatrix(Flex(FlexKh).Row, Flex(FlexKh).ColIndex("KHCODE")) = Text(TxtKhCode).Text
      Flex(FlexKh).TextMatrix(Flex(FlexKh).Row, Flex(FlexKh).ColIndex("KHMC")) = Text(TxtKhMc).Text
   End If

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

Private Sub Delrecord()
On Error GoTo Errorhandle

   If Flex(FlexKh).Rows = 1 Then
      Exit Sub
   End If

   If MsgBox("您真的要删除吗？", vbYesNo) = vbYes Then
      OKhs.Remove CStr(OKh.KhKey)
      Flex(FlexKh).RemoveItem Flex(FlexKh).Row
      If Flex(FlexKh).Rows = 1 Then
         Set OKh = Nothing
         Clearcontrol
      Else
         Set OKh = OKhs(CStr(Flex(FlexKh).RowData(Flex(FlexKh).Row)))
         SetValueToControl
      End If
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If Flex(FlexKh).Rows > 1 Then
      Set OKh = OKhs(CStr(Flex(FlexKh).RowData(Flex(FlexKh).Row)))
      SetValueToControl
   Else
      Set OKh = Nothing
      Clearcontrol
   End If
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtKhCode).Text = OKh.KhCode
   Text(TxtKhMc).Text = OKh.KhMc
   Text(TxtKhTel).Text = OKh.KhTel
   Text(TxtKhFax).Text = OKh.KhFax
   Text(TxtKhEmail).Text = OKh.KhEmail
   Text(TxtKhWww).Text = OKh.KhWww
   Text(TxtKhAdd).Text = OKh.KhAdd
   Text(TxtKhPCode).Text = OKh.KhPCode
   Text(TxtKhLinkMan).Text = OKh.KhLinkMan
   Combo(CbxKh_CwBzCode).Text = OKh.Kh_CwBzCode
   Combo(CbxKh_CwSmCode).Text = OKh.Kh_CwSmCode
   Check(ChkKhIsStop).Value = OKh.KhIsStop
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set OKh = Nothing
   Set OKhs = Nothing
   
   gPublicFunction.SaveFormSet Me
    
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 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 TlbKh, mButton
   End If
  
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
   
   Select Case Action
       Case "ADD"
            AddRecord RecordName
       Case "CHG"
            ChgRecord RecordName
       Case "CAN"
            CancelRecord RecordName
       Case "SAV"
            SaveRecord RecordName
       Case "DEL", "DEF"
            Delrecord
       Case "EXI"
            Unload Me
       Case "FIN"
            ShowBmQuery
       Case Else
           
   End Select

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(TlbKh).Tag = "" Then
      Exit Sub
   End If

   If Me.ActiveControl Is Nothing Then
      Exit Sub
   End If
     
   Select Case Me.ActiveControl.Tag
   Case "TXTCWBZCODE", "TXTCWSMCODE"
         mCodeType = Mid(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