求助：如果在表格上实现划线功能？

Question

我用 MSHFlexGrid 显示数据表，想在表格上再划辅助线，但line控件总在表格后层，移不到前层来，用窗体的ling划线功能也不行，请问该如何实现？谢谢。

Answer 1

弄一个PictureBox，调窄一点，看上去也是一条线

Answer 2

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As LongPrivate Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As LongPrivate Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Command1_Click()
    Dim hdc As Long
    Dim p As POINTAPI
    hdc = GetWindowDC(MSHFlexGrid1.hwnd)
    MoveToEx hdc, 30, 30, p
    LineTo hdc, 100, 100
End Sub画一条（30，30）－（100，100）的斜线

Answer 3

谢谢楼上朋友指点！1、“弄一个PictureBox，调窄一点，看上去也是一条线”--这个不行，只能直线，斜线不能；2、非常感谢，已经成功。继续求教： 线条粗细与颜色该如何设？

Answer 4

yachong(蚜虫) 老师，请问线条粗细与颜色该如何设？

Answer 5

模块:
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long窗体:Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Command1_Click()
Dim old As Long
Dim p As Long
Dim a As POINTAPI
Dim hdc As Long
          
hdc = GetWindowDC(MSHFlexGrid1.hwnd)
p = CreatePen(0, 3, vbRed)
old = SelectObject(hdc, p)MoveToEx hdc, 0, 0, a: LineTo hdc, 200, 200
MoveToEx hdc, 0, 0, a: LineTo hdc, 30, 400SelectObject hdc, old
DeleteObject p
End Sub
用上面方法可以实现在表格上画图了,但如何才能清除所划的线条?

Answer 6

设置画刷,即可得到不同线条
清除....好象有这么个API,,,忘记TNND了.....你看看API声明上,用特定方法再次调用可以清除

Answer 7

清除....好象有这么个API,,,忘记TNND了.....你看看API声明上,用特定方法再次调用可以清除
==================================================================================
我也忘光光了，以前可以在表格上画很多东西的
都忘了，一点都想不起来了
至于清除，调用表格的Refresh方法应该可以清除所有的线条
忘记了，晕死了快

Answer 8

SetROP2 函数可以起到设置DrawMode的效果 常数 DrawMode 像素值 
R2_BLACK vbBlackness 黑色 
R2_WHITE vbWhitness 白色 
R2_NOP vbNop 不变 
R2_NOT vbInvert 当前显示颜色的反色 
R2_COPYPEN vbCopyPen 画笔颜色 
R2_NOTCOPYPEN vbNotCopyPen R2_COPYPEN的反色 
R2_MERGEPENNOT vbMergePenNot 显示颜色的反色与画笔颜色进行OR运算 
R2_MASKPENNOT vbMaskPenNot 显示颜色的反色与画笔颜色进行AND运算 
R2_MERGENOTPEN vbMergeNotPen 画笔颜色的反色与显示颜色进行OR运算 
R2_MASKNOTPEN vbMaskNotPen 画笔颜色的反色与显示颜色进行AND运算 
R2_MERGEPEN vbMergePen 画笔颜色与显示颜色进行OR运算 
R2_NOTMERGEPEN vbNotMergePen R2_MERGEPEN的反色 
R2_MASKPEN vbMaskPen 显示颜色与画笔颜色进行AND运算 
R2_NOTMASKPEN vbNotMaskPen R2_MASKPEN的反色 
R2_XORPEN vbXorPen 显示颜色与画笔颜色进行异或运算 
R2_NOTXORPEN vbNotXorPen R2_XORPEN的反色 
'=============================================================================
'反复按command1可以看到清除效果
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As LongPrivate Const R2_XORPEN = 7      '  DPx
Private Sub Command1_Click()
Dim old As Long
Dim p As Long
Dim a As POINTAPI
Dim hdc As Long
          
hdc = GetWindowDC(MSHFlexGrid1.hwnd)
SetROP2 hdc, R2_XORPEN
p = CreatePen(0, 3, vbRed)
old = SelectObject(hdc, p)MoveToEx hdc, 0, 0, a: LineTo hdc, 200, 200
MoveToEx hdc, 0, 0, a: LineTo hdc, 30, 400SelectObject hdc, old
DeleteObject p
End Sub

Answer 9

非常感谢 yachong(蚜虫) ，结贴散分。用表格的refresh 就清除了线条