Rss & SiteMap

Foxtable(狐表) http://www.foxtable.com

新一代数据库软件,完美融合Access、Foxpro、Excel、vb.net之优势,人人都能掌握的快速软件开发工具!
共3 条记录, 每页显示 10 条, 页签: [1]
[浏览完整版]

标题:金额栏Vb转FOXTABLE

1楼
zhuxinhui 发表于:2024/11/15 1:48:00
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 ,想请各位大神写一个!
2楼
有点蓝 发表于:2024/11/15 8:33:00
把Private 改为Public ,放到全局代码即可
3楼
zhuxinhui 发表于:2024/11/15 9:03:00
试试先

共3 条记录, 每页显示 10 条, 页签: [1]

Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号

Powered By Dvbbs Version 8.3.0
Processed in .03125 s, 2 queries.