adjustcost.cls

金算盘软件代码

            Reload
            bCancel = 1
        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
        mclsSubClass.CallWndProc Msg, wParam, lParam
        '确保第0列不被拖出
        If frmName.grdCol.ColWidth(0) > 0 Then frmName.grdCol.ColWidth(0) = 0
        For i = 1 To frmName.grdCol.Cols - 1
            If ColProperty(i).blnUsable = False And frmName.grdCol.ColWidth(i) <> 0 Then
                frmName.grdCol.ColWidth(i) = 0
            End If
            If ColProperty(i).blnUsable = True And frmName.grdCol.ColWidth(i) < 490 Then
                frmName.grdCol.ColWidth(i) = 490
            End If
        Next i
        If blnColDrag Then
            blnColDrag = False
            With frmName.grdCol
                My.blnRefresh = False
                If My.bytRegion = FGrid Or My.bytRegion = fpicture Then
                    If My.bytIndex <> .col Then .col = My.bytIndex
                     GrdInputButtonLocal .Row, .col
                End If
                TotalRowAdjust
                My.blnRefresh = True
                'frmname.Refresh
            End With
        End If
        Exit Sub
    End If
    
    If Msg = WM_LBUTTONDOWN Then        '鼠标左键按下
        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
    '取Paint事件矩形区域
        If My.blnRefresh Then
            '取Paint事件矩形区域
            If Not m_pBusy Then
                m_pBusy = True
                GetUpdateRect frmName.grdCol.hwnd, GridClipRect, False
                mclsSubClass.CallWndProc Msg, wParam, lParam
                If frmName.grdCol.Visible Then
                    DrawGridLine
                    DrawReadOnlyCol
    '               Debug.Print Time
                End If
                m_pBusy = False
            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
        MinMax.ptMinTrackSize.y = lngDefaultHeight \ Screen.TwipsPerPixelY
        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.lblHead(5).Visible Then DrawTotalBox
            If frmName.lblHead(5).Visible Then DrawAllButton
        End If
    Else
        mclsHook.CallWndProc Msg, wParam, lParam
    End If
End Sub

Private Sub DrawGridLine()
    
    Dim intI As Integer
    My.blnRefresh = False
    With frmName.grdCol
        
        '画GRID网格线
        For intI = 1 To 40
            '画水平线
            If .RowHeight(0) * intI > .Height Then Exit For
                DrawALine .hwnd, 0, .RowHeight(0) * intI - Screen.TwipsPerPixelY, _
                           .Width, .RowHeight(0) * intI - Screen.TwipsPerPixelY, _
                           GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, SeparateLineColor
            
        Next intI
        '画竖线
        For intI = 0 To .Cols - 1
            If .ColWidth(intI) = 0 Or .ColPos(intI) + .ColWidth(intI) >= .Width - Screen.TwipsPerPixelX Or (Not .ColIsVisible(intI)) Then
            Else
                DrawALine .hwnd, .ColPos(intI) + .ColWidth(intI) - 15, 0, _
                                   .ColPos(intI) + .ColWidth(intI) - 15, .Height, _
                                   GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, SeparateLineColor
            End If
        Next intI
        '画按纽
        If My.bytRegion = FGrid And False Then
            For intI = .LeftCol To .Cols - 1
                If (Not ColProperty(intI).blnReadOnly) And (ColProperty(intI).lngCtrType = TRefer Or ColProperty(intI).lngCtrType = TDate) And .ColIsVisible(intI) And .ColWidth(intI) <> 0 And .ColPos(intI) + .ColWidth(intI) < .Width Then
                    DrawAButton .hwnd, .ColPos(intI) + .ColWidth(intI) - intButtonWidth - 2 * Screen.TwipsPerPixelX, _
                    .RowPos(.Row) + 1 * Screen.TwipsPerPixelY, intButtonWidth, .RowHeight(0) - 2 * Screen.TwipsPerPixelY, 0, _
                    GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom
                End If
            Next intI
        End If
    End With
    My.blnRefresh = True
