Foxtable(狐表)用户栏目专家坐堂 → [求助]求一个金额栏的写法


  共有1752人关注过本帖树形打印复制链接

主题:[求助]求一个金额栏的写法

帅哥哟,离线,有人找我吗?
nxhylczh
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:335 积分:2674 威望:0 精华:0 注册:2018/11/22 9:19:00
[求助]求一个金额栏的写法  发帖心情 Post By:2018/11/28 16:36: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 ,想请各位大神写一个!
原来画出来的效果图如下


图片点击可在新窗口打开查看此主题相关图片如下:1543394080(1).jpg
图片点击可在新窗口打开查看








 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/11/28 17:03:00 [只看该作者]

参考

 

http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=15139

 

在 MouseEnterCell 加入代码 e.Table.Refresh


 回到顶部
帅哥哟,离线,有人找我吗?
nxhylczh
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:335 积分:2674 威望:0 精华:0 注册:2018/11/22 9:19:00
  发帖心情 Post By:2018/11/29 9:16:00 [只看该作者]

e.Table.Refresh
这句加了,但是还是会出现空白,最后一行画不了。
不稳定,楼主能优化一下吗?
还有一个问题,就是如何上底部合计行固定呢?

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/11/29 9:37:00 [只看该作者]

1、 

 

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:账簿.table

2、

 

http://foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=121773&skin=0

 


 回到顶部