frmdlcommisiongoods.frm

金算盘软件代码

Private Sub Form_Load()
    Dim strTmp As String, strSql As String, recRecordset As rdoResultset
    Dim intTmp As Integer
    
    Set mclsGrid = New NewGrid
    Set mclsGrid.Grid = msgGrid
    Set mclsGrid.Form = Me
    SetHelpID Me.hwnd, 17003
    isinit = True
    blnIsCancel = False
    FrmSubmitAdjustBill.MousePointer = vbHourglass
    DetailID = FrmSubmitAdjustBill.getID
    If IsNull(DetailID) Then
       DetailID = 0
    End If
    CustomerID = C2Lng(FrmSubmitAdjustBill.lblHead(0).Tag)
    DispartString FrmSubmitAdjustBill.lblHead(1).Caption, Currencynm, Customernm
    dblRate = FrmSubmitAdjustBill.lblField(6).Caption
    CurrencyID = FrmSubmitAdjustBill.GetFID(7)
    Currencynm = FrmSubmitAdjustBill.lblField(7).Caption
'    DispartString Currencynm, strTmp, Currencynm
'    CurRateDec CurrencyID, inthl, intTmp
    strSql = "SELECT Currencys.blnIsIndirect As 计价方式, Currencys.bytCurrencyDec As 位数, Currencys.strCurrencyName As 币种 " _
          & " FROM Currencys WHERE (((Currencys.lngCurrencyID)=" & CurrencyID & "));"
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    If recRecordset.RowCount <> 0 Then
        inthl = recRecordset!位数
        blnisDirect = recRecordset!计价方式
        Currencynm = recRecordset!币种
    Else
        inthl = 0
        Currencynm = ""
        blnisDirect = False
    End If
    recRecordset.Close
'    Set mclsGrid.EditText = ytext
'    mclsGrid.SetEditText ("调拨金额")
'    mclsGrid.SetEditText ("调拨数量")
'    Cmdall(7).Picture = Utility.GetFormResPicture(1001, 0)
'    Cmdall(1).Picture = Utility.GetFormResPicture(1002, 0)
'    Cmdall(4).Picture = Utility.GetFormResPicture(1010, 0)
'    lbdw.Caption = Customernm
'    Lbb(1).Caption = Currencynm
    
    mblnFormNoRezise = False
    mclsGrid.ColOfs = intfixl
    GetList
    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    Set mclsGrid.EditText = ytext
    mclsGrid.SetEditText ("调拨金额")
    mclsGrid.SetEditText ("调拨数量")
    Cmdall(7).Picture = Utility.GetFormResPicture(1001, 0)
    Cmdall(1).Picture = Utility.GetFormResPicture(1002, 0)
    Cmdall(4).Picture = Utility.GetFormResPicture(1010, 0)
    lbdw.Caption = Customernm
    Lbb(1).Caption = Currencynm
    If msgGrid.Rows > 1 Then
       msgGrid.col = 1               '对第一列进行排序
       msgGrid.ColSel = 1
       msgGrid.Row = 1
       msgGrid.RowSel = 1
       msgGrid.Sort = 6
    End If
    RedrawForm
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    FrmSubmitAdjustBill.MousePointer = vbDefault
End Sub

Public Sub GivemeParameter(dwID As Long, bzID As Long, Optional ywID As Long = 0)
'dwID:入库单位ID
'bzID:币种ID
'ywID:单据业务ID
'    Dim strTmp As String
'    Dim intTmp As Integer
'    CustomerID = dwID
'    CurrencyID = bzID
'    FrmSubmitAdjustBill.MousePointer = vbHourglass
'    DetailID = FrmSubmitAdjustBill.getID
'    CustomerID = C2Lng(FrmSubmitAdjustBill.lblHead(0).Tag)
'    DispartString FrmSubmitAdjustBill.lblHead(1).Caption, Currencynm, Customernm
'    CurrencyID = FrmSubmitAdjustBill.getFID(7)
'    Currencynm = FrmSubmitAdjustBill.lblField(7).Caption
'    DispartString Currencynm, strTmp, Currencynm
'    CurRateDec CurrencyID, inthl, intTmp
'    If CustomerID < 1 Then
'       FrmSubmitAdjustBill.MousePointer = vbDefault
'       ShowMsg FrmSubmitAdjustBill.hwnd, "请先输入单位！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "委托代销调拨"
'       Exit Sub
'    End If
'    If CurrencyID < 1 Then
'       FrmSubmitAdjustBill.MousePointer = vbDefault
'       ShowMsg FrmSubmitAdjustBill.hwnd, "请先输入币种！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "委托代销调拨"
'       Exit Sub
'    End If
'    isinit = True
'    Show 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
FrmSubmitAdjustBill.MousePointer = vbDefault
    If blnIsCancel = False And msgGrid.Rows > 1 Then
       If Balance.IsChange(msgGrid, 1) Then
            If ShowMsg(Me.hwnd, "确定退出调拨吗", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "委托代销调拨") = IDNO Then
                Cancel = True
                Exit Sub
            End If
       End If
    End If
    
    If msgGrid.Rows > 1 Then
      mclsGrid.GridToListSet
      mclsGrid.ListSet.SaveList
    End If
    Set mclsGrid = Nothing
    Set mlhls = Nothing
