ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[Excel 程序开发] [第37期] 移动调整控件 已结

[复制链接]

TA的精华主题

TA的得分主题

发表于 2008-7-1 17:04 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

移动控件
这是一个动态调整界面、很实用的例子
所涉及的知识并不高深,但对逻辑思维以及代码调试水平有相当的要求。


编辑代码,使窗体中的文本框可以在按下鼠标左键时移动调整大小(与设计时状态相似)

附加限制条件:禁止使用某个隐藏属性,用此属性仅仅一行代码就能实现和设计界面完全一样的效果。

但危险性也相当大,及易造成那excel死机,这也不是此次竞赛的目的。尽管还未收到此类答案,但还是要说明一下。——ldy 2008-7-9

至本帖编辑时为止,收到以下会员的答案: 彭希仁,taller,HHAAMM,long9841,zpy2,chylhr

关于这个隐藏属性由于没有多大实用意义反,而会有副作用

测试时 最好先保存你的文件

Private Sub CommandButton1_Click()
    Me.DesignMode = fmModeOn
End Sub
Private Sub CommandButton2_Click()
    Me.DesignMode = fmModeOff
End Sub

[此贴子已经被作者于2008-7-21 13:41:51编辑过]
单选投票, 共有 10 人参与投票

距结束还有: 4259 天1 小时7 分钟

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

TA的精华主题

TA的得分主题

发表于 2008-7-1 17:28 | 显示全部楼层

跟贴占位

 


代码较简洁,运行流畅 ,符合题目要求 +3分 唯一 有效使用 4+1 方法 +1分 共4分

[此贴子已经被ldy于2008-7-21 4:55:10编辑过]

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

发表于 2008-7-1 17:30 | 显示全部楼层

TA的精华主题

TA的得分主题

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

发帖占位,邮件已发


调整移动正常,但未处理鼠标显示问题,共 2 分

增加了限制移动范围,但不顺滑,控件靠左边后不能上下移动,但这不是题目要求不加分也不减分

[此贴子已经被ldy于2008-7-21 4:47:36编辑过]

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

发表于 2008-7-8 03:57 | 显示全部楼层

发帖占位,邮件已发

利用8个附加Label控件 解决鼠标显示问题,移动调整正常 +3分

[此贴子已经被ldy于2008-7-21 3:47:28编辑过]

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

发表于 2008-7-8 18:01 | 显示全部楼层

发帖占位,邮件已发


虽然也是 4+1 判断法,但右边 、下边 、右下角和右上角 无法有效调整,没有处理好鼠标显示问题 共 +1分

[此贴子已经被ldy于2008-7-21 4:55:36编辑过]

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

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

跟贴占个位


可以调整移动,但及其难受,控件不能实时调整,事件应用错误。没有处理鼠标显示问题

并且有未处理错误,考虑初次答题    +1分 鼓励

[此贴子已经被ldy于2008-7-21 4:05:59编辑过]

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

发表于 2008-7-13 22:06 | 显示全部楼层

占位

 


调整移动正常,用代码控制处理鼠标显示,虽然麻烦些但符合要求 +3分

[此贴子已经被ldy于2008-7-21 4:11:22编辑过]

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-7-21 13:30 | 显示全部楼层

