frmdlcommisionmachining.frm

金算盘软件代码

Private mdblInQuantity As String                                            '加工入库串
Private mdblInAmount As String                                              '加工入库金额
Private mdblLastAmount As Double                                            '原本次结算金额
Private mblnFormNoRezise As Boolean                                         '窗体是否允许Resize
Private mblnModify As Boolean                                               '按钮退出吗
Private mfrmToFormname As Form
Private mblnOk As Boolean

Public Function GivemeParameter(ToForm As Object, Optional ywID As Long = 0) As Boolean
    Dim strCustomerName As String
    Dim strGoodsUnit As String
    Dim strGoodsName As String
        
    mblnOk = False
    Set mfrmToFormname = ToForm
    mlngItemID = C2lng(ToForm.TextOfGrid(ToForm.GrdCol.Row, 28))
    mlngDetailID = C2lng(ToForm.TextOfGrid(ToForm.GrdCol.Row, 0))
    mlngCustomerID = C2lng(ToForm.lblHead(0).Tag)
    mstrDate = ToForm.lblField(2).Caption
    
    If mlngDetailID > 0 Then
        DispartString ToForm.lblHead(1).Caption, strGoodsName, strCustomerName
    
        strGoodsUnit = ToForm.TextOfGrid(ToForm.GrdCol.Row, 4)
        strGoodsName = ToForm.TextOfGrid(ToForm.GrdCol.Row, 1)
        mdblInQuantity = C2Dbl(ToForm.TextOfGrid(ToForm.GrdCol.Row, 5))
        mdblInAmount = C2Dbl(ToForm.TextOfGrid(ToForm.GrdCol.Row, 10))
