clsr_p.cls

金算盘软件代码

    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 2
            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
    Dim hdc As Long
    Dim lngL As Long
    Dim lngLeft As Long
    Dim lngRight As Long
    Dim lngTop As Long
    Dim lngButton As Long
    Dim lngWidth As Long
    With frmName
    hdc = GetDC(.hWnd)
    DrawAllButton hdc
    '画阴影
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
    Else
        lngColor = RGB(128, 128, 128)
    End If
    lngLeft = .LblBack.Left
    lngTop = .LblBack.top
    lngRight = lngLeft + .LblBack.width
    lngButton = lngTop + .LblBack.Height
    DrawABox hdc, lngRight, _
                  lngTop + 3 * Screen.TwipsPerPixelY, _
                  lngRight + 2 * Screen.TwipsPerPixelX, _
                  lngButton + 3 * Screen.TwipsPerPixelY, _
                  lngColor, True
    DrawABox hdc, lngLeft + 3 * Screen.TwipsPerPixelX, _
                  lngButton, _
                  lngRight, _
                  lngButton + 3 * Screen.TwipsPerPixelY, _
                           lngColor, True
    '画标题下的横线
    If blnErase = True Then
        lngColor = fccolor.lngBackColor
    Else
        lngColor = fccolor.lngCaptionForeColor
    End If
    lngLeft = .lblCaption.Left
    lngTop = .lblCaption.top
    lngRight = lngLeft + .lblCaption.width
    lngButton = lngTop + .lblCaption.Height
    DrawALine hdc, lngLeft, lngButton + 2 * Screen.TwipsPerPixelY, _
        lngRight, lngButton + 2 * Screen.TwipsPerPixelY, _
        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
    '画合计栏上的竖线
    If blnErase = True Then
        lngColor = fccolor.lngBackColor
    Else
        lngColor = fccolor.lngGridLineColor
    End If
    lngL = .grdCol.Left
    lngTop = .grdCol.top + .grdCol.Height
    lngButton = lngTop + .grdCol.RowHeight(0)
    intI = 1
    lngLeft = .grdCol.Left + .grdCol.ColPos(intI) + .grdCol.ColWidth(intI) - Screen.TwipsPerPixelX
    lngWidth = .grdCol.width
    DrawALine hdc, lngLeft, lngTop, lngLeft, lngButton, FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
    For intI = .grdCol.LeftCol To .grdCol.Cols - 1
        lngLeft = .grdCol.ColPos(intI) + .grdCol.ColWidth(intI) - Screen.TwipsPerPixelX
        If lngLeft >= lngWidth Then
            Exit For
        ElseIf (Not .grdCol.ColIsVisible(intI)) Then
        Else
            DrawALine hdc, lngL + lngLeft, lngTop, _
                        lngL + lngLeft, lngButton, _
                        FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        End If
    Next intI
    '画GRID下的表格
    '画GRD及合计栏外框
    If blnErase = True Then
        lngColor = fccolor.lngBackColor
    Else
        lngColor = fccolor.lngGridBorderColor
    End If
        
    lngLeft = lngL
    lngRight = lngLeft + .grdCol.width
    lngTop = .grdCol.top
    lngButton = lngTop + .grdCol.Height
    
    DrawABox hdc, lngL - Screen.TwipsPerPixelX, lngTop - 1 * Screen.TwipsPerPixelY, _
        lngRight - 0 * Screen.TwipsPerPixelX, .lblNote(0).top + .lblNote(0).Height + 2 * Screen.TwipsPerPixelY, lngColor
    DrawABox hdc, lngL - 3 * Screen.TwipsPerPixelX, _
                  lngTop - 3 * Screen.TwipsPerPixelY, _
                  lngRight + 2 * Screen.TwipsPerPixelX, _
                 .lblNote(0).top + .lblNote(0).Height + 4 * Screen.TwipsPerPixelY, _
                  lngColor
    
'    If blnErase = True Then
'        lngColor = fccolor.lngBackColor
'        DrawBLine hdc, lngLeft, lngButton + 0, _
'            lngRight, lngButton + 0, lngColor
'        DrawBLine hdc, lngLeft, lngButton + .grdCol.RowHeight(0) + 0, _
'            lngRight, lngButton + .grdCol.RowHeight(0) + 0, lngColor
'        DrawBLine hdc, .lblNote(0).Left + .lblNote(0).width + 2 * Screen.TwipsPerPixelX, lngButton, _
'                    .lblNote(0).Left + .lblNote(0).width + 2 * Screen.TwipsPerPixelX, .LblMemo(0).top - 2 * Screen.TwipsPerPixelY, lngColor
'    Else
        lngColor = fccolor.lngGridLineColor
        DrawALine hdc, lngLeft, lngButton, _
            lngRight, lngButton + 0, _
            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        DrawALine hdc, lngLeft, lngButton + .grdCol.RowHeight(0) + 0, _
            lngRight, lngButton + .grdCol.RowHeight(0) + 0, _
            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        DrawALine hdc, .lblNote(0).Left + .lblNote(0).width + 2 * Screen.TwipsPerPixelX, lngButton + .grdCol.RowHeight(0), _
                    .lblNote(0).Left + .lblNote(0).width + 2 * Screen.TwipsPerPixelX, .lblNote(0).top + .lblNote(0).Height + 2 * Screen.TwipsPerPixelY, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        DrawALine hdc, .lblNote(2).Left - 3 * Screen.TwipsPerPixelX, lngButton + .grdCol.RowHeight(0), _
                    .lblNote(2).Left - 3 * Screen.TwipsPerPixelX, .lblNote(0).top + .lblNote(0).Height + 2 * Screen.TwipsPerPixelY, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
        DrawALine hdc, .lblNote(2).Left + .lblNote(2).width + 3 * Screen.TwipsPerPixelX, lngButton + .grdCol.RowHeight(0), _
                    .lblNote(2).Left + .lblNote(2).width + 3 * Screen.TwipsPerPixelX, .lblNote(0).top + .lblNote(0).Height + 2 * Screen.TwipsPerPixelY, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
'    End If
    '画备注框
        lngColor = fccolor.lngGridBorderColor
        DrawABox hdc, .LblMemo(1).Left - Screen.TwipsPerPixelX, _
                           .LblMemo(1).top - Screen.TwipsPerPixelY, _
                           .LblMemo(1).Left + .LblMemo(1).width + 1 * Screen.TwipsPerPixelX, _
                           .LblMemo(1).top + .LblMemo(1).Height - 1 * Screen.TwipsPerPixelY, _
                           lngColor
    If .LblMemo(3).Visible Then
        DrawABox hdc, .LblMemo(3).Left - Screen.TwipsPerPixelX, _
                           .LblMemo(3).top - Screen.TwipsPerPixelY, _
                           .LblMemo(3).Left + .LblMemo(3).width + 1 * Screen.TwipsPerPixelX, _
                           .LblMemo(3).top + .LblMemo(3).Height - 1 * Screen.TwipsPerPixelY, _
                           lngColor
    End If
    
    '画快捷键的下画线
    If blnErase = True Then
        lngColor = RGB(192, 192, 192)
        For intI = 0 To 4 Step 2
            DrawBLine hdc, .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
    Else
        lngColor = RGB(0, 0, 0)
        For intI = 0 To 4 Step 2
            If .lblHead(intI).Visible Then
                DrawALine hdc, .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, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngColor
            Else
                DrawALine hdc, .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, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom, lngBackColor
            End If
        Next intI
    End If
'    '画备注快捷键的下画线
'    If blnErase = True Then
'        lngColor = fccolor.lngBackColor
'    Else
'        lngColor = fccolor.lngFooterForeColor
'    End If
'    intI = 0
'    DrawBLine .hwnd, .lblmemo(0).Left + .lblmemo(0).Width - 2 * .FontSize * 10, .lblmemo(0).top + .lblmemo(0).Height - 60, _
'        .lblmemo(0).Left + .lblmemo(0).Width - 1 * .FontSize * 10, .lblmemo(0).top + .lblmemo(intI).Height - 60, lngColor
    ReleaseDC .hWnd, hdc
    End With
End Sub
Private Sub DrawAllButton(ByVal hdc As Long)
    Dim i As Integer
'  Dim lngBackColor As Long
'  lngBackColor = GetSysColor(COLOR_BTNFACE)
    With frmName
    '画FIELD区按纽
    For i = 1 To .lblField.Count - 1
        If .lblField(i).Visible And (Field(i).lngCtrType = tdate Or Field(i).lngCtrType = TRefer) Then
            DrawAButton hdc, .lblField(i).Left + .lblField(i).width - intButtonWidth - 1 * Screen.TwipsPerPixelX, _
                            .lblField(i).top, intButtonWidth, .lblField(i).Height - Screen.TwipsPerPixelY, 0, lngBackColor, _
                            FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
'           DrawAButton .hWnd, .lblField(i).Left + .lblField(i).Width - intButtonWidth, _
'                            .lblField(i).Top, intButtonWidth, .lblField(i).Height, 0
        End If
    Next i
    '画HEAD行按纽
    For i = 1 To .lblHead.Count - 1 Step 2
        If .lblHead(i).Visible Then
            DrawAButton hdc, .lblHead(i).Left + .lblHead(i).width - intButtonWidth - 4 * Screen.TwipsPerPixelX, _
                    .lblHead(i).top + 1 * Screen.TwipsPerPixelY, intButtonWidth + 2 * Screen.TwipsPerPixelX, .lblHead(i).Height - 3 * Screen.TwipsPerPixelY, 0, lngBackColor, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
        End If
    Next i
    '画Field0处所粘贴行输入按纽
    If .lblNote(3).Visible Then
        For i = 1 To .lblNote.Count - 1 Step 2
            DrawAButton hdc, .lblNote(i).Left + .lblNote(i).width - intButtonWidth - 0 * Screen.TwipsPerPixelX, _
                .lblNote(i).top - 1 * Screen.TwipsPerPixelY, intButtonWidth, .lblNote(i).Height + 0 * Screen.TwipsPerPixelY, 0, lngBackColor, _
                FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
        Next i
    End If
    
    '画备注行按纽
    i = 3
    If .LblMemo(i).Visible Then
        DrawAButton hdc, .LblMemo(i).Left + .LblMemo(i).width - intButtonWidth - 0 * Screen.TwipsPerPixelX, _
                    .LblMemo(i).top - 1 * Screen.TwipsPerPixelY, intButtonWidth, .LblMemo(i).Height + 1 * Screen.TwipsPerPixelY, 0, lngBackColor, _
                    FormClipRect.Left, FormClipRect.top, FormClipRect.Right, FormClipRect.Bottom
    End If
    
    End With
    
End Sub
Private Sub GrdAndLabelInitial()
    '列表及LABEL控件初始化
    Dim intI As Integer
    Dim i%
    '--------------------------
    '应付单只显示1--5列
    '--------------------------
    With frmName.grdCol
        '.ColWidth(0) = 0
        frmName.grdCol.ColWidth(0) = frmName.TextWidth("12345")
'       For inti = 5 To .cols - 1
'            .ColWidth(inti) = 0
'       Next inti
        .ColAlignment(0) = 4
        For intI = 1 To .Cols - 1
            .TextMatrix(0, intI) = ColProperty(intI).strColCaption
            If ColProperty(intI).blnUsable Then
                .ColWidth(intI) = ColProperty(intI).lngColWidth
            Else
                .ColWidth(intI) = 0
            End If
            If ColProperty(intI).lngCtrType = tCurrency Then
                .ColAlignment(intI) = 7
                If frmName.lblTotal.Count > intI Then
                    If intI = 1 Then
                        frmName.lblTotal(intI).Alignment = 2
                    Else
                        frmName.lblTotal(intI).Alignment = 1
                    End If
                End If
            Else
                .ColAlignment(intI) = 1
            End If
            .Row = 0
            .col = intI
            .CellAlignment = 4
'            .CellBackColor = frmName.lblFieldCaption(1).BackColor
'            .CellForeColor = frmName.lblFieldCaption(1).ForeColor
        Next intI
        ReadonlyColBackColor
    End With
    
    For intI = 0 To frmName.lblField.UBound
        If Field(intI).lngCtrType = tCurrency Then frmName.lblField(intI).Alignment = 1
        If intI = 0 Then
            frmName.lblField(intI).WordWrap = True
        Else
            frmName.lblField(intI).WordWrap = False
        End If
    Next intI
End Sub
Private Sub CurrRedWord()
    '对普通GRD内容中金额为负数的单元做红字显示处理
    Dim intI As Integer
    Dim i%
    Dim strText As String
    My.blnRefresh = False
    With frmName.grdCol
        If .Rows > .FixedRows Then
            For intI = .FixedCols To .Cols - 1
                If .ColWidth(intI) > 0 And ColProperty(intI).lngCtrType = tCurrency And ColProperty(intI).blnReadOnly = False Then
                    For i% = 1 To .Rows - 1
                        If C2Dbl(TextMatrix(i%, intI)) < 0 Then
                            strText = TextMatrix(i%, intI)
                            WriteGrd strText, i%, intI
                        End If
                    Next i%
                End If
            Next intI
        End If
    End With
    My.blnRefresh = True
End Sub
Private Sub ReadonlyColBackColor()
    '设只读列背静色
    Dim intI As Integer
    Dim i%
    Dim blnTmp As Boolean
    blnTmp = My.blnRefresh
    My.blnRefresh = False
    With frmName.grdCol
        If .Rows > .FixedRows Then
            For i% = 1 To .Cols - 1
                For intI = .FixedRows To .Rows - 1
                    If .ColWidth(i%) > 0 Then
                        .col = i%
                        .Row = intI
                        If ColPrope