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 ,想请各位大神写一个！
加好友 
发短信
Post By：2024/11/15 1:48:00 [显示全部帖子]
