原创技术分享: ControlsAnchor.cls V1.1

bcrun 2013-07-08 06:57:21
加精
注意：2013年7月17日更正：原来CControlsAnchor的fFormResizable_Unload是不对的，现更正为fFormParent_Unload
CControlExtender.cls
'---------------------------------------------------------------------------------------

' 模块名    : CControlExtender.cls

' 时间      : 2013/7/8

' 作者      : 杨过.网狐.cn(csdn bcrun)

' 功能      :

' 说明      :

' 备注      : 星辰设计室VB一群:283362041,星辰学园BASIC辅导群:289219875

'---------------------------------------------------------------------------------------

Option Explicit



Public Enum AnchorStyles

    none = 0                                                                    '该控件未锚定到其容器的任何边缘。

    Top = 1                                                                     '该控件锚定到其容器的上边缘。

    Bottom = 2                                                                  '该控件锚定到其容器的下边缘。

    Left = 4                                                                    '该控件锚定到其容器的左边缘。

    Right = 8                                                                   '该控件锚定到其容器的右边缘。

    All = Top + Bottom + Left + Right

End Enum



Public Enum DockStyle                                                           '指定控件停靠的位置和方式。

    none = 0                                                                    '该控件未停靠。

    Top = 1                                                                     '该控件的上边缘停靠在其包含控件的顶端。

    Bottom = 2                                                                  '该控件的下边缘停靠在其包含控件的底部。

    Left = 3                                                                    '该控件的左边缘停靠在其包含控件的左边缘。

    Right = 4                                                                   '该控件的右边缘停靠在其包含控件的右边缘。

    Fill = 5                                                                    '控件的各个边缘分别停靠在其包含控件的各个边缘，并且适当调整大小。

End Enum

Private m_eAnchor As AnchorStyles

Public LeftSpace As Single

Public TopSpace As Single

Public RightSpace As Single

Public BottomSpace As Single

Public MidPosXScale As Single   '控件中间在横向上的坐标比例

Public MidPosYScale As Single   '控件中间在纵向上的坐标比例

Public AnchorControl As Control





Public Property Get Anchor() As AnchorStyles

    

    Anchor = m_eAnchor

    

End Property



Public Property Let Anchor(ByVal eAnchor As AnchorStyles)

    

    m_eAnchor = eAnchor

    

End Property


CControlsAnchor.cls



'---------------------------------------------------------------------------------------

' 模块名    : CControlsAnchor.cls

' 版本时间  : 1.1版　2013/7/8

' 作者      : 杨过.网狐.cn(csdn bcrun)

' 功能      :

' 说明      : 本类的Anchor行为，参照.net中Windows.Forms的相差行为设计

' 备注      : 星辰设计室VB一群:283362041,星辰学园BASIC辅导群:289219875

'---------------------------------------------------------------------------------------

'更新历史：v1.1:新增：按比例定位，bug修补：针对VB6一次Form_Initialize后可能多次Form_Load的特点，及时释放fCtrlCols对象

Option Explicit



Private fbResizeInitOk As Boolean                                               'ResizeInit结束的标识，方便实现在调用ReSizeForm前先调用ReSizeInit过程

Private fFormOldWidth As Single                                                 '保存窗体的原始宽度

Private fFormOldHeight As Single                                                '保存窗体的原始高度

Private fObjOldFont As Single                                                   '保存窗体的原始字体比

Private WithEvents fFormParent As Form

Private fContainer As Object

Private WithEvents fPicBoxResizable As VB.PictureBox

Private WithEvents fFormResizable As VB.Form

Private fCtrlCols As New Collection

Private fAnchor As AnchorStyles

Private Type TCtl

    Anchor As AnchorStyles

End Type

Private fCtl As TCtl

'在Form_Load中优先调用本过程

