billset.cls

金算盘软件代码

                    If My.bytRegion = FNote Then
                        If wParam = 38 Then
                            If frmName.GrdCol.Row = 1 Then
                                mblnKeyDown = True
                            End If
                        ElseIf wParam = 40 Then
                            If frmName.GrdCol.Row = frmName.GrdCol.Rows - 1 Then
                                mblnKeyDown = True
                            End If
                        End If
                    Else
                        mblnKeyDown = True
                    End If
                Else
                    mblnKeyDown = True
 '                   bCancel = 1
                End If
            ElseIf wParam = 37 Then ' left
                If My.bytRegion = FField Or My.bytRegion = FHead Or My.bytRegion = FNote Or My.bytRegion = FGrid Or My.bytRegion = FcmdFooter Or My.bytRegion = FFooter Then
                    If Not ctrInput Is Nothing Then
                        If ctrInput.SelStart = 0 Then
                            mblnKeyDown = True
                        End If
                    Else
                        mblnKeyDown = True
                    End If
                ElseIf My.bytRegion = FPicture Then
                    If Not ctrPicInput Is Nothing Then
                        If ctrPicInput.SelStart = 0 Then
                            mblnKeyDown = True
                        End If
                    Else
                        mblnKeyDown = True
                    End If
                Else
                    mblnKeyDown = True
                End If
            ElseIf wParam = 39 Then 'right
                If My.bytRegion = FField Or My.bytRegion = FHead Or My.bytRegion = FNote Or My.bytRegion = FGrid Or My.bytRegion = FcmdFooter Or My.bytRegion = FFooter Then
                    If Not ctrInput Is Nothing Then
                        If ctrInput.SelStart = Len(ctrInput.Text) Then
                            mblnKeyDown = True
                        End If
                    Else
                        mblnKeyDown = True
                    End If
                ElseIf My.bytRegion = FPicture Then
                    If Not ctrPicInput Is Nothing Then
                        If ctrPicInput.Name = "cashInput" Then
                            If ctrPicInput.SelStart = Len(ctrPicInput.Text) - 1 Then
                                mblnKeyDown = True
                            End If
                        ElseIf ctrPicInput.SelStart = Len(ctrPicInput.Text) Then
                            mblnKeyDown = True
                        End If
                    Else
                        mblnKeyDown = True
                    End If
                Else
                    mblnKeyDown = True
                End If
            ElseIf wParam = 27 Then
                mblnKeyDown = True
            End If
        End If
    End If
    If Msg = WM_KEYUP Then
        If mblnKeyDown = False Then Exit Sub
        mblnKeyDown = False
        
        If wParam = 13 Then
             If GetKeyState(17) < 0 Then
                  Exit Sub
             End If
        End If
        
        
        If frmName.refInput(0).ReferVisible Or frmName.refInput(1).ReferVisible Or frmName.refInput(2).ReferVisible Or frmName.dtmInput.IsDropDown = 1 Or frmName.cashInput.IsDropDown = 1 Then
            Exit Sub
        End If
        
        If wParam = 37 Or wParam = 38 Or wParam = 39 Or wParam = 40 Or wParam = 9 Then
            If Not blnBusy = True Then
                blnBusy = True
                If wParam = 9 And GetKeyState(16) < 0 Then
                    ShiftTaborder
                Else
                    TabOrder (wParam)
                End If
                blnBusy = False
            End If
        ElseIf wParam = 13 Then     'TAB键处理程序
            If GetKeyState(17) < 0 Then Exit Sub
            If Not blnBusy = True Then
                blnBusy = True
                TabOrder (wParam)
                blnBusy = False
            End If
        ElseIf wParam = 27 Then 'ESCAPE
                Reload
        End If
    End If
