📄 frmcgshd.frm
字号:
Dim oCgShdhs As CgShdhs
Dim oCgShdh As CgShdh
Dim oCgShd As CgShd
Private Sub Command_Click(Index As Integer)
On Error GoTo Errorhandle
Select Case Index
Case CmdAdd
AddRecord
Case CmdDel
Delrecord "CgShd"
Case CmdDelh
Delrecord "CgShdH"
Case CmdSave
SaveRecord
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_AfterEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long)
On Error GoTo Errorhandle
SetControlToFlex
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Flex_BeforeEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
On Error GoTo Errorhandle
If oCgShdh Is Nothing Then
Cancel = True
End If
Select Case Flex(FlexCgShd).ColKey(Col)
Case "CGSHD_HWBMCODE"
Case "CGSHDQTY", "CGSHDPRICE", "CGSHDBZ"
If oCgShd Is Nothing Then
Cancel = True
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
Flex(FlexCgShd).Editable = flexEDKbdMouse
Flex(FlexCgShdh).ColKey(1) = "CGSHDHDOCNO"
Flex(FlexCgShdh).ColKey(2) = "CGSHDHDAT"
Flex(FlexCgShdh).ColKey(3) = "CGSHDH_KHCODE"
Flex(FlexCgShd).ColKey(1) = "CGSHD_CGPODDOCNO"
Flex(FlexCgShd).ColKey(2) = "CGSHD_HWBMCODE"
Flex(FlexCgShd).ColKey(3) = "CGSHD_HWBMMC"
Flex(FlexCgShd).ColKey(4) = "CGSHD_HWBMDW"
Flex(FlexCgShd).ColKey(5) = "CGSHD_HWCKMC"
Flex(FlexCgShd).ColKey(6) = "CGSHDQTY"
Flex(FlexCgShd).ColKey(7) = "CGSHDPRICE"
Flex(FlexCgShd).ColKey(8) = "CGSHDAMT"
Flex(FlexCgShd).ColKey(9) = "CGSHDBZ"
FillComboWithSql Me, Combo(CBxCgShd_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=2 ORDER BY KHCODE", "KHNO"
LoadDataIntoGrid "CgShdH"
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub LoadDataIntoGrid(Index As String)
Dim ItemStr As String
Dim mCgShdh As CgShdh
Dim mCgShd As CgShd
On Error GoTo Errorhandle
Select Case UCase(Index)
Case "CGSHDH"
Flex(FlexCgShdh).Rows = 1
Set oCgShdhs = New CgShdhs
oCgShdhs.Fillbydb " CgShdHTYPE=1 "
For Each mCgShdh In oCgShdhs
ItemStr = vbTab & mCgShdh.CgShdhDocno & vbTab & mCgShdh.CgShdhDat & vbTab & mCgShdh.Kh.KhCode
Flex(FlexCgShdh).AddItem ItemStr
Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Rows - 1) = mCgShdh.CgShdhKey
Next
If Flex(FlexCgShdh).Rows > 1 Then
Flex(FlexCgShdh).Row = 1
Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(1)))
SetValueToControl
Else
Set oCgShdh = Nothing
Clearcontrol
End If
Case "CGSHD"
Flex(FlexCgShd).Rows = 1
Flex(FlexCgShd).AddItem ""
oCgShdh.CgShds.Fillbydb oCgShdh
For Each mCgShd In oCgShdh.CgShds
ItemStr = vbTab & mCgShd.CgPod.CgPodh.CgPodhDocno & vbTab & mCgShd.Hwbm.HwBmCode & vbTab & mCgShd.Hwbm.HwBmMc & vbTab & mCgShd.Hwbm.HwBmDw & vbTab & mCgShd.HwCk.HwCkMc & vbTab & mCgShd.CgShdQty & vbTab & mCgShd.CgShdPrice & vbTab & mCgShd.CgShdAmt & mCgShd.CgShdBz
Flex(FlexCgShd).AddItem ItemStr, Flex(FlexCgShd).Rows - 1
Flex(FlexCgShd).RowData(Flex(FlexCgShd).Rows - 2) = mCgShd.CgShdKey
Next
If Flex(FlexCgShd).Rows > 2 Then
Flex(FlexCgShd).Row = 1
Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(1)))
Else
Set oCgShd = Nothing
End If
End Select
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddRecord()
On Error GoTo Errorhandle
Set oCgShdh = New CgShdh
Set oCgShd = Nothing
Clearcontrol
Text(TxtCgShdDocno).SetFocus
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Clearcontrol()
On Error GoTo Errorhandle
Text(TxtCgShdDocno).Text = ""
Text(DtpCgShdDat).Text = ""
Combo(CBxCgShd_KhCode).Text = ""
Flex(FlexCgShd).Rows = 1
Flex(FlexCgShd).AddItem ""
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SaveRecord()
On Error GoTo Errorhandle
SetValueToObject
If oCgShdh.CgShdhId = -1 Then
oCgShdhs.Add oCgShdh
ChgGrid "ADD"
Else
oCgShdh.Save
ChgGrid "CHG"
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub SetValueToObject()
Dim mCgShd As CgShd
Dim I As Integer
On Error GoTo Errorhandle
oCgShdh.CgShdhType = 1
oCgShdh.CgShdhDocno = Trim(Text(TxtCgShdDocno).Text)
oCgShdh.CgShdhDat = Dtp(DtpCgShdDat).Value
oCgShdh.CgShdh_KhCode = Trim(Combo(CBxCgShd_KhCode).Text)
For I = 1 To Flex(FlexCgShd).Rows - 2
Set mCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(I)))
mCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShd_HWBMCODE")))
mCgShd.CgShd_HwCkMc = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShd_HWCKMC")))
mCgShd.CgShdQty = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShdQTY")))
mCgShd.CgShdPrice = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShdPRICE")))
mCgShd.CgShdBz = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShdBZ")))
Next
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 & oCgShdh.CgShdhDocno & vbTab & oCgShdh.CgShdhDat & vbTab & oCgShdh.Kh.KhCode
Flex(FlexCgShdh).AddItem ItemStr
Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Rows - 1) = oCgShdh.CgShdhKey
Flex(FlexCgShdh).Row = Flex(FlexCgShdh).Rows - 1
Else
Flex(FlexCgShdh).TextMatrix(Flex(FlexCgShdh).Row, Flex(FlexCgShdh).ColIndex("CgShdHDOCNO")) = oCgShdh.CgShdhDocno
Flex(FlexCgShdh).TextMatrix(Flex(FlexCgShdh).Row, Flex(FlexCgShdh).ColIndex("CgShdHDAT")) = oCgShdh.CgShdhDat
Flex(FlexCgShdh).TextMatrix(Flex(FlexCgShdh).Row, Flex(FlexCgShdh).ColIndex("CgShdH_KHCODE")) = oCgShdh.Kh.KhCode
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Delrecord(Index As String)
On Error GoTo Errorhandle
Select Case UCase(Index)
Case "CGSHDH"
If Flex(FlexCgShdh).Rows = 1 Then
Exit Sub
End If
If MsgBox("您真的要删除当前整张单据吗?", vbYesNo) = vbYes Then
oCgShdhs.Remove CStr(oCgShdh.CgShdhKey)
Flex(FlexCgShdh).RemoveItem Flex(FlexCgShdh).Row
If Flex(FlexCgShdh).Rows = 1 Then
Set oCgShd = Nothing
Set oCgShdh = Nothing
Clearcontrol
Else
Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Row)))
SetValueToControl
End If
End If
Case "CGSHD"
If Flex(FlexCgShd).Row = Flex(FlexCgShd).Rows - 1 Then
Exit Sub
End If
If MsgBox("您真的要删除单据当前行吗?", vbYesNo) = vbYes Then
oCgShdh.CgShds.Remove CStr(oCgShd.CgShdKey)
Flex(FlexCgShd).RemoveItem Flex(FlexCgShd).Row
If Flex(FlexCgShd).Rows = 2 Then
Set oCgShd = Nothing
Flex(FlexCgShdh).RemoveItem Flex(FlexCgShdh).Row
If Flex(FlexCgShdh).Rows = 1 Then
Set oCgShdh = Nothing
Else
Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Row)))
SetValueToControl
End If
Else
If Flex(FlexCgShd).Row = Flex(FlexCgShd).Rows - 1 Then
Flex(FlexCgShd).Row = Flex(FlexCgShd).Row - 1
End If
Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(Flex(FlexCgShd).Row)))
End If
End If
End Select
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Flex_RowColChange(Index As Integer)
On Error GoTo Errorhandle
Select Case Index
Case FlexCgShdh
If Flex(FlexCgShdh).Rows > 1 Then
Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Row)))
SetValueToControl
Else
Set oCgShdh = Nothing
Clearcontrol
End If
Case FlexCgShd
If Flex(FlexCgShd).Row <> Flex(FlexCgShd).Rows - 1 Then
Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(Flex(FlexCgShd).Row)))
Else
Set oCgShd = Nothing
End If
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub SetValueToControl()
On Error GoTo Errorhandle
Text(TxtCgShdDocno).Text = oCgShdh.CgShdhDocno
Dtp(DtpCgShdDat).Value = oCgShdh.CgShdhDat
Combo(CBxCgShd_KhCode).Text = oCgShdh.Kh.KhCode
LoadDataIntoGrid "CgShd"
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle
Set oCgShdhs = Nothing
Set oCgShdh = Nothing
Set oCgShd = Nothing
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub SetControlToFlex()
Dim mCurCol As Integer
Dim mCurRow As Integer
On Error GoTo Errorhandle
mCurRow = Flex(FlexCgShd).Row
mCurCol = Flex(FlexCgShd).Col
Select Case Flex(FlexCgShd).ColKey(Flex(FlexCgShd).Col)
Case "CGSHD_HWBMCODE"
If oCgShd Is Nothing Then
AddNewRecord
Else
oCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(mCurRow, mCurCol))
Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMMC")) = oCgShd.Hwbm.HwBmMc
Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMDW")) = oCgShd.Hwbm.HwBmDw
End If
Case "CGSHD_HWCKMC"
If Not oCgShd Is Nothing Then
oCgShd.CgShd_HwCkMc = Trim(Flex(FlexCgShd).TextMatrix(mCurRow, mCurCol))
End If
Case "CGSHDQTY"
If Not oCgShd Is Nothing Then
oCgShd.CgShdQty = Val(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, mCurCol))
Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, Flex(FlexCgShd).ColIndex("CGSHDAMT")) = oCgShd.CgShdAmt
End If
Case "CGSHDPRICE"
If Not oCgShd Is Nothing Then
oCgShd.CgShdPrice = Val(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, mCurCol))
Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, Flex(FlexCgShd).ColIndex("CGSHDAMT")) = oCgShd.CgShdAmt
End If
Case "CGSHDBZ"
If Not oCgShd Is Nothing Then
oCgShd.CgShdBz = Trim(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, mCurCol))
End If
End Select
Exit Sub
Errorhandle:
'Flex(FlexCgShd).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub AddNewRecord()
Dim mCurRow As Integer
On Error GoTo Errorhandle
mCurRow = Flex(FlexCgShd).Row
If Trim(Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).Col)) <> "" Then
Set oCgShd = New CgShd
Set oCgShd.CgShdh = oCgShdh
oCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).Col))
oCgShdh.CgShds.Add oCgShd, 0
Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMMC")) = oCgShd.Hwbm.HwBmMc
Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMDW")) = oCgShd.Hwbm.HwBmDw
Flex(FlexCgShd).RowData(Flex(FlexCgShd).Rows - 1) = oCgShd.CgShdKey
Flex(FlexCgShd).AddItem ""
End If
Exit Sub
Errorhandle:
Set oCgShd = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Resize()
On Error GoTo Errorhandle
Resize_ALL Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -