|
不好意思,我还是不明白版版所说的全部注释掉是指哪里注释掉.下面是起作用工作表的全部代码, 您到底是指具体哪里注释掉啊?不是说只保留粗体的部分吧?那前面怎么定义? Option Explicit
Dim c As clsXcolor
Dim myRect As RECT
Dim DesktopRect As RECT
Dim rc As RECT
Dim MyTop, MyLeft As Integer
Dim T, L As Long
Dim lnghDC As Long
Dim lngLogPixelsX As Long
Dim Hwnd, brush As Long Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hdc As Long '注意它的位置,它在Worksheet_SelectionChange这一Module里和外对应的不一样
Set c = New clsXcolor
c.WindowStyle = vbGreenStyle ' vbXPStyle
lnghDC = GetDC(0)
lngLogPixelsX = GetDeviceCaps(GetDC(0), LOGPIXELSX)
'// note
'获得鼠标所在的窗口句柄
'GetCursorPos CursorPos
'HWND = WindowFromPoint(CursorPos.x, CursorPos.Y)
Dim HWND1 As Long, hWndDesk As Long, hWndWin As Long
Dim HwdDesktop As Long
HWND1 = FindWindow("XLMAIN", Application.Caption)
hWndDesk = FindWindowEx(HWND1, 0&, "XLDESK", vbNullString)
Hwnd = FindWindowEx(hWndDesk, 0&, "EXCEL7", vbNullString) 'Excel 主窗体 'hwnd = FindWindow("XLMAIN", Application.Caption)
GetWindowRect Hwnd, myRect
'OffsetRect myRect, -myRect.Left, -myRect.Top
MyLeft = myRect.Left
MyTop = myRect.Top
Debug.Print myRect.Left
Debug.Print myRect.Right
Debug.Print myRect.Top
Debug.Print myRect.Bottom HwdDesktop = GetDesktopWindow()
GetWindowRect HwdDesktop, DesktopRect Dim HorizonPixels, VerticalPixels As Single
HorizonPixels = DesktopRect.Right - DesktopRect.Left
VerticalPixels = DesktopRect.Bottom - DesktopRect.Top
If hdc = 0 Then hdc = GetWindowDC(Hwnd) '给出窗口的设备名 DC
GetWindowRect Hwnd, rc '给出窗口矩形
'OffsetRect rc, -rc.Left, -rc.Top
Debug.Print rc.Left
Debug.Print rc.Right
Debug.Print rc.Top
Debug.Print rc.Bottom
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Dim lngCurPos As POINTAPI
Dim mTop As Long, mLeft As Long, mRight As Long, mBottom As Long
Dim x As Long, y As Long, x1 As Long, y1 As Long, x2 As Long, y2 As Long
If ClientToScreen(Hwnd, lngCurPos) = 0 Then Exit Sub
'ScreenToClient的作用是把屏幕中的坐标转换为客户区的坐标(关于什么是客户区，请参考前面的文章)。
'hwnd是客户区对象的句柄，而lpPoint则是已经存放着屏幕坐标的POINTAPI类型，执行该函数后，
'lpPoint的内容将被转换为客户区坐标值?
' ClientToScreen HWND, CursorPos
'ClientToScreen HWND, Point 'CursorPos
ClientToScreen Hwnd, lngCurPos
GetCursorPos lngCurPos
For y = lngCurPos.y To 0 Step -1
If ActiveWindow.RangeFromPoint(lngCurPos.x, y).Address <> Target.Address Then
mTop = y - 1
Exit For
End If
Next y For y1 = lngCurPos.y To VerticalPixels
If ActiveWindow.RangeFromPoint(lngCurPos.x, y1).Address <> Target.Address Then
mBottom = y1 - 1
Exit For
End If
Next y1 For x = lngCurPos.x To 0 Step -1
If ActiveWindow.RangeFromPoint(x, lngCurPos.y).Address <> Target.Address Then
mLeft = x - 1
Exit For
End If
Next x For x1 = lngCurPos.x To HorizonPixels
If ActiveWindow.RangeFromPoint(x1, lngCurPos.y).Address <> Target.Address Then
mRight = x1 - 1
Exit For
End If
Next x1
Debug.Print "Top:is:" & mTop & ";" & "Left:is:" & mLeft & ";" & _
"Right:is:" & mRight & ";" & "Bottom: is:" & mBottom & "." If Target.Areas.Count > 1 Then
Exit Sub
End If
Dim I As Long I = InStr(1, Target.Address, ":")
If I > 0 Then
Exit Sub
End If
'Column
rc.Left = mLeft - MyLeft + 1
rc.Right = rc.Left + Target.Width * ActiveWindow.Zoom / 100 * lngLogPixelsX / 72
rc.Top = DefaultWindowFrameHeight
rc.Bottom = rc.Top + ActiveWindow.UsableHeight * lngLogPixelsX / 72 ' 'Cells
' rc.Left = mLeft - MyLeft
' rc.Right = rc.Left + Target.Width * ActiveWindow.Zoom / 100 * lngLogPixelsX / 72
' rc.Top = mTop - MyTop
' rc.Bottom = mBottom - MyTop 'Row
' rc.Left = 0 + DefaultWindowFrameWidth
' rc.Right = rc.Left + ActiveWindow.UsableWidth * lngLogPixelsX / 72
' rc.Top = mTop - MyTop
' rc.Bottom = mBottom - MyTop
Debug.Print rc.Right
Debug.Print rc.Left
Debug.Print rc.Top
Debug.Print rc.Bottom
'UpdateWindow HWND ' OleTranslateColor Colors.crSelBack, 0&, Colors.crSelBack
Application.ScreenUpdating = True brush = CreateSolidBrush(Colors.crSelBack) '创建蓝色画刷 (&HFF0000)
' Dim hPen As Long
' '用指定的样式、宽度和颜色创建一个画笔 -> PS_SOLID 代表直线
'hPen = CreatePen(PS_SOLID, 1&, Colors.crSelBack)'(&HFF0000) '创建蓝色画笔
' Call SelectObject(hdc, hPen) '指定画笔'将画笔选入设备场景
Call SelectObject(hdc, brush)
'SetBkMode hdc, TRANSPARENT SetROP2 hdc, 10 '10 '9 ' R2_NOT '设置DC的颜色，备以后移去时使用 '建立画笔14 '设置xor作图模式
Call SaveDC(hdc) '保存画笔和刷子
' Call SelectObject(hdc, hPen) '设置新笔
Call SelectObject(hdc, brush) '设备空刷子 'DrawFrame hdc, rc, Colors.crSelBorder ' crBorder
Rectangle hdc, rc.Left, rc.Top, rc.Right, rc.Bottom
'UpdateWindow HWND 'Row
rc.Left = 0 + DefaultWindowFrameWidth
rc.Right = rc.Left + ActiveWindow.UsableWidth * lngLogPixelsX / 72
rc.Top = mTop - MyTop
rc.Bottom = mBottom - MyTop Rectangle hdc, rc.Left, rc.Top, rc.Right, rc.Bottom Call RestoreDC(hdc, -1) '-1时恢复以前的内容'恢复DC设备
ReleaseDC Hwnd, hdc '删除窗口设备句柄,释放资源
DeleteObject brush
'DeleteObject ll_Pen End Sub
| 
楼主: stanleypan
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-8-24 02:12
楼主