很遗憾没有收到 投轻松解决票的朋友的答案。
VBA的TextBox 没有句柄,几乎无法用API来操作。主要用MouseMove事件来控制
通常的做法是对鼠标的位置进行判断,一般采取8+1 判断法 即 4边4角 + 中间。
然后进行相应的动作。
从代码判断的复杂性而言 中间的代码最容易其次是下边、右边和 右下角。
再复杂一点的是 上边、左边 和 右上角、左下角,最复杂的是左上角 要同时改变4 个值 。
代码运行时 只进行一种操作来改变控件状态。
8+1的判断方法不仅代码量大,而且很难扩展。
这期的答题者大都是采用的 8+1 判断法。
只有彭希仁有效采用4+1判断法,即 4边 + 中间。
这种方法运行时,进行 1或 2种操作,来改变控件状态。
这就把复杂的问题简单化了,在编写代码时只用考虑 左中右  三种状态。
因为左和上 右和下 的代码一致,直接复制,只要x 改 y ,left、width 改top、height就行了
而 中 和 右 的 代码都是最简单的,有点难度的只有左边的代码了,在8+1方法里这只算中等。
彭希仁答案给我很好的启发:这是我根据4+1方法编写的代码,仅仅需要一个MouseMove事件
出于代码可读性考虑,采用条状的 if语句,作用类同语句写在一行
Private Sub Text2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Static xX As Single, yY As Single, 上 As Boolean, 下 As Boolean, 左 As Boolean, 右 As Boolean, 中 As Boolean
    With Text2 ' 标准移动,一般的程序都是这种效果,实现基本功能最洗练的代码
        .ZOrder: If CheckBox1.value = 0 And .MousePointer > 0 Then .MousePointer = 0
        If Button = 0 And CheckBox1 Then
            CheckBox1.SetFocus: xX! = X: yY! = Y
            上 = Y <= 5: 下 = .Height - Y <= 5
            左 = X <= 5: 右 = .Width - X <= 5
            If 上 And 下 Then 上 = False
            If 左 And 右 Then 左 = False
            中 = Not (上 Or 右 Or 左 Or 下)
            If 中 Then .MousePointer = 15
            If (左 Or 右) Then .MousePointer = 9
            If (上 Or 下) Then .MousePointer = 7
            If (左 And 上) Or (右 And 下) Then .MousePointer = 8
            If (左 And 下) Or (右 And 上) Then .MousePointer = 6
        ElseIf Button = 1 And CheckBox1 Then
            If 中 Then .Move .Left + X - xX!, .Top + Y - yY!
            If 上 And .Height - Y + yY! >= 1 Then .Move , .Top + Y - yY!, , .Height - Y + yY!
            If 左 And .Width - X + xX! >= 1 Then .Move .Left + X - xX!, , .Width - X + xX!
            If 下 And .Height + Y - yY! >= 1 Then .Height = .Height + Y - yY!: yY! = Y
            If 右 And .Width + X - xX! >= 1 Then .Width = .Width + X - xX!: xX! = X
        End If
    End With
End Sub

If CheckBox1.value = 0 And .MousePointer > 0 Then .MousePointer = 0
在没有勾选复选框时 恢复默认光标 “I” 型,
鼠标按下前 记录参照点 xx,yy, 5 种状态值以及设置MousePointer属性,
CheckBox1.SetFocus这句所起的作用是让鼠标正常显示。
也可以用 .visible = false: .visible=true 来达到相同效果,这是VBA的缺陷,VB中不用多此一举。
鼠标按下 根据 上下左右中 分别执行相关语句(1 或2 句)改变控件形态。

4+1的好处还在于容易扩展。如果要实现翻转拖动,在end if前 增加以下4句判断即可实现

实现翻转效果:
            If 上 And Y > .Height Then 上 = Not 上: 下 = Not 下: yY = Y: .Top = .Top + .Height
            If 下 And Y < 0 Then 上 = Not 上: 下 = Not 下: yY = Y: .Top = .Top + Y: .Height = -Y
            If 左 And X > .Width Then 左 = Not 左: 右 = Not 右: xX = X: .Left = .Left + .Width
            If 右 And X < 0 Then 左 = Not 左: 右 = Not 右: xX = X: .Left = .Left + X: .Width = -X

如果采用8+1方法,想要实现翻转拖动,工作量将会以几何级数递增。

根据这个方法可以容易地编写更加友好的界面,就像调整sheeet表中的控件一样,限制控件的移动范围。
无论如何快速拖动,控件始终不会超出窗体范围,并且不会出现鼠标与控件脱节的情况。
这就要考虑到各个边界值及最小值的问题,以及鼠标移出移入窗体 控件的反应,
要在窗体内实现控件边框紧跟鼠标效果,细节方面考虑比较多。用纯粹的VBA代码,
以实现完美效果。 具体代码请参考附件的 Text4的代码 “媲美 office系列产品的调整控件效果”。


注:office中鼠标按下时无法改变鼠标的可视形态,所以在翻转代码里用的是 “小十字线” 指针而不是“斜箭头”
参考
http://club.excelhome.net/viewthread.php?tid=339584&px=0

附件:

本帖子中包含更多资源

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

x

TA的精华主题

TA的得分主题

发表于 2008-7-21 16:14 | 显示全部楼层

我想可以这样做,通用性会好点:

点击控件事件后,用API画出一个无色的有句柄的方框,大小和选中的控件一样大小.

API通过感知方框来知道位置,并调整方框大小. 同时修改文本框大小.

这样的优点是不需要为每个控件写事件. 方框的一些处理放在类中.

当有N多个TEXTBOX, 及还有其他控件也要调整时,直接利用控件事件,会比较麻烦吧.

[此贴子已经被作者于2008-7-21 16:24:30编辑过]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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