End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim lngX As Long, lngY As Long
    Dim sinX As Single, sinY As Single
    Dim lngCnt As Long
    Dim i As Integer, mOldRow As Integer, mOldCol As Integer
    Dim intRow As Integer
    Static blnColDrag As Boolean

    lngX = (lParam Mod (2 ^ 16)) * Screen.TwipsPerPixelX
    lngY = (lParam \ (2 ^ 16)) * Screen.TwipsPerPixelY
    sinX = lngX
    sinY = lngY

    If Msg = WM_LBUTTONUP Then
        If mblngrdCellDoing Then Exit Sub
        mclsSubClass.CallWndProc Msg, wParam, lParam
        If blnColDrag Then
            blnColDrag = False
            My.blnRefresh = False
            '确保第0列不被拖出
            If frmName.GrdCol.ColWidth(0) > 0 Then frmName.GrdCol.ColWidth(0) = 0
            '确保后面的列不被拖出
            For i = 5 To frmName.GrdCol.Cols - 2
                If frmName.GrdCol.ColWidth(i) > 0 Then frmName.GrdCol.ColWidth(i) = 0
            Next i
            If mblnLeftRight = False Then '非左右结构
                If frmName.GrdCol.ColWidth(26) > 0 Then frmName.GrdCol.ColWidth(26) = 0
            Else  '左右结构
                If frmName.GrdCol.ColWidth(26) <= 8 * 2 * lngOneTextWidth Then frmName.GrdCol.ColWidth(26) = 8 * 2 * lngOneTextWidth
            End If
            For i = 1 To 4
                If ColProperty(i).blnUsable Then
                    If frmName.GrdCol.ColWidth(i) <= 8 * 2 * lngOneTextWidth Then frmName.GrdCol.ColWidth(i) = 8 * 2 * lngOneTextWidth
                End If
            Next i
            grdColWidthAdjust
            With frmName.GrdCol
                If My.bytRegion = FGrid Or My.bytRegion = FPicture Then

                    If My.lngOldCol <> .col Then
                        .col = My.lngOldCol
                    End If
                    If My.lngOldCol = 1 Then    'My.bytIndex = 1
                        GrdInputButtonLocal .Row, .col
                    Else
                        If Not ctrInput Is Nothing Then SaveInput2Form
                        GrdInputButtonLocal .Row, .col, True
                    End If
                End If
'                TotalRowAdjust True
                blnPaint = True
            End With
            My.blnRefresh = True
        End If
        Exit Sub
    End If
    
    If Msg = WM_LBUTTONDOWN Then        '鼠标左键按下
        If mblngrdCellDoing Then Exit Sub
        With frmName.GrdCol
            If .MouseRow < .FixedRows Then    '点中固定行
                '判断鼠标是否点中列线以便拖动
                i = .MouseCol
                If lngX >= .ColPos(i) + .ColWidth(i) - 50 Or lngX <= .ColPos(i) + 50 Then
                    blnColDrag = True
                End If
            End If
        End With
        mclsSubClass.CallWndProc Msg, wParam, lParam
        Exit Sub
    End If
        
    If Msg = WM_PAINT Then
        If blnNoPaint Then
            DefWindowProc frmName.GrdCol.hWnd, Msg, wParam, lParam
            blnNoPaint = False
        Else
           If My.blnRefresh Then
                '取Paint事件矩形区域
                GetUpdateRect frmName.GrdCol.hWnd, GridClipRect, False
                If My.bytRegion = FGrid Or My.bytRegion = FPicture Then
                    If blnPaint = False Then
                        unRefreshRect frmName.GrdCol.hWnd, frmName.GrdCol.ColPos(frmName.GrdCol.col), frmName.GrdCol.RowPos(frmName.GrdCol.Row), frmName.GrdCol.ColPos(frmName.GrdCol.col) + frmName.GrdCol.ColWidth(frmName.GrdCol.col), frmName.GrdCol.RowPos(frmName.GrdCol.Row) + frmName.GrdCol.RowHeight(frmName.GrdCol.Row)
                        blnPaint = False
                    Else
                        blnPaint = False
    '                    Debug.Print time
                    End If
                End If
                mclsSubClass.CallWndProc Msg, wParam, lParam
                DrawGridLine
            End If
        End If
    Else
        mclsSubClass.CallWndProc Msg, wParam, lParam
    End If
End Sub
Private Sub mclsHook_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = lngDefaultWidth \ Screen.TwipsPerPixelX + 9
        MinMax.ptMinTrackSize.y = lngDefaultHeight \ Screen.TwipsPerPixelY + 0
        MinMax.ptMaxTrackSize.x = 1800
        MinMax.ptMaxTrackSize.y = 1600
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
        Exit Sub
    End If

    If Msg = WM_PAINT Then
        If My.blnRefresh Then
                '取Paint事件矩形区域
                GetUpdateRect frmName.hWnd, FormClipRect, False
                mclsHook.CallWndProc Msg, wParam, lParam
                If frmName.GrdCol.Visible Then DrawTotalBox
       End If
    ElseIf Msg = WM_LBUTTONDOWN Or Msg = WM_LBUTTONUP Then
        If mblngrdCellDoing Then
            mclsHook.CallWndProc Msg, wParam, lParam
        End If
    Else
        mclsHook.CallWndProc Msg, wParam, lParam
    End If
