| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 523 人关注过本帖
标题:自动生成菜单--再次求助, 请风吹过b帮助再次帮忙!
只看楼主 加入收藏
yuk_yu
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:334
专家分:134
注 册:2009-3-16
结帖率:85.71%
收藏
已结贴  问题点数:50 回复次数:2 
自动生成菜单--再次求助, 请风吹过b帮助再次帮忙!
我曾经求助过一次,但觉得用图片还是不太漂亮,想改为自主生成Commandbutton, 要求自动限制按钮的宽度,宽度以Caption最长的来决定宽度

要求请参考如下面链接,谢谢
https://bbs.bccn.net/thread-445539-1-1.html

[ 本帖最后由 yuk_yu 于 2015-6-30 14:39 编辑 ]
搜索更多相关主题的帖子: 漂亮 图片 
2015-06-30 14:38
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:50 
程序代码:
Option Explicit

Dim apppath As String                       '保存着最后一次调用的路径

Private Sub Command1_Click()
Call addlab("c:\windows\system32")          '调用
End Sub

Private Sub Form_Load()
CmdMenu(0).Visible = False                   '不显示

Call addlab("c:\windows\")                  '调用,示例,这个与按钮的调用的路径不同,路径以最后一次调用为准

End Sub

Public Sub addlab(p As String)

Dim s As String
Dim i As Long

If Right(p, 1) <> "\" Then                  '标准化路径,是否带最后一个 \
    apppath = p & "\"                       '不带,加上
Else
    apppath = p
End If

For i = 1 To CmdMenu.Count - 1               '先删原有的
    Unload CmdMenu(i)
Next i

i = 1
s = Dir(apppath & "*.exe")                  '搜索 exe 文件
Do While s <> ""                            '找到
    Load CmdMenu(i)                          '加载一个
    CmdMenu(i).Caption = s                   '标题
    s = Dir                                 '下一个
    i = i + 1                               '计数器
Loop

Call viewlab                                '排列

End Sub

Public Sub viewlab()

Const XR = 120
Const YR = 120

Dim i As Long
Dim x As Long, y As Long
x = XR
y = YR

'找最长的
Me.Font.Size = CmdMenu(0).Font.Size         '窗体字号设置为按钮字号
Dim maxw As Long, j As Long
For i = 1 To CmdMenu.Count - 1
    j = Me.TextWidth(CmdMenu(i).Caption)    '取按钮内容长度
    If maxw < j Then maxw = j
Next i

maxw = maxw + 10 * Screen.TwipsPerPixelX     '各空 5 像素,经测试,最少要各空 4 像素才能保证文字不换行


'第一个元素需要特殊处理
CmdMenu(1).Left = XR
CmdMenu(1).Width = maxw
x = XR + maxw
CmdMenu(1).Top = YR
CmdMenu(1).Visible = True                                '放完后显示

'从第二个元素开始
For i = 2 To CmdMenu.Count - 1

    If maxw + XR + x > Me.ScaleWidth Then       '如果本元素放上去会超出窗体
        y = y + CmdMenu(0).Height + YR                      '换到下一行
        x = XR + maxw
        CmdMenu(i).Width = maxw
        CmdMenu(i).Left = XR
        CmdMenu(i).Top = y
    Else
        CmdMenu(i).Left = x + XR                            '否则就放到本行
        x = x + XR + maxw
        CmdMenu(i).Width = maxw
        CmdMenu(i).Top = y
    End If

    CmdMenu(i).Visible = True                                '放完后显示
Next i

End Sub

Private Sub Form_Resize()
Call viewlab                                                '改变窗体大小时,重新排列
End Sub

Private Sub CmdMenu_Click(Index As Integer)

'单击时
If Dir(apppath & CmdMenu(Index).Caption) <> "" Then          '文件存在,防止显示列表后又把文件删掉,造成程序出错
    Shell apppath & CmdMenu(Index).Caption, vbNormalFocus    '执行
Else
    MsgBox CmdMenu(Index).Caption & " 已不存在,请检查!", vbCritical, "错误"
End If

End Sub


一个是按了名字。
第二个就是多了一个测试文字长度,然后设置按钮宽度的问题。

授人于鱼,不如授人于渔
早已停用QQ了
2015-06-30 17:33
yuk_yu
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:334
专家分:134
注 册:2009-3-16
收藏
得分:0 
回复 2楼 风吹过b
感谢版主的完美解答!谢谢
2015-07-15 16:42
快速回复:自动生成菜单--再次求助, 请风吹过b帮助再次帮忙!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.032727 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved