以文本方式查看主题 -  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp) --  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2) ----  金额栏Vb转FOXTABLE  (http://foxtable.net/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 --   试试先