End Sub
Public Sub DrawReadOnlyCol()
    Dim intLeft As Integer
    Dim i As Integer
    Dim intR As Integer
    Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
    With frmName.grdCol
        If .RowIsVisible(.Rows - 1) = False Then Exit Sub
        intLeft = .LeftCol
        If intLeft = 0 Then intLeft = 1
        For i = intLeft To .Cols - 1
            If ColProperty(i).blnReadOnly And .ColIsVisible(i) And .ColWidth(i) <> 0 Then
                If .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) < .Height Then
                    For intR = 1 To 30
                        x1 = .ColPos(i)
                        y1 = .RowPos(.Rows - 1) + .RowHeight(0) * intR
                        If y1 > .Height Then Exit For
                        x2 = .ColPos(i) + .ColWidth(i) - 2 * Screen.TwipsPerPixelX
                        y2 = y1 + .RowHeight(0) - 2 * Screen.TwipsPerPixelY
                        DrawABox .hwnd, x1, y1, x2, y2, _
                        RGB(192, 192, 192), RGB(192, 192, 192)
                    Next intR
                End If
            End If
        Next i
    End With
End Sub
Private Sub DrawShadow(Optional ByVal blnErase As Boolean = False)
    Dim lngColor As Long
    Dim intI As Integer
    With frmName
    
    '画阴影
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
    Else
        lngColor = RGB(128, 128, 128)
    End If
    DrawABox .hwnd, .LblBack.Left + .LblBack.Width, _
                           .LblBack.top + 3 * Screen.TwipsPerPixelY, _
                           .LblBack.Left + .LblBack.Width + 2 * Screen.TwipsPerPixelX, _
                           .LblBack.top + .LblBack.Height + 3 * Screen.TwipsPerPixelY, _
                           lngColor, True
    DrawABox .hwnd, .LblBack.Left + 3 * Screen.TwipsPerPixelX, _
                           .LblBack.top + .LblBack.Height + 0 * Screen.TwipsPerPixelY, _
                           .LblBack.Left + .LblBack.Width + 0 * Screen.TwipsPerPixelX, _
                           .LblBack.top + .LblBack.Height + 3 * Screen.TwipsPerPixelY, _
                           lngColor, True
    
    '画快捷键的下画线
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
    Else
        lngColor = RGB(0, 0, 0)
    End If
    For intI = 0 To 4 Step 4
            DrawBLine .hwnd, .lblHead(intI).Left + .lblHead(intI).Width - 2 * .FontSize * 10, .lblHead(intI).top + .lblHead(intI).Height + 0, _
                .lblHead(intI).Left + .lblHead(intI).Width - 1 * .FontSize * 10, .lblHead(intI).top + .lblHead(intI).Height + 0, lngColor
    Next intI
   End With
End Sub

Public Sub DrawTotalBox(Optional ByVal blnErase As Boolean = False)
    Dim intI As Integer
    Dim lngColor As Long
    With frmName

    '画阴影
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
    Else
        lngColor = RGB(128, 128, 128)
    End If
    DrawABox .hwnd, .LblBack.Left + .LblBack.Width, _
                           .LblBack.top + 3 * Screen.TwipsPerPixelY, _
                           .LblBack.Left + .LblBack.Width + 2 * Screen.TwipsPerPixelX, _
                           .LblBack.top + .LblBack.Height + 3 * Screen.TwipsPerPixelY, _
                           lngColor, True
    DrawABox .hwnd, .LblBack.Left + 3 * Screen.TwipsPerPixelX, _
                           .LblBack.top + .LblBack.Height + 0 * Screen.TwipsPerPixelY, _
                           .LblBack.Left + .LblBack.Width + 0 * Screen.TwipsPerPixelX, _
                           .LblBack.top + .LblBack.Height + 3 * Screen.TwipsPerPixelY, _
                           lngColor, True
    '画标题下的横线
    If blnErase = True Then
        lngColor = RGB(255, 255, 255)
    Else
        lngColor = RGB(0, 0, 0)
    End If
    DrawALine .hwnd, .lblCaption.Left, .lblCaption.top + .lblCaption.Height + 2 * Screen.TwipsPerPixelY, _
        .lblCaption.Left + .lblCaption.Width, .lblCaption.top + .lblCaption.Height + 2 * Screen.TwipsPerPixelY, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, fccolor.lngCaptionForeColor
    '画合计栏上的竖线
    If blnErase = True Then
        lngColor = RGB(255, 255, 255)
    Else
        lngColor = SeparateLineColor
    End If
    For intI = 1 To .grdCol.Cols - 1
        If .grdCol.ColPos(intI) + .grdCol.ColWidth(intI) >= .grdCol.Width - Screen.TwipsPerPixelX Or (Not .grdCol.ColIsVisible(intI)) Then
        Else
            DrawALine .hwnd, .grdCol.Left + .grdCol.ColPos(intI) + .grdCol.ColWidth(intI) - Screen.TwipsPerPixelX, .grdCol.top + .grdCol.Height, _
                        .grdCol.Left + .grdCol.ColPos(intI) + .grdCol.ColWidth(intI) - Screen.TwipsPerPixelX, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0), _
                        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        End If
    Next intI
