以文本方式查看主题 - 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 -- 试试先 |