frmdlpurchase.frm

金算盘软件代码

       msgGrid.Row = 1
       msgGrid.RowSel = 1
       msgGrid.Sort = 6
    End If
' End If
Exit Sub
Err:
    ShowMsg Me.hwnd, "栏目设置操作不成功  ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "受托结算"
End Sub

Private Sub Form_Load()
    Set mclsGrid = New NewGrid
    Set mclsGrid.Grid = msgGrid
    Set mclsGrid.Form = Me
    Set bsdate = New Base
    blnIsCancel = False
    SetHelpID Me.hwnd, 10024
    hldate = bsdate.BaseDate
    isinit = True
    mblnFormNoRezise = False
    mclsGrid.ColOfs = intfixl
    GetList
    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    Set mclsGrid.EditText = ytext
    mclsGrid.SetEditText ("结算金额")
    mclsGrid.SetEditText ("结算数量")
    cmdOk(5).Picture = Utility.GetFormResPicture(1001, 0)
    cmdOk(1).Picture = Utility.GetFormResPicture(1002, 0)
    cmdOk(4).Picture = Utility.GetFormResPicture(1010, 0)
    lbdw.Caption = Customernm
    Lbbz(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
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    mfrmToFormname.MousePointer = vbDefault
End Sub
Public Sub GivemeParameter(ToForm As Object, Optional dwID As Long = 0, Optional bzID As Long = 0, Optional ywID As Long = 0)
    Dim strTmp As String
'    CustomerID = dwID
 '   CurrencyID = bzID
    Set mfrmToFormname = ToForm
    mfrmToFormname.MousePointer = vbHourglass
    DetailID = mfrmToFormname.getID                            '取单据业务ID
    CustomerID = C2Lng(mfrmToFormname.lblHead(0).Tag)          '取单位ID
    DispartString mfrmToFormname.lblHead(1).Caption, Currencynm, Customernm       '取单位名称
    CurrencyID = mfrmToFormname.GetFID(7)                      '取币种ID
    Currencynm = mfrmToFormname.lblField(7).Caption            '取币种名称
    DispartString Currencynm, strTmp, Currencynm
    If CustomerID < 1 Then
       mfrmToFormname.MousePointer = vbDefault
       ShowMsg mfrmToFormname.hwnd, "请先输入单位", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "受托结算"
       Exit Sub
    End If
    If CurrencyID < 1 Then
       mfrmToFormname.MousePointer = vbDefault
       ShowMsg mfrmToFormname.hwnd, "请先输入币种", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "受托结算"
       Exit Sub
    End If
    isinit = True
    Me.Show 1
End Sub


Private Sub Form_Unload(Cancel As Integer)
    mfrmToFormname.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
    mclsGrid.GridToListSet
    mclsGrid.ListSet.SaveList
    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(Trim(msgGrid.TextMatrix(getx, gety))) = 0) Or IsNull(msgGrid.TextMatrix(getx, gety)) Then
        getnumber = 0
    Else
        If getx > 0 Then
           getnumber = CDbl(msgGrid.TextMatrix(getx, gety))
        End If
    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, oldsj As Double
Dim str As String
    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 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 ytext.Left > cmdOK(0).Left Then
'              ytext.Text = ""
'              Exit Sub
'           End If
           If (msgGrid.TextMatrix(0, ytextCol) = "结算金额") Then
               If Abs(getnumber(ytextRow, 11)) < Abs(xx) Then
                  ShowMsg Me.hwnd, "结算金额不能大于未结算金额！", 0, 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) = ytext.Text
               hLb(i).Refresh
          Else
                '输入的是结算数量
               If (msgGrid.TextMatrix(0, ytextCol) = "结算数量") And getnumber(ytextRow, 43) <> 0 Then
                   str = Balance.check_modidl(ytext.Text, getnumber(ytextRow, 12), getnumber(ytextRow, 28))
                    If (str <> "A") Then
                       msgGrid.TextMatrix(ytextRow, n) = str
                       str = Balance.translate_minsl(str, getnumber(ytextRow, 28))
                       xx = getnumber(ytextRow, 44) * CDbl(str) / getnumber(ytextRow, 43)
                       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 Me.hwnd, "结算数量输入不正确，请重试！", 0, msgcaption
                       blnCancel = True
                   End If
               End If
           End If
   End If
Exit Sub
Err:
    ShowMsg Me.hwnd, "数据合法性检查失败  ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "受托结算"
    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, zql As Double, 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 And msgGrid.Rows > 1 Then
        If (msgGrid.TextMatrix(0, 1) = "结算") And (msgGrid.MouseCol = 1) Then
               i = intfixl
               k = intfixl
               m = i
               n = i
            '本循环找出本次收款及本次折扣所在的列
           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, 11) <> (getnumber(ytextRow, i)) Then         '打√情况
               msgGrid.TextMatrix(ytextRow, 1) = "√"
               xx = getnumber(ytextRow, 11) - getnumber(ytextRow, i)
               msgGrid.TextMatrix(ytextRow, i) = CStr(getnumber(ytextRow, i) + xx)
               hLb(i).Caption = CStr(CDbl(IIf(Len(hLb(i).Caption) = 0, "0", hLb(i).Caption)) + xx)
               xx = getnumber(ytextRow, 12) - getnumber(ytextRow, k)
               msgGrid.TextMatrix(ytextRow, k) = msgGrid.TextMatrix(ytextRow, 12)
           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, ("请将结算栏放在第一列上！！"), 0, 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 Me.menuchk, , x + 118, y + 418
    End If
End Sub


Private Sub msgGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.Refresh
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