'    Set bsdata = Nothing
    Utility.RemoveFormResPicture 1001
    Utility.RemoveFormResPicture 1002
    Utility.RemoveFormResPicture 1010
End Sub
'从Flexgrid中取出数字值
Private Function getnumber(getx As Integer, gety As Integer) As Double
    If (Len(msgGrid.TextMatrix(getx, gety)) = 0 Or IsNull(msgGrid.TextMatrix(getx, gety))) Then
        getnumber = 0
    Else
        getnumber = CDbl(msgGrid.TextMatrix(getx, gety))
    End If
End Function

Private Sub mclsGrid_BeforeSave(blnCancel As Boolean)
'离开TEXT输入框存盘前响应的动作
Dim str As String, p As Integer
    If msgGrid.TextMatrix(0, ytextCol) = "调拨数量" Then
       ytext.Text = ""
       blnCancel = True
    Else
       If (msgGrid.TextMatrix(0, ytextCol) = "调拨金额") Then
           ytext.Text = ""
           blnCancel = True
       End If
    End If

End Sub

Private Sub mclsGrid_DataValid(blnCancel As Boolean)
'离开TEXT输入框时响应的动作
Dim i As Integer, n As Integer, xx As Double, temp As Double, str As String, oldsj As Double
'On Error GoTo Err
    If IsNumeric(ytext.Text) = False And Len(Trim(ytext.Text)) > 0 Then
          blnCancel = True
          Exit Sub
    End If
   ytextRow = msgGrid.Row
   ytextCol = msgGrid.col
   If (msgGrid.TextMatrix(0, ytextCol) = "调拨金额" Or msgGrid.TextMatrix(0, ytextCol) = "调拨数量") Then
       If IsNumeric(ytext.Text) = False Then
          blnCancel = True
          Exit Sub
       End If
       If Len(Trim(ytext.Text)) = 0 Or IsEmpty(ytext.Text) Then
          xx = 0
       Else
          xx = CDbl(ytext.Text)
       End If

       oldsj = getnumber(ytextRow, ytextCol)
       If (oldsj <> xx) Then
                i = intfixl
                n = intfixl
                      
                 '本循环找出本次调拨所在的列
                While (msgGrid.TextMatrix(0, i) <> "调拨金额")
                       i = i + 1
                Wend
                While (msgGrid.TextMatrix(0, n) <> "调拨数量")
                       n = n + 1
                Wend
               
               If (msgGrid.TextMatrix(0, ytextCol) = "调拨金额") Then
                    If Abs(getnumber(ytextRow, 4)) < Abs(xx) Then
                       ShowMsg Me.hwnd, "调拨金额不能大于可调拨金额！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
                       blnCancel = True
                       Exit Sub
                    End If
                      '以上为有效性检查与处理，所得xx数据应是正确的了
                   If xx <> 0 Then
                      msgGrid.TextMatrix(ytextRow, 1) = "√"
                   End If
                   
                   hLb(i).Caption = CStr(CDbl(hLb(i).Caption) + xx - oldsj)       '更新调拨金额
                               
                               '更新数组及列表的调拨金额
                   msgGrid.TextMatrix(ytextRow, i) = CStr(xx)          '此行也许不必
                   hLb(i).Refresh
              Else
                          '输入的是调拨数量
                   If (msgGrid.TextMatrix(0, ytextCol) = "调拨数量") And getnumber(ytextRow, 7) <> 0 Then
                          str = Balance.check_modidl(CStr(xx), getnumber(ytextRow, 5), getnumber(ytextRow, 9))
                          If (str <> "A") Then
                             msgGrid.TextMatrix(ytextRow, n) = str
                             str = Balance.translate_minsl(str, getnumber(ytextRow, 9))
                             xx = getnumber(ytextRow, 8) * CDbl(str) / getnumber(ytextRow, 7)
                             xx = Format(xx, FormatString(inthl))
                            oldsj = getnumber(ytextRow, i)
                            msgGrid.TextMatrix(ytextRow, i) = CStr(xx)
                            If xx <> 0 Then
                               msgGrid.TextMatrix(ytextRow, 1) = "√"
                            End If
                            xx = xx - oldsj          '变化金额
                            hLb(i).Caption = CStr(CDbl(IIf(Len(hLb(i).Caption) = 0, "0", hLb(i).Caption)) + xx)
                         Else
                             ShowMsg hwnd, "调拨数量输入不正确，请重试！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
                             blnCancel = True
                         End If
                       End If
            End If
       End If
 End If