'''        ToForm.grdCol.col = 5
'''        If CLng(ToForm.grdCol.CellForeColor) = 255 Then
'''            mdblInQuantity = -mdblInQuantity
'''            mdblInAmount = -mdblInAmount
'''        End If
        title(1).Caption = strCustomerName
        title(2).Caption = "入库数量：" & IIf(IsNull(mdblInQuantity), "0", ToForm.TextOfGrid(ToForm.GrdCol.Row, 5)) & "(" & strGoodsUnit & ")"
        title(4).Caption = strGoodsName
        title(5).Caption = "入库金额：" & IIf(IsNull(mdblInAmount), "0", Format(mdblInAmount, "0." & String(gclsBase.NaturalCurDec, "0")))
        Load Me
        RefreshGrid
        Me.Show vbModal
    End If
    GivemeParameter = mblnOk
End Function

Private Sub Form_Activate()
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        If Not txtEdit.Visible Then
            Cmdall_Click 1
            KeyCode = 0
        End If
    End If
End Sub

Private Sub mclsGrid_AfterRefresh(lngRow As Long)
    With msgGrid
        If mintFactorCol > 0 Then
            If mintUnChkQtyCol > 0 Then
                .TextMatrix(lngRow, mintUnChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastUnChkQtyCol), GetValue(lngRow, mintFactorCol))
            End If
            If mintChkQtyCol > 0 Then
                .TextMatrix(lngRow, mintChkQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastChkQtyCol), GetValue(lngRow, mintFactorCol))
            End If
            If mintTotalQtyCol > 0 Then
                .TextMatrix(lngRow, mintTotalQtyCol) = MinToNormalQty(GetValue(lngRow, mintLastTotalQtyCol), GetValue(lngRow, mintFactorCol))
            End If
        End If
    End With
End Sub

Private Sub mclsGrid_AfterSave()
    With msgGrid
         If mintChkAmtCol > 0 Then
            .TextMatrix(.Row, mintChkAmtCol) = strFormat(C2Dbl(.TextMatrix(.Row, mintChkAmtCol)), gclsBase.NaturalCurDec)
        End If
    End With
End Sub

'响应完全结算菜单
Private Sub mnuCheckAll_Click()
    Dim lngRow As Long
        
    If mintChkAmtCol > 0 Then
        For lngRow = 1 To msgGrid.Rows - 1
            If msgGrid.TextMatrix(lngRow, 1) <> "√" Then
                msgGrid.TextMatrix(lngRow, 1) = "√"
                msgGrid.TextMatrix(lngRow, mintChkAmtCol) = strFormat(GetValue(lngRow, mintUnChkAmtCol), gclsBase.NaturalCurDec)
                msgGrid.TextMatrix(lngRow, mintChkQtyCol) = msgGrid.TextMatrix(lngRow, mintUnChkQtyCol)
                ShowHlb mintChkAmtCol, C2Dbl(hLb(mintChkAmtCol).Caption) + GetValue(lngRow, mintUnChkAmtCol)
            End If
        Next lngRow
    End If
 End Sub

'响应完全取消菜单
Private Sub mnuUndoCheck_Click()
    Dim lngRow As Long
    
    If mintChkAmtCol > 0 And mintChkQtyCol > 0 Then
        For lngRow = 1 To msgGrid.Rows - 1
            If msgGrid.TextMatrix(lngRow, 1) = "√" Then
                ShowHlb mintChkAmtCol, C2Dbl(hLb(mintChkAmtCol).Caption) - GetValue(lngRow, mintChkAmtCol)
                msgGrid.TextMatrix(lngRow, 1) = ""
                msgGrid.TextMatrix(lngRow, mintChkAmtCol) = ""
                msgGrid.TextMatrix(lngRow, mintChkQtyCol) = ""
            End If
        Next lngRow
    End If
End Sub

'响应窗体按钮动作
Private Sub Cmdall_Click(Index As Integer)
    Select Case Index
    Case 7                                    '确定存盘
        SaveData (1)
    Case 1                                    '取消
        Unload Me
    Case 2                                    '筛选
        FilterData
    Case 3                                    '栏目设置
        setColumn
    Case 4
         'BillPublic.ShowBill getnumber(msgGrid.Row, 6), mlngDetailID
    Case 5                                   '全部核销
        mnuCheckAll_Click
    Case 6
        mnuUndoCheck_Click                    '全部取消
    End Select
End Sub

'从对应视图取SQL语句并打开、初始化之
Private Function GetList() As rdoResultset
    Dim strSelect As String, strWhere As String, strFrom As String
    Dim strSql As String, strCond As String
    Dim recRecordset As rdoResultset, intCount As Integer
    Dim q2 As rdoQuery
    Dim lngTmpID As Long
    Dim strTmpFrom As String
   ' On Error Resume Next
    
    mclsGrid.ListSet.ViewId = mintViewId
    
    With mclsGrid.ListSet
        strFrom = .FromOfSql
        strSelect = .SelectOfSql
        strWhere = .WhereOfSql
    End With
    
    strCond = " WHERE (ItemActivity.lngCustomerID=" & mlngCustomerID _
        & " AND ItemActivityDetail.lngItemID<>" & mlngItemID _
        & " AND (ItemActivity.lngActivityTypeID in (15,46)) AND (blnIsVoid=0)" _
        & " AND Abs(ItemActivityDetail.dblQuantity-ItemActivityDetail.dblEntrustQuantity" _
        & "+ NVL(DEntrustInToOut.dblQuantity,0))>0.00001 "
    If Trim(strWhere) <> "" Then
        strWhere = strCond & " AND  (" & strWhere & ")"
    Else
        strWhere = strCond
    End If

    lngTmpID = mlngDetailID
    strSelect = "SELECT ItemActivityDetail.lngActivityDetailID As 业务ID," _
        & " DECODE( SIGN(NVL(DEntrustInToOut.dblQuantity+DEntrustInToOut.dblAmount,0)),0,'',DECODE(SIGN(DEntrustInToOut.lngInActivityDetailID- " & lngTmpID & "),0,'√',''))  As 结算," _
        & " NVL(DEntrustInToOut.dblAmount,0) AS 原结算金额," _
        & " NVL(DEntrustInToOut.dblQuantity,0) AS 原结算数量, " _
        & "ItemActivityDetail.dblCostAmount+ItemActivityDetail.dblCostDiff-ItemActivityDetail.dblSaleTax-ItemActivityDetail.dblEntrustAmount+" _
        & " NVL(DEntrustInToOut.dblAmount,0) AS 原未结金额," _
        & "ItemActivityDetail.dblQuantity-ItemActivityDetail.dblEntrustQuantity+" _
        & " NVL(DEntrustInToOut.dblQuantity,0) AS 原未结数量," _
        & "ItemActivity.lngActivityTypeID AS 类型ID," _
        & "ItemActivityDetail.dblQuantity As 原总数量," _
        & "ItemActivityDetail.dblCostAmount As 原总金额," _
        & "dblFactor As 原换算因子," _
        & "ItemActivityDetail.lngItemID," & strSelect
    strTmpFrom = TransferPublic.getDentrustInToOutOraSql
    strTmpFrom = Salary.Change_Text("[DetailID]", mlngDetailID, strTmpFrom)
    strFrom = UCase(strFrom)
    strFrom = Salary.Change_Text("DENTRUSTINTOOUT", " (" & strTmpFrom & ") DENTRUSTINTOOUT ", strFrom)
    strSql = strSelect & " " & strFrom & " " & strWhere
    Set GetList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Exit Function
End Function

'初始化各text框中数据
Private Sub ShowTotalRow()
    Dim dblUnChkAmount As Double
    Dim dblChkAmount As Double
    Dim dblTotalAmount As Double
    On Error Resume Next
    
    dblUnChkAmount = 0
    dblChkAmount = 0
    dblTotalAmount = 0
    mdblLastAmount = 0
    'If Not Datadl.Recordset Is Nothing Then
        'With Datadl.Recordset
    If Not Datadl.Resultset Is Nothing Then
        With Datadl.Resultset
            .MoveFirst
            Do While Not .EOF
                'dblUnChkAmount = dblUnChkAmount + C2Dbl(.Fields("未结金额"))
                'dblChkAmount = dblChkAmount + C2Dbl(IIf(IsNull(.Fields("结算金额")), 0, .Fields("结算金额")))
                'dblTotalAmount = dblTotalAmount + C2Dbl(IIf(IsNull(.Fields("总金额")), 0, .Fields("总金额")))
                dblUnChkAmount = dblUnChkAmount + C2Dbl(.rdoColumns("未结金额"))
                dblChkAmount = dblChkAmount + C2Dbl(IIf(IsNull(.rdoColumns("结算金额")), 0, .rdoColumns("结算金额")))
                dblTotalAmount = dblTotalAmount + C2Dbl(IIf(IsNull(.rdoColumns("总金额")), 0, .rdoColumns("总金额")))
                .MoveNext
            Loop
        End With
    End If
    mdblLastAmount = dblChkAmount
     
    hLb(mintUnChkAmtCol).Caption = strFormat(dblUnChkAmount, gclsBase.NaturalCurDec)
    hLb(mintChkAmtCol).Caption = strFormat(dblChkAmount, gclsBase.NaturalCurDec)
    hLb(mintTotalAmtCol).Caption = strFormat(dblTotalAmount, gclsBase.NaturalCurDec)
End Sub

'结算内容筛选
Private Sub FilterData()
    Dim lngRow As Long
    Dim blnOK As Boolean
    
    If mblnModify Then
        If ShowMsg(Me.hWnd, "筛选操作后，你刚刚做的结算将被取消，需要先存盘吗?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "委托加工入库结算") = IDYES Then
            SaveData (0)
        End If
    End If
    If mclsGrid.ListSet.ListID < 1 Then
       mclsGrid.ListSet.SaveList
    End If
    Filter.ShowFilter mclsGrid.ListSet.ListID, 1, , , , , blnOK
    If blnOK Then
        RefreshGrid
    End If
End Sub

'存盘
'入参 ： kkk=0是存盘不关闭窗体，kkk=1是存盘关闭窗体
'功能 ： 响应存盘操作
Private Sub SaveData(intQuit As Integer)
    Dim strSql As String
    Dim lngRow As Long
    Dim dblQuantity As Double
    Dim dblAmount As Double
    Dim blnSucceed As Boolean
    
    If Not ExclusiveIn(Caption, mclsMainControl.LogID) Then
        Exit Sub
    End If
    
    On Error GoTo Err
    gclsBase.BaseWorkSpace.BeginTrans

    dblAmount = C2Dbl(hLb(mintChkAmtCol).Caption)
    strSql = "UPDATE ItemActivityDetail SET dblEntrustAmount=" & dblAmount _
        & " WHERE lngActivityDetailID=" & mlngDetailID
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    mfrmToFormname.TextOfGrid(mfrmToFormname.GrdCol.Row, 10) = dblAmount
    If mdblInQuantity <> 0 Then
        mfrmToFormname.TextOfGrid(mfrmToFormname.GrdCol.Row, 6) = Abs(dblAmount / mdblInQuantity)
    End If
    
    strSql = "DELETE FROM EntrustInToOut WHERE lngInActivityDetailID=" & mlngDetailID & " AND dblQuantity=0 AND dblAmount=0"
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    
    For lngRow = 1 To msgGrid.Rows - 1
        If (GetValue(lngRow, mintLastChkAmtCol) <> GetValue(lngRow, mintChkAmtCol) Or GetValue(lngRow, mintLastChkQtyCol) <> GetValue(lngRow, mintChkQtyCol)) Then     '前后有否变化
            dblQuantity = NormalToMinQty(GetValue(lngRow, mintChkQtyCol), GetValue(lngRow, mintFactorCol))
            dblAmount = GetValue(lngRow, mintChkAmtCol)
            '新增情况
            If (GetValue(lngRow, mintLastChkAmtCol) = 0 And GetValue(lngRow, mintLastChkQtyCol) = 0) And (dblAmount <> 0 Or dblQuantity <> 0) Then
                strSql = "INSERT INTO EntrustInToOut (lngOutActivityDetailID,lngInActivityDetailID,dblQuantity,dblAmount) " _
                    & " Values(" & GetValue(lngRow, 0) & "," & mlngDetailID & "," & dblQuantity & "," & dblAmount & ")"
            Else
                strSql = "UPDATE EntrustInToOut SET dblQuantity=" & dblQuantity & ",dblAmount =" & dblAmount _
                    & " WHERE lngOutActivityDetailID =" & GetValue(lngRow, 0) & " And lngInActivityDetailID =" & mlngDetailID & ""
            End If
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
            strSql = "UPDATE ItemActivityDetail SET dblEntrustQuantity=dblEntrustQuantity+(" & dblQuantity & ")-(" & GetValue(lngRow, mintLastChkQtyCol) & "), " _
                & "dblEntrustAmount=dblEntrustAmount+(" & dblAmount & ")-(" & GetValue(lngRow, mintLastChkAmtCol) & ") WHERE lngActivityDetailID=" & GetValue(lngRow, 0) & ""
            blnSucceed = gclsBase.ExecSQL(strSql)
            If Not blnSucceed Then GoTo Err
        End If
    Next lngRow
    strSql = "DELETE FROM EntrustInToOut WHERE lngInActivityDetailID=" & mlngDetailID & " AND dblQuantity=0 AND dblAmount=0"
    blnSucceed = gclsBase.ExecSQL(strSql)
    If Not blnSucceed Then GoTo Err
    
    gclsBase.BaseWorkSpace.CommitTrans
    mblnModify = False
    mblnOk = True
    If intQuit = 1 Then
       Unload Me
    End If
    Exit Sub

Err:
    gclsBase.BaseWorkSpace.RollbackTrans
    ShowMsg Me.hWnd, "存盘失败：" & Err.Description, MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Caption
End Sub


'重定窗体中各控件的位置、大小
Private Sub Form_Resize()
    If Me.WindowState = 1 Then
      Exit Sub
    End If