'    If Msg = WM_NCLBUTTONDOWN Then
'        If UCase(ctrInput.Name) = UCase("refInput") Then
'            ctrInput.PopRefer False
'        ElseIf UCase(ctrPicInput.Name) = UCase("refInput") Then
'            ctrPicInput.PopRefer False
'        End If
'    End If
End Sub

Private Sub DrawGridLine()
    Dim intCur As Integer
    Dim intRate As Integer
    Dim intI As Integer
    Dim lngLenth As Long
    Dim lngStrLen As Long
    Dim strCode As String
    Dim strName As String
    Dim strCur As String
    Dim lngColor As Long
    Dim hdc As Long
    Dim lngWidth As Long
    Dim lngHeight As Long
    Dim lng3left As Long
    Dim lng3Right As Long
    Dim lng3Width As Long
    Dim lngLeft As Long
    Dim lngTop As Long
    
    My.blnRefresh = False
    With frmName.GrdCol
    hdc = GetDC(.hWnd)
    lngHeight = .Height
    lngWidth = .width
    lng3left = .ColPos(3)
    lng3Width = .ColWidth(3)
    lng3Right = lng3left + lng3Width
    If ColProperty(3).blnUsable Then
        '写第三列上显示的文本
        For intI = .TopRow To .Rows - 1
            lngLenth = (lng3Width \ 2 - 2 * Screen.TwipsPerPixelX) \ lngOneTextWidth
            lngTop = .RowPos(intI)
            WriteAString hdc, lng3left + 2 * Screen.TwipsPerPixelX, _
                              lngTop + Screen.TwipsPerPixelY, _
                              .TextMatrix(intI, 5), lngLenth
            If C2Dbl(.TextMatrix(intI, 6)) <> 0 Then
                lngStrLen = lng3left + lng3Width \ 2 + 2 * Screen.TwipsPerPixelX
                WriteAString hdc, lngStrLen, _
                                  lngTop + Screen.TwipsPerPixelY, _
                                  .TextMatrix(intI, 6), lngLenth
             End If
            If C2Dbl(.TextMatrix(intI, 9)) <> 0 Then
                strCur = .TextMatrix(intI, 9)
                If Left(strCur, 1) = "-" Then
                    lngColor = RGB(255, 0, 0)
                    strCur = Mid(strCur, 2)
                Else
                   lngColor = RGB(0, 0, 0)
                End If
                lngLenth = (lng3Width - 2 * Screen.TwipsPerPixelX) \ lngOneTextWidth
                lngStrLen = lng3left + 2 * Screen.TwipsPerPixelX
                WriteAString hdc, lngStrLen, _
                                    lngTop + lngOldHeight + 10, _
                                    strCur, lngLenth, lngColor
            End If
        Next intI
        For intI = 1 To 40
            '画第三列上线条
            If lngOldHeight * (2 * intI + 1) > .Height Then Exit For
            '横线
            DrawALine hdc, lng3left, lngOldHeight * (2 * intI + 1), _
                       lng3Right, lngOldHeight * (2 * intI + 1), _
                       GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom
            '竖线
            DrawALine hdc, lng3left + lng3Width / 2, lngOldHeight * (2 * intI), _
                       lng3left + lng3Width / 2, lngOldHeight * (2 * intI + 1), _
                       GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom
        Next intI
    End If
    '写第4,5列上显示的文本
    If blnCashLine Then
        For intI = .TopRow To .Rows - 1
            If .RowIsVisible(intI) = False Then Exit For
            WriteCashAmount hdc, intI, 4
         '   WriteCashAmount hdc, intI, 26
        Next intI
        DrawCashLine hdc, 4, GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom
        'DrawCashLine hdc, 26, GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom
    End If
    '画GRID网格线
    For intI = 1 To 40
        '画水平线