takestock.cls

金算盘软件代码

        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_WINDOWPOSCHANGING Then
        If ctrInput Is Nothing Then

        Else
            On Error Resume Next
            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" Or UCase(ctrInput.Name) = "RECLIST" Then
                    If ctrInput.ReferVisible Then
                        ctrInput.PopRefer False
                        Exit Sub
                    End If
'                ElseIf UCase(ctrInput.Name) = "DTMINPUT" Or UCase(ctrInput.Name) = "CURINPUT" Then
'                    If ctrInput.IsDropDown Then
'
'                    End If
                End If
            End If
        End If
    End If
    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
    Dim lngRowheight As Long
    My.blnRefresh = False
    Dim lngHdc As Long
    SeparateLineColor = fccolor.lngGridLineColor   'GRID列分隔线色
    With frmName.GrdCol
        lngHdc = GetDC(.hWnd)
        lngRowheight = .RowHeight(0)
        '画GRID网格线
        For intI = 1 To 40
            '画水平线
            If lngRowheight * intI > .Height Then Exit For
'                DrawALine lngHdc, 0, lngRowheight * intI - Screen.TwipsPerPixelY, _
'                           .width, lngRowheight * intI - Screen.TwipsPerPixelY, _
'                           GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, SeparateLineColor
            If frmName.GrdCol.Row <> 0 And (intI = frmName.GrdCol.Row - frmName.GrdCol.TopRow + 1 Or intI = frmName.GrdCol.Row - frmName.GrdCol.TopRow + 2) Then
                DrawBLine lngHdc, 0, lngRowheight * intI - Screen.TwipsPerPixelY, _
                           .width, lngRowheight * intI - Screen.TwipsPerPixelY, _
                            C2lng(RGB(0, 0, 255))   'frmName.lblCaption.ForeColor
            Else
                DrawBLine lngHdc, 0, lngRowheight * intI - Screen.TwipsPerPixelY, _
                           .width, lngRowheight * intI - Screen.TwipsPerPixelY, _
                            SeparateLineColor
            End If
            
        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 lngHdc, .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 lngHdc, .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
        ReleaseDC .hWnd, lngHdc
    End With
    If frmName.chkPrint(1).Value = 0 Then
'        frmName.grdCol.Refresh
    Else
'        frmName.PaintPicture Utility.GetFormResPicture(1024, 0), _
'                frmName.lblCaption.Left + frmName.lblCaption.Width + 30, frmName.LblBack.top
        DrawAIcon frmName.GrdCol.hWnd, frmName.lblCaption.Left + frmName.lblCaption.width, frmName.GrdCol.RowHeight(0), 1024
        Utility.RemoveFormResPicture (1024)
    End If

    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
    Dim lngHdc As Long
    Dim lngRowheight As Long
    
    With frmName.GrdCol
        lngRowheight = .RowHeight(0)
        lngHdc = GetDC(.hWnd)
        If .RowIsVisible(.Rows - 1) = False Then Exit Sub
        intLeft = 1
        If intLeft = 0 Then intLeft = 1
        For i = intLeft To .Cols - 1
            If ColProperty(i).blnReadOnly Then
               If .ColIsVisible(i) And .ColWidth(i) <> 0 Then
                  x1 = .ColPos(i)
                  x2 = .ColPos(i) + .ColWidth(i) - 2 * Screen.TwipsPerPixelX
                  If .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) < .Height Then
                      y1 = .RowPos(.Rows - 1) + lngRowheight
                      y2 = y1 - 2 * Screen.TwipsPerPixelY
                      For intR = 1 To 30
                          y2 = y2 + lngRowheight  '.RowPos(.Rows - 1) + lngRowHeight * intR
                          If y2 > .Height Then
                             y2 = y2 - lngRowheight
                             Exit For
                          End If
                      Next intR
                      DrawABox lngHdc, x1, y1, x2, y2, RGB(192, 192, 192), RGB(192, 192, 192)
                  End If
               End If
            End If
        Next i
        ReleaseDC .hWnd, lngHdc
    End With
    If frmName.chkPrint(1).Value = 1 Then
        DrawAIcon frmName.GrdCol.hWnd, frmName.lblCaption.Left + frmName.lblCaption.width, lngRowheight, 1024
        Utility.RemoveFormResPicture (1024)
    End If