'    '画GRID下的表格
'    '画GRD及合计栏外框
'    If blnErase = True Then
'        lngColor = RGB(255, 255, 255)
'    Else
'        lngColor = RGB(0, 0, 0)
'    End If
'    DrawABox .hwnd, .grdCol.Left - Screen.TwipsPerPixelX, .grdCol.top - 1 * Screen.TwipsPerPixelY, _
'        .grdCol.Left + .grdCol.Width - 0 * Screen.TwipsPerPixelX, .lblmemo(0).top - 3 * Screen.TwipsPerPixelY, lngColor
'    If blnErase = True Then
''        lngColor = RGB(255, 255, 255)
''        DrawBLine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + 0, _
''            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + 0, lngColor
''        DrawBLine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, _
''            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, lngColor
''        DrawBLine .hwnd, .lblNote(0).Left + .lblNote(0).Width + 30, .grdCol.top + .grdCol.Height, _
''                    .lblNote(0).Left + .lblNote(0).Width + 30, .lblmemo(0).top - 50, lngColor
'    Else
'        lngColor = SeparateLineColor
'        DrawALine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + 0, _
'            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + 0, _
'            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
'        DrawALine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, _
'            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, _
'            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
'        DrawALine .hwnd, .lblNote(0).Left + .lblNote(0).Width + 30, .grdCol.top + .grdCol.Height, _
'                    .lblNote(0).Left + .lblNote(0).Width + 30, .lblmemo(0).top - 30, _
'                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
'    End If

'画GRID下的表格
'画GRD及合计栏外框
    If blnErase = True Then
        lngColor = RGB(255, 255, 255)
    Else
        lngColor = RGB(0, 0, 0)
    End If
    DrawABox .hwnd, .grdCol.Left - Screen.TwipsPerPixelX, .grdCol.top - 1 * Screen.TwipsPerPixelY, _
        .grdCol.Left + .grdCol.Width - 0 * Screen.TwipsPerPixelX, .lblmemo(0).top - 3 * Screen.TwipsPerPixelY, lngColor
    
    DrawABox .hwnd, .grdCol.Left - Screen.TwipsPerPixelX - 2 * Screen.TwipsPerPixelX, _
                            .grdCol.top - 1 * Screen.TwipsPerPixelY - 2 * Screen.TwipsPerPixelY, _
                            .grdCol.Left + .grdCol.Width - 0 * Screen.TwipsPerPixelX + 2 * Screen.TwipsPerPixelX, _
                            .lblmemo(0).top - 3 * Screen.TwipsPerPixelY + 2 * Screen.TwipsPerPixelY, _
                            lngColor
    
    If blnErase = True Then
        lngColor = RGB(255, 255, 255)
        DrawBLine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + 0, _
            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + 0, lngColor
        DrawBLine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, _
            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, lngColor
        DrawBLine .hwnd, .lblNote(0).Left + .lblNote(0).Width + 2 * Screen.TwipsPerPixelX, .grdCol.top + .grdCol.Height, _
                    .lblNote(0).Left + .lblNote(0).Width + 2 * Screen.TwipsPerPixelX, .lblmemo(0).top - 2 * Screen.TwipsPerPixelY, lngColor
    Else
        lngColor = SeparateLineColor
        DrawALine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + 0, _
            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + 0, _
            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        DrawALine .hwnd, .grdCol.Left, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, _