ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2019函数公式学习大典 不用妈妈陪默写神器 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2016实战技巧学习锦囊 WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 5769|回复: 6

[Excel 程序开发] [第25期-2]追踪鼠标(已结)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2007-7-2 10:31 | 显示全部楼层 |阅读模式

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


[此贴子已经被作者于2007-7-29 18:56:59编辑过]
单选投票, 共有 6 人参与投票

距结束还有: 3893 天17 小时33 分钟

您所在的用户组没有投票权限

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2007-7-3 09:05 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

答案已发送至:agstick@126.com,占位。

答案正确,谢谢参与。

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2007-7-17 19:42 | 显示全部楼层

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

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

 

 

没有处理MouseUp事件。

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2007-7-18 21:39 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

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

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

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

占楼完毕。

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

 

 

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

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

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-7-29 18:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

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

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

只有很少的控件还有句柄,列举如下:

WebBrowser --   网页浏览器控件

ProgressBar --   进度条控件

ImageCombo--  图片组合框

Slider   --  滑块控件

StatusBar  --状态栏控件

TabStrip -- 选项卡控件

ToolBar--工具栏控件

TreeView --树型控件

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

另:附上我得答案。


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2007-7-30 17:35 | 显示全部楼层

回复:(agstick)

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

好奇怪好奇怪[em25]

TA的精华主题

TA的得分主题

发表于 2007-7-2 17:03 | 显示全部楼层

答案已发.

悄悄得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编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-19 16:58 , Processed in 0.049565 second(s), 15 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表