自动生成菜单--再次求助, 请风吹过b帮助再次帮忙!
我曾经求助过一次,但觉得用图片还是不太漂亮,想改为自主生成Commandbutton, 要求自动限制按钮的宽度,宽度以Caption最长的来决定宽度要求请参考如下面链接,谢谢
https://bbs.bccn.net/thread-445539-1-1.html
[ 本帖最后由 yuk_yu 于 2015-6-30 14:39 编辑 ]
2015-06-30 14:38
程序代码: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

2015-06-30 17:33
2015-07-15 16:42