Public Sub Init(ByVal AFormParent As Form, Optional AContainer As Object)

    Dim oCtl As Control

    Dim oCtlExt As CControlExtender

    If (IsMissing(AContainer) Or (AContainer Is Nothing)) Then

        Set fContainer = AFormParent

    Else

        Set fContainer = AContainer

        

    End If

    If (TypeOf fContainer Is PictureBox) Then

        Set fPicBoxResizable = fContainer

    ElseIf (TypeOf fContainer Is Form) Then

        Set fFormResizable = fContainer

        

    End If

    Set fFormParent = AFormParent

    '    fFormOldWidth = AFormParent.Width

    '    fFormOldHeight = AFormParent.Height

    fFormOldWidth = fContainer.ScaleWidth

    fFormOldHeight = fContainer.ScaleHeight

    fObjOldFont = fContainer.Font.Size / fFormOldHeight

    On Error Resume Next

    For Each oCtl In AFormParent.Controls

        

        If Not (oCtl.Container Is fContainer) Then

            GoTo ContinueoCtl

        End If

        Set oCtlExt = New CControlExtender

        oCtlExt.Anchor = AnchorStyles.Left Or AnchorStyles.Top Or AnchorStyles.Right Or AnchorStyles.Bottom

        With oCtlExt

            .LeftSpace = oCtl.Left

            .TopSpace = oCtl.Top

            .RightSpace = fContainer.ScaleLeft + fContainer.ScaleWidth - (oCtl.Left + oCtl.Width)

            .BottomSpace = fContainer.ScaleTop + fContainer.ScaleHeight - (oCtl.Top + oCtl.Height)

        End With

        

        'Call fCtrlCols.Add(oCtlExt, oCtl.Name)

ContinueoCtl:

    Next oCtl

    On Error GoTo 0

    fbResizeInitOk = True

End Sub

Public Sub AddControl(AItemName As String, oCtl As Control, AAnchorStyles As AnchorStyles)

    Dim oCtlExt As New CControlExtender

    oCtlExt.Anchor = AAnchorStyles

    With oCtlExt

        .LeftSpace = oCtl.Left

        .TopSpace = oCtl.Top

        .RightSpace = fContainer.ScaleLeft + fContainer.ScaleWidth - (oCtl.Left + oCtl.Width)

        .BottomSpace = fContainer.ScaleTop + fContainer.ScaleHeight - (oCtl.Top + oCtl.Height)

        .MidPosXScale = ((oCtl.Left + oCtl.Width / 2) - fContainer.ScaleLeft) / fContainer.ScaleWidth

        .MidPosYScale = ((oCtl.Top + oCtl.Height / 2) - fContainer.ScaleTop) / fContainer.ScaleHeight

    End With

    Set oCtlExt.AnchorControl = oCtl

    Call fCtrlCols.Add(oCtlExt, AItemName)

End Sub

