- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- [求助]求一个金额栏的写法 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=128083)
-- 发布时间：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
-- 发布时间：2018/11/28 17:03:00
--
-- 发布时间：2018/11/29 9:16:00
--
e.Table.Refresh
这句加了，但是还是会出现空白，最后一行画不了。
不稳定，楼主能优化一下吗？
还有一个问题，就是如何上底部合计行固定呢？
-- 发布时间：2018/11/29 9:37:00
--
1、
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:账簿.table |
2、
http://foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=121773&skin=0