'Exit Sub
'Err:
'    ShowMsg Me.hwnd, "数据合法性检查失败  ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
     'blnCancel = True
End Sub
'本函数用于做结算与非结算处理
Private Sub msgGrid_Click()
Dim i As Integer, k As Integer, intCount As Integer
Dim m As Integer, n As Integer, xx As Double, temp As Double
On Error GoTo Err
    ytextRow = msgGrid.Row
    ytextCol = msgGrid.col
    If ytextRow > 0 And msgGrid.ColSel > 0 And msgGrid.MouseRow > 0 Then
        If (msgGrid.TextMatrix(0, 1) = "选择") And (msgGrid.MouseCol = 1) Then
            i = intfixl
            k = intfixl
           '本循环找出本次调拨所在的列
           While (msgGrid.TextMatrix(0, i) <> "调拨金额")
                  i = i + 1
           Wend
           While (msgGrid.TextMatrix(0, k) <> "调拨数量")
                  k = k + 1
           Wend
           If (msgGrid.TextMatrix(ytextRow, 1) = "") Or getnumber(ytextRow, 4) <> (getnumber(ytextRow, i)) Then         '打√情况
               msgGrid.TextMatrix(ytextRow, 1) = "√"
               xx = getnumber(ytextRow, 4) - getnumber(ytextRow, i)
               msgGrid.TextMatrix(ytextRow, i) = msgGrid.TextMatrix(ytextRow, 4)
                              '总结算金额及数量的更新
               hLb(i).Caption = CStr(CDbl(IIf(Len(hLb(i).Caption) = 0, "0", hLb(i).Caption)) + xx)
               msgGrid.TextMatrix(ytextRow, k) = msgGrid.TextMatrix(ytextRow, 5)
           Else
               msgGrid.TextMatrix(ytextRow, 1) = ""       '取消打√(结算)情况
               hLb(i).Caption = CStr(CDbl(hLb(i).Caption) - getnumber(ytextRow, i))
               msgGrid.TextMatrix(ytextRow, k) = ""
               msgGrid.TextMatrix(ytextRow, i) = ""
               
           End If
           Me.Refresh
        Else
            If (msgGrid.TextMatrix(0, 1) <> "选择") Then
               ShowMsg Me.hwnd, ("请将结算栏放在第一列上！！"), MB_SYSTEMMODAL + MB_ICONEXCLAMATION, msgcaption
            End If
        End If
        msgGrid.Refresh
    End If
Exit Sub
Err:
    ShowMsg Me.hwnd, "系统出错！    ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "委托代销调拨"
End Sub

Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgGrid
        If .MouseCol = 1 Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub

'右键菜单
Private Sub msgGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And msgGrid.Rows > 1 Then
        PopupMenu menuchk, , x + 118, y + 418
    End If
End Sub


'保存yText得到焦点时的数字值
Private Sub yText_GotFocus()
    'oldsj = CDbl(IIf(Len(ytext.Text) = 0, "0", ytext.Text))
End Sub
'当yText失去焦点时将响应的动作
Private Sub yText_LostFocus()

End Sub