End Sub
Private Sub DrawShadow(Optional ByVal blnErase As Boolean = False)
    Dim lngColor As Long
    Dim intI As Integer
    Dim lngHdc As Long
    With frmName
    lngHdc = GetDC(.hWnd)
    
    '画阴影
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
    Else
        lngColor = RGB(128, 128, 128)
    End If
    DrawABox lngHdc, .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 lngHdc, .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 2
            DrawBLine lngHdc, .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
    ReleaseDC .hWnd, lngHdc
   End With
End Sub

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

    '画阴影
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
    Else
        lngColor = RGB(128, 128, 128)
    End If
    DrawABox lngHdc, .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 lngHdc, .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 lngHdc, .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 lngHdc, .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 lngHdc, .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 lngHdc, .grdCol.Left, .grdCol.top + .grdCol.Height + 0, _
'            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + 0, lngColor
'        DrawBLine lngHdc, .grdCol.Left, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, _
'            .grdCol.Left + .grdCol.Width, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0) + 0, lngColor
'        DrawBLine lngHdc, .lblNote(0).Left + .lblNote(0).Width + 30, .grdCol.top + .grdCol.Height + .grdCol.RowHeight(0), _
'                    .lblNote(0).Left + .lblNote(0).Width + 30, .lblmemo(0).top - 30, lngColor
'    Else
'        lngColor = SeparateLineColor
'        DrawALine lngHdc, .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 lngHdc, .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 lngHdc, .lblNote(0).Left + .lblNote(0).Width + 30, .grdCol.top + .grdCol.Height, _
'                    .lblNote(0).Left + .lblNote(0).Width + 30, .lblmemo(0).top - 50, _
'                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
'    End If

    '画GRID下的表格
'画GRD及合计栏外框
    If blnErase = True Then
        lngColor = RGB(255, 255, 255)
    Else
        lngColor = fccolor.lngGridBorderColor
    End If
    DrawABox lngHdc, .GrdCol.Left - Screen.TwipsPerPixelX, .GrdCol.top - 1 * Screen.TwipsPerPixelY, _
        .GrdCol.Left + .GrdCol.width - 0 * Screen.TwipsPerPixelX, .LblMemo(0).top - 6 * Screen.TwipsPerPixelY, lngColor

    DrawABox lngHdc, .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 - 6 * Screen.TwipsPerPixelY + 2 * Screen.TwipsPerPixelY, _
                            lngColor
    
    If blnErase = True Then
        lngColor = RGB(255, 255, 255)
        DrawBLine lngHdc, .GrdCol.Left, .GrdCol.top + .GrdCol.Height + 0, _
            .GrdCol.Left + .GrdCol.width, .GrdCol.top + .GrdCol.Height + 0, lngColor
        DrawBLine lngHdc, .GrdCol.Left, .GrdCol.top + .GrdCol.Height + .GrdCol.RowHeight(0) + 0, _
            .GrdCol.Left + .GrdCol.width, .GrdCol.top + .GrdCol.Height + .GrdCol.RowHeight(0) + 0, lngColor
        DrawBLine lngHdc, .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 - 5 * Screen.TwipsPerPixelY, lngColor
    Else
        lngColor = fccolor.lngGridBorderColor
        DrawALine lngHdc, .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 lngHdc, .GrdCol.Left, .GrdCol.top + .GrdCol.Height, _
            .GrdCol.Left + .GrdCol.width, .GrdCol.top + .GrdCol.Height, _
            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        DrawALine lngHdc, .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 - 5 * Screen.TwipsPerPixelY, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
    End If
    
    '画备注框
    Dim lngX2 As Long
    If .LblMemo(2).Visible Then
        lngX2 = .LblMemo(3).Left + .LblMemo(3).width + Screen.TwipsPerPixelX
    Else
        lngX2 = .LblMemo(1).Left + .LblMemo(1).width + Screen.TwipsPerPixelX
    End If
    If blnErase = True Then
'        lngColor = RGB(255, 255, 255)
'        DrawABox lngHdc, .lblmemo(0).Left - Screen.TwipsPerPixelX, _
'                           .lblmemo(0).top - Screen.TwipsPerPixelY, _
'