Public Sub Resize()

    Dim oCtl As Control

    Dim oCtlExt As CControlExtender

    Dim oFormParent As Form

    Dim sglCtlWidth As Single

    On Error Resume Next

    Set oFormParent = fFormParent

    For Each oCtlExt In fCtrlCols

        '        If Not (oCtl.Container Is fContainer) Then

        '            GoTo ContinueoCtl

        '        End If

        'Set oCtlExt = fCtrlCols.Item(oCtl.Name)

        Set oCtl = oCtlExt.AnchorControl

        If ((oCtlExt.Anchor And AnchorStyles.Left) <> 0) And _

            ((oCtlExt.Anchor And AnchorStyles.Right) <> 0) Then

            With oCtl

                .Width = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtlExt.RightSpace - oCtl.Left

            End With

        ElseIf ((oCtlExt.Anchor And AnchorStyles.Right) <> 0) Then

            With oCtl

                .Left = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtl.Width - oCtlExt.RightSpace

            End With

        ElseIf ((oCtlExt.Anchor And (AnchorStyles.Left Or AnchorStyles.Right)) = 0) Then

            With oCtl

                sglCtlWidth = oCtl.Width

                .Left = fContainer.ScaleLeft + fContainer.ScaleWidth * oCtlExt.MidPosXScale - oCtl.Width / 2

            End With

        End If

        

        If ((oCtlExt.Anchor And AnchorStyles.Top) <> 0) And _

            ((oCtlExt.Anchor And AnchorStyles.Bottom) <> 0) Then

            With oCtl

                .Height = fContainer.ScaleTop + fContainer.ScaleHeight - oCtlExt.BottomSpace - oCtl.Top

            End With

        ElseIf ((oCtlExt.Anchor And AnchorStyles.Bottom) <> 0) Then

            With oCtl

                .Top = fContainer.ScaleTop + fContainer.ScaleHeight - oCtl.Height - oCtlExt.BottomSpace

            End With

        ElseIf ((oCtlExt.Anchor And (AnchorStyles.Top Or AnchorStyles.Bottom)) = 0) Then

            With oCtl

                .Top = fContainer.ScaleTop + fContainer.ScaleHeight * oCtlExt.MidPosYScale - oCtl.Height / 2

            End With

        End If

        '        If (TypeOf oCtl Is PictureBox) Or (TypeOf oCtl Is TextBox) Then

        '            With oCtl

        '                .Width = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtlExt.RightSpace - oCtl.Left

        '                .Height = fContainer.ScaleTop + fContainer.ScaleHeight - oCtlExt.BottomSpace - oCtl.Top

        '            End With

        '        ElseIf (TypeOf oCtl Is Label) Then

        '

        '        Else

        '            With oCtl

        '                .Left = fContainer.ScaleLeft + fContainer.ScaleWidth - oCtl.Width - oCtlExt.RightSpace

        '                .Top = fContainer.ScaleTop + fContainer.ScaleHeight - oCtl.Height - oCtlExt.BottomSpace

        '            End With

        '        End If

        

        'oCtlExt.Anchor = AnchorStyles.Left Or AnchorStyles.Top Or AnchorStyles.Right Or AnchorStyles.Bottom

        'Call fCtrlCols.Add(oCtlExt, oCtl.Name)

ContinueoCtl:

    Next oCtlExt

End Sub







Private Sub fFormResizable_Resize()

    Call Resize

End Sub



Private Sub fFormParent_Unload(Cancel As Integer)

    Debug.Print "fFormParent_Unload"

    '针对VB6一次Form_Initialize后可能多次Form_Load的特点，及时释放fCtrlCols对象，非常重要！

    Set fCtrlCols = Nothing

End Sub



Private Sub fPicBoxResizable_Resize()

    Call Resize

End Sub
...全文
2685 37 打赏 收藏 转发到动态 举报
写回复
用AI写文章
37 条回复
切换为时间正序
请发表友善的回复…
发表回复
AddDark 2013-08-18
  • 打赏
  • 举报
 回复
标记一下，后备
bcrun 2013-08-17
  • 打赏
  • 举报
 回复
本来想着这代码比较简单，又把模块全发上来了，应该没啥问题。晚几天我再看看单独发篇博文吧，到时候也在论坛中通知一下。 另外这个模块后来也更新到1.2了，别看只百来行，真细究起来还是常能找出问题的。
hisungao 2013-08-16
  • 打赏
  • 举报
 回复
引用 26 楼 bcrun 的回复:
[quote=引用 22 楼 u011364707 的回复:] 这个怎么玩？
后面两个窗体的代码直接复制出去存为相应的frm文件，这个是演示效果的。[/quote] 现在真看不懂,能指点一下吗?我把它拷出来后运行后就是"ok""about""command"和"txt1"拖动窗口后没有规律地移动,没有见到说是按比例定位也没有见到是按比例缩放?谢谢了.
晴日安 2013-07-26
  • 打赏
  • 举报
 回复
Nice software !
goepopo 2013-07-25
  • 打赏
  • 举报
 回复
支持一下！！！
苍狼传说 2013-07-25
  • 打赏
  • 举报
 回复
