以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  金额栏Vb转FOXTABLE  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=194171)

--  作者:zhuxinhui
--  发布时间:2024/11/15 1:48:00
--  金额栏Vb转FOXTABLE
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXVSCROLL = 2
Private ScrollBarWidth As Long
Private Sub DrawLine(ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal Color As Long)
    Dim hPen As Long
    Dim hOldPen As Long
    Dim pt As POINTAPI
    
    hPen = CreatePen(0, 1, Color)
    hOldPen = SelectObject(hdc, hPen)
    
    Call MoveToEx(hdc, x1, y1, pt)
    Call LineTo(hdc, x2, y2)

    Call SelectObject(hdc, hOldPen)
    Call DeleteObject(hPen)
End Sub
Public Sub 金额线(Grid As FlexCell.Grid, iCol As Long, iRow As Long, sTyle As Integer, ByVal Row As Long, ByVal Col As Long, ByVal hdc As Long, ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long, Handled As Boolean)
    Dim i As Integer
    Dim intSpace As Integer
    Dim intLen As Integer
    Dim rcText As RECT
    \'iCol   要画线的列
    \'irow   要画线的行
    \'Style  金额线的样式
    Grid.AutoRedraw = False
    Select Case sTyle
        Case 0
            If Col = iCol Then
                If Row >= iRow Then
                    intSpace = Grid.Column(iCol).Width / 14
                    For i = 14 To 1 Step -1
                        
                        Select Case i
                        Case 1, 2, 4, 5, 7, 8, 10, 11, 13
                            DrawLine hdc, Left + i * intSpace, Top, Left + i * intSpace, Bottom, &H408000
                        Case 3, 6, 9
                            DrawLine hdc, Left + i * intSpace, Top, Left + i * intSpace, Bottom, &H8000
                        Case 12
                            DrawLine hdc, Left + i * intSpace, Top, Left + i * intSpace, Bottom, vbRed
                        End Select
                    Next
                    
                    Handled = True
                End If
            End If
        Case 1
            If Col = iCol Then
                If Row >= iRow Then
                    intSpace = Grid.Column(iCol).Width / 14
                    For i = 14 To 1 Step -1
                        \'DrawLine hDC, Left + i * intSpace, Top, Left + i * intSpace, Bottom, &H800000
                        Select Case i
                        Case 1, 2, 4, 5, 7, 8, 10, 11, 13
                            DrawLine hdc, Left + i * intSpace, Top, Left + i * intSpace, Bottom, RGB(90, 158, 214)
                        Case 3, 6, 9
                            DrawLine hdc, Left + i * intSpace, Top, Left + i * intSpace, Bottom, &H800000
                        Case 12
                            DrawLine hdc, Left + i * intSpace, Top, Left + i * intSpace, Bottom, vbRed
\'                        Case 14
\'                            DrawLine hDC, Left + i * intSpace, Top, Left + i * intSpace, Bottom, vbBlack
                        End Select
                    Next
                    
                    Handled = True
                End If
            End If
    End Select
    If Len(Grid.Cell(Row, Col).Text) <> 0 Then
        Dim strText As String
        strText = Replace(Format(Grid.Cell(Row, Col).DoubleValue, "0.00"), ".", "")
        intLen = Len(strText)
        rcText.Top = Top
        rcText.Bottom = Bottom
        For i = Len(strText) To 1 Step -1
            rcText.Left = Left + (13 - intLen + i) * intSpace
            rcText.Right = rcText.Left + intSpace
            DrawText hdc, Mid(strText, i, 1), 1, rcText, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER
        Next
    End If
    
    Grid.AutoRedraw = True
    
End Sub

以上是用Vb的 FlexCell 控件的写法。看FoxTable支持DrawCell ,想请各位大神写一个!

--  作者:有点蓝
--  发布时间:2024/11/15 8:33:00
--  
把Private 改为Public ,放到全局代码即可
--  作者:zhuxinhui
--  发布时间:2024/11/15 9:03:00
--  
试试先