[第25期-2]追踪鼠标（已结）

agstick

说明：
本题的实用性不大，主要目的是提高大家学习API函数的兴趣，也给大家多一点赚分的机会，所以题目也不难。

[此贴子已经被作者于2007-7-29 18:56:59编辑过]

willin2000

答案已发送至：agstick@126.com，占位。

答案正确，谢谢参与。

[此贴子已经被agstick于2007-7-22 17:38:40编辑过]

f_qc

才发完看到了最后的要求，重做了一下，以最后发的为准，不好意思

api的使用还是比较麻烦，调画笔整了半天

 

 

没有处理MouseUp事件。

[此贴子已经被agstick于2007-7-22 17:39:48编辑过]

chrisfang

学了老头子版主的几堂VBA课程，也来做一下课后作业。答案已发送。

感谢老头子写了好多由浅入深的VBA课程，特别适合我这样的入门都还没有的”敲门级“菜鸟学习。

人比较懒，程序开发版几乎从来都不去，要不是竞赛题还真是错过了不少好帖子，也错过不少学习的机会。

占楼完毕。

*************************************************************************************************

 

 

呃，方法有点怪，这题主要考察api绘图函数，虽说有点不符题意，还是要鼓励一下。

呵呵，方法怪是因为没找到画笔的资料，只能用偷换概念取一下巧了。——chrisfang

[此贴子已经被作者于2007-7-23 10:07:12编辑过]

agstick

此题很简单，主要考察了一下调用API绘图函数的基本方法，相关的内容程序版有介绍。

需要说一下，之所以用ListView控件，是因为这是一个有句柄的控件，我们都知道VBA里绝大部分控件都失去了句柄，

只有很少的控件还有句柄，列举如下：

WebBrowser －－   网页浏览器控件

ProgressBar －－   进度条控件

ImageCombo－－  图片组合框

Slider   －－  滑块控件

StatusBar  －－状态栏控件

TabStrip －－ 选项卡控件

ToolBar－－工具栏控件

TreeView －－树型控件

 没有句柄使得很多api函数无法使用，这不得不说是一种遗憾。

另：附上我得答案。

紧身长裙

版主好哦,你做的答案非常棒! 只是我在里面改工作表名称,会多出好多字符来哦?

好奇怪好奇怪[em25]

qee用

答案已发.

悄悄得2分:-)

代码很简洁，有点小问题，当快速单击2次鼠标右键后会变成红色大圆。

---------------------------

没测试快速两次击键的情况,想当然地认为up/down应是成对出现的,测试发现在两次快击中Down事件触发一次(??这个应和系统捕捉的时间间隔有关),而UP事件触发了2次.完善一下:

'** iState状态列表**********************************************************
'**  0 :初使状态         小红
'**  1 :前一按键为左键   小红
'**  2 :当前按住左键     大红
'**  3 :前一按键为右键   小兰
'**  4 :当前按住右键     大兰
'**  以上状态由Back_MouseDown/MouseUp改变,DrawRound据之确定圆圈的大小及颜色
'***************************************************************************
Dim iState As Integer
Private Const SmallSize = 30
Private Const LargeSize = 60
Private Const PS_SOLID = 0
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor 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 Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Sub Back_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
  iState = Button * 2
  DrawRound x, y
End Sub
Private Sub Back_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
  If iState Mod 2 = 0 Then iState = iState - 1 '此处加个判断
  DrawRound x, y
End Sub
Private Sub Back_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
  DrawRound x, y
End Sub
Private Sub DrawRound(ByVal x As Long, ByVal y As Long)
  Dim hdc As Long
  Dim pen As Long
  Dim lngSize As Long
  lngSize = IIf(iState = 2 Or iState = 4, LargeSize, SmallSize)
  hdc = GetDC(Back.hwnd)
  pen = CreatePen(PS_SOLID, 1, IIf(iState > 2, &HFF0000, &HFF&))
  SelectObject hdc, pen
  Back.Refresh
  RoundRect hdc, x - lngSize / 2, y - lngSize / 2, x + lngSize / 2, y + lngSize / 2, lngSize, lngSize
  DeleteObject pen
  ReleaseDC 0, hdc
End Sub

[此贴子已经被作者于2007-7-22 18:04:44编辑过]