这个真能省不少事！
CatchWind 2013-07-21
  • 打赏
  • 举报
 回复
不错，省了很多调整窗体控件位置代码
u010542902 2013-07-20
  • 打赏
  • 举报
 回复
拿来学习一下，感觉好好啊，真的很好啊
猪猪猪猪猪猪猪猪 2013-07-19
  • 打赏
  • 举报
 回复
咖啡西瓜 2013-07-19
  • 打赏
  • 举报
 回复
看看
菜菜258 2013-07-18
  • 打赏
  • 举报
 回复
拿来学习一下，好久都没有更新了
zhedielj 2013-07-17
  • 打赏
  • 举报
 回复
拿来学习一下，好久都没有更新了
zhaozhig 2013-07-16
  • 打赏
  • 举报
 回复
拿来学习一下，谢谢分享！
ywdaisjm 2013-07-15
  • 打赏
  • 举报
 回复
6742 2013-07-15
  • 打赏
  • 举报
 回复
拿来学习一下，谢谢分享！
bcrun 2013-07-13
  • 打赏
  • 举报
 回复
引用 30 楼 sysdzw 的回复:
不错，可以处理窗体扩缩的情况。 以前看到过一个控件，可以可视化的控制当前窗体内各个控件的靠左还是靠右，也挺不错。
我这个基本上就是按.net里WinForms那个Anchor的效果来写的。你说的那个是不是类似Dock的(即vb6 form里的Align？
2pm 2013-07-12
  • 打赏
  • 举报
 回复
支持一下！！！
无·法 2013-07-12
  • 打赏
  • 举报
 回复
不错，可以处理窗体扩缩的情况。 以前看到过一个控件，可以可视化的控制当前窗体内各个控件的靠左还是靠右，也挺不错。
Seme 2013-07-11
  • 打赏
  • 举报
 回复
好厉害``````
franzho 2013-07-11
  • 打赏
  • 举报
 回复
学习了，谢谢分享
加载更多回复（17）
WEB页面性能测试：页面加载过程+页面性能指标+页面性能工具实战课程
通过页面性能测试概念+页面加载过程+页面性能指标+页面性能测试工具的学习，可以学到如下内容： ①WEB网站页面性能的指标(白屏时间、首屏加载完成时间、FP、FCP、DCL、CLS、FPS等）； ②WEB网站页面性能测试策略； ...
[原创分享]: ControlsAnchor.cls V1.2(终结版)
截图图片和代码如下： resize（改变大小后）
java.lang.ClassCastException: com.google.gson.internal.LinkedTreeMap cannot be cast to xxxxxx
java.lang.ClassCastException: com.google.gson.internal.LinkedTreeMap cannot be cast to xxxxxx原因在于转换普通String字符串到List列表对象时候，解决方法可以用下面的转换方法： /** * 把一个json的字符串转换成为一个包含POJO对象的List * * @pa...
latex file “elsarticle.cls” not found
相信不少研究生在开开始用latex投稿论文的时候，会遇到这样的问题。原因是不慎删除了模版中的“elsarticle.cls”文件或者本地装的tex不是完整版。 解决方法：第一种：复制下边链接在百度云下载“elsarticle.cls” 文件，直接导入“elsarticle.cls” 文件到你论文.tex文件所在的目录。 链接:https://pan.baidu.com/s/1FLoB0rhmeAGB4yyRYflG_A 密码:to26 如果链接失效可采取方法二 解决方法二：第一...
!LaTeX Error:File 'moderncv.cls' not found.
用latex+gummi做简历，遇到如下问题： !LaTeX Error:File 'moderncv.cls' not found. 查了一下，moderncv.cls这个类是存在texlive-latex-extra里面的，所以把texlive-latex-extra装上就果断ok啦~~ 网上也看见其他人已经装了这个包可仍然出现这个问题的情况： （refer：moderncv
控件

1,451

社区成员

41,355

社区内容

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章