clsorder.cls

金算盘软件代码

'
'        If Val(strText) < 0 Then
'            frmName.grdCol.CellForeColor = RGB(255, 0, 0)
' '           frmName.grdCol.TextMatrix(lngRow, lngCol) = IIf(Mid(Mid(strText, 2), 1, 1) = ".", "0" & Mid(strText, 2), Mid(strText, 2))
'        ElseIf Val(strText) = 0 Then
'            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
'            frmName.grdCol.TextMatrix(lngRow, lngCol) = ""
'        Else
''            frmName.grdCol.TextMatrix(lngRow, lngCol) = IIf(Mid(strText, 1, 1) = ".", "0" & strText, strText)
'            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
'        End If
'
'
''        If lngCol = 3 Or lngCol = 11 Then    '计量单位翻译
''            If C2Dbl(strText) < 0 Then
''                strText = Right(strText, Len(strText) - 1)
''            End If
''            frmname.grdCol.TextMatrix(lngRow, lngCol) = BillPublic.DisplayData(strtext,  TransQuantity(C2Lng(frmname.grdCol.TextMatrix(lngRow, ColProperty(2).bytGrdIDCol)), C2Lng(frmname.grdCol.TextMatrix(lngRow, 34)), strText)
''            If lngCol = 3 Then
''                frmname.grdCol.TextMatrix(lngRow, 35) = BillPublic.NumberConvert(strText, C2Dbl(frmname.grdCol.TextMatrix(lngRow, 34)), True)
''            End If
''        End If
'
'        frmName.grdCol.Row = lngR
'        frmName.grdCol.col = lngC
'        My.blnCtrlBinding = blnB
'        My.blnRefresh = True
'    Else
'        frmName.grdCol.TextMatrix(lngRow, lngCol) = strText
'    End If

    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim blnRefreshBak As Boolean
    Dim strNew As String
    
    blnRefreshBak = My.blnRefresh
    If lngRow > frmName.GrdCol.Rows - 1 Or lngCol > frmName.GrdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Sub
    End If
    strText = Trim(strText)
    If blnBackRowCol Then
        lngR = frmName.GrdCol.Row
        lngC = frmName.GrdCol.col
    Else
        lngR = 0
        lngC = 0
    End If
    
    My.blnRefresh = False
    Select Case lngCol
    Case 4, 5   '单价
        strText = Format(C2Dbl(strText), FormatString(gclsBase.PriceDec))
    Case 6      '扣率
        strText = Format(C2Dbl(strText), "0.00")
    Case 7, 9, 14  '原币
        strText = Format(C2Dbl(strText), strCurDec)
    Case 8, 10, 15 '本币
        strText = Format(C2Dbl(strText), strDec)
    Case Else
    End Select
    With frmName.GrdCol
        If .ColAlignment(lngCol) = flexAlignRightCenter And Len(strText) > 0 Then
            If lngR <> lngRow Then
                .Row = lngRow
            End If
            If lngC <> lngCol Then
                .col = lngCol
            End If
            strNew = Left(strText, 1)
            If strNew = "-" Then
                If C2lng(.CellForeColor) <> C2lng(RGB(255, 0, 0)) Then
                    .CellForeColor = RGB(255, 0, 0)
                End If
                .TextMatrix(lngRow, lngCol) = Mid(strText, 2)
            ElseIf Val(strText) = 0 Then
                If C2lng(.CellForeColor) <> C2lng(RGB(0, 0, 0)) Then
                    .CellForeColor = RGB(0, 0, 0)
                End If
                .TextMatrix(lngRow, lngCol) = ""
            Else
                If C2lng(.CellForeColor) <> C2lng(RGB(0, 0, 0)) Then
                    .CellForeColor = RGB(0, 0, 0)
                End If
                .TextMatrix(lngRow, lngCol) = strText
            End If
            If blnBackRowCol Then
                If lngR <> lngRow Then
                    .Row = lngR
                End If
                If lngC <> lngCol Then
                    .col = lngC
                End If
            End If
        Else
            If lngCol = 20 Then
                .TextMatrix(lngRow, lngCol) = IIf(C2lng(strText) = 0, "", C2lng(strText))
            Else
                .TextMatrix(lngRow, lngCol) = strText
            End If
        End If
    End With
    My.blnRefresh = blnRefreshBak
End Sub
'------------------------------
'从GRID上某一单元格内取出字符串
'------------------------------
Public Function strGrdCell(ByVal lngRow As Long, ByVal lngCol As Long, Optional blnBackRowCol As Boolean = True) As String
'    Dim lngR As Long, lngC As Long
'    Dim blnB As Boolean
'    If lngRow > frmName.grdCol.Rows - 1 Or lngCol > frmName.grdCol.Cols - 1 Or _
'       lngRow < 0 Or lngCol < 0 Then
'        Exit Function
'    End If
'    If frmName.grdCol.ColAlignment(lngCol) = flexAlignRightCenter Then
'        blnB = My.blnCtrlBinding
'        My.blnRefresh = False
'        My.blnCtrlBinding = False
'        lngR = frmName.grdCol.Row
'        lngC = frmName.grdCol.col
'        frmName.grdCol.Row = lngRow
'        frmName.grdCol.col = lngCol
'        If C2lng(frmName.grdCol.CellForeColor) = C2lng(RGB(255, 0, 0)) Then
'            strGrdCell = FilterString(CStr(C2Dbl(frmName.grdCol.TextMatrix(lngRow, lngCol))) * (-1))
'        Else
'            strGrdCell = FilterString(frmName.grdCol.TextMatrix(lngRow, lngCol))
'        End If
'        frmName.grdCol.Row = lngR
'        frmName.grdCol.col = lngC
'        My.blnCtrlBinding = blnB
'        My.blnRefresh = True
'    Else
'        strGrdCell = frmName.grdCol.TextMatrix(lngRow, lngCol)
'    End If
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim blnRefreshBak As Boolean
    Dim strTmp As String
    
    blnRefreshBak = My.blnRefresh
    
    With frmName.GrdCol
        If lngRow > .Rows - 1 Or lngCol > .Cols - 1 Or _
           lngRow < 0 Or lngCol < 0 Then
            Exit Function
        End If
        If .ColAlignment(lngCol) = flexAlignRightCenter Then
            If C2Dbl(.TextMatrix(lngRow, lngCol)) = 0 Then
                strGrdCell = ""
                Exit Function
            Else
                My.blnRefresh = False
                If blnBackRowCol Then
                    lngR = .Row
                    lngC = .col
                End If
                If lngR <> lngRow Then
                    .Row = lngRow
                End If
                If lngC <> lngCol Then
                    .col = lngCol
                End If
                If CLng(.CellForeColor) = CLng(RGB(255, 0, 0)) Then
                    strTmp = "-" & .TextMatrix(lngRow, lngCol)
                Else
                    strTmp = .TextMatrix(lngRow, lngCol)
                End If
                If blnBackRowCol Then
                    If lngR <> lngRow Then
                        .Row = lngR
                    End If
                    If lngC <> lngCol Then
                        .col = lngC
                    End If
                End If
                strGrdCell = FilterString(strTmp, ",")
                My.blnRefresh = blnRefreshBak
            End If
        Else
            strGrdCell = .TextMatrix(lngRow, lngCol)
        End If
    End With
End Function

Private Sub Class_Terminate()
    Set mclsSubClass = Nothing
    Set mclsHook = Nothing
    Set HookHe = Nothing
    Erase Field
    Erase ColProperty
    Erase lngPosition
    Erase strColRow
    Set ColBill = Nothing  '单据内容集合(不包括ActivityID和DetailID)
    Set ctrInput = Nothing
    Set frmName = Nothing
    Set clsRecord = Nothing
    Set clsRecordCustomer = Nothing
    Set DiscInfos = Nothing
    Set NewQ = Nothing
End Sub
Private Sub HookHe_OnMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    Dim lngSelStart As Long
    
    If Msg = WM_CHAR Or Msg = WM_KEYDOWN Or Msg = WM_KEYUP Then
        If m_bBusy Then
            bCancel = 1
            GoTo EndProc
        End If
        If blnMenuVisible Then
            GoTo EndProc
        End If
    End If

    If Msg = WM_KEYDOWN Then
        If wParam = 37 Or wParam = 39 Then
            If Not ctrInput Is Nothing Then
                If UCase(ctrInput.Name) = UCase("QuanInput") Then
                    lngSelStart = NewQ.SelStart
                Else
                    lngSelStart = ctrInput.SelStart
                End If
            End If
        End If
        If wParam = 38 Or wParam = 40 Or wParam = 9 Or wParam = 13 Then      'TAB键处理程序
            If wParam = 13 And UCase(frmName.ActiveControl.Name) = "CMDBUTTON" Then
                If frmName.ActiveControl.index < 4 Then
                    blnKeyInForm = False
                Else
                    blnKeyInForm = True
                End If
            Else
                blnKeyInForm = True
            End If
        ElseIf wParam = 37 Then
            If Not ctrInput Is Nothing And My.bytRegion <> FcmdButton And My.bytRegion <> FCheck Then
                If lngSelStart = 0 Then
                    blnKeyInForm = True
                End If
            Else
                blnKeyInForm = True
            End If
        ElseIf wParam = 39 Then
            If Not ctrInput Is Nothing And My.bytRegion <> FcmdButton And My.bytRegion <> FCheck Then
                If lngSelStart = Len(TextOfCtrInput) Then
                    blnKeyInForm = True
                End If
            Else
                blnKeyInForm = True
            End If
        ElseIf wParam = 27 Then 'ESCAPE
            blnKeyInForm = True
            If ctrInput Is Nothing Then

            Else
                If UCase(ctrInput.Name) = "REFINPUT" Or UCase(ctrInput.Name) = "DTMINPUT" Or UCase(ctrInput.Name) = "CURINPUT" Or UCase(ctrInput.Name) = "RECLIST" Then
                    If UCase(ctrInput.Name) = "REFINPUT" Then
                        If ctrInput.ReferVisible Then
'                            ctrInput.PopRefer False
                            blnEscNoCancel = True
                            GoTo EndProc
                        End If
                    ElseIf UCase(ctrInput.Name) = "DTMINPUT" Or UCase(ctrInput.Name) = "CURINPUT" Then
                        If ctrInput.IsDropDown Then
                            blnEscNoCancel = True
                            GoTo EndProc
                        End If
                    ElseIf UCase(ctrInput.Name) = "RECLIST" Then
                        If ctrInput.ReferVisible Then
'                            ctrInput.PopRefer False
                            blnEscNoCancel = True
                            GoTo EndProc
                        End If
                    End If
                End If
            End If
            blnEscNoCancel = False
        End If
    End If
    If Msg = WM_KEYUP Then
'        Debug.Print time & vbTab & wParam
        If Not blnKeyInForm Then GoTo EndProc
'        Debug.Print "2" & time & vbTab & wParam
        blnKeyInForm = False
        If wParam = 37 Or wParam = 38 Or wParam = 39 Or wParam = 40 Or wParam = 9 Or wParam = 13 Then      'TAB键处理程序
            If wParam = 13 Then
                If GetKeyState(17) < 0 Then
                    GoTo EndProc
                End If
            End If

            If Not m_bBusy Then
                m_bBusy = True
                TabOrder (wParam)
'                bCancel = 1
                m_bBusy = False
            End If
        ElseIf wParam = 27 Then 'ESCAPE
            If Not blnEscNoCancel Then
                #If conWan = 1 Then
                  If My.bytRegion = FCheck Then
                      Unload frmName
                  Else
                      ChkSetFocus 0
                  End If
                #Else
                  If My.bytRegion = FcmdButton And My.bytIndex = 0 Then
                      Unload frmName
                  Else
                      cmdButton_Click 0
                  End If
                #End If
            Else
                blnEscNoCancel = False
            End If
'            Reload
'            bCancel = 1
        End If
    End If
EndProc:
    #If conWan = 1 Then
      If Msg <> WM_MOUSEMOVE And Msg <> 280 Then