控件自适应窗体大小

一个老外写的控件自适应窗体大小变化的完美代码  
  ’类模块:clsAutoPositioner  
  Option   Explicit  
  Dim   m_oAssignments   As   New   Collection  
   
  Public   Function   AddAssignment(ctl   As   Object,   _  
                                                                  ctlRelative   As   Object,   _  
                                                                  tPosType   As   tPOSITION_TYPE)  
          Dim   x   As   New   clsAutoPositionerItem  
          Set   x.oCTL   =   ctl  
          Set   x.oREL   =   ctlRelative  
          x.tPosType   =   tPosType  
           
          Select   Case   x.tPosType  
                  Case   tCONTAINER_RELATIVE_POS_RIGHT:  
                                  x.lValue   =   x.oREL.Width   -   x.oCTL.Left  
                  Case   tCONTAINER_RELATIVE_POS_BOTTOM:  
                                  x.lValue   =   x.oREL.Height   -   x.oCTL.Top  
                                   
                  Case   tCONTAINER_WIDTH_DELTA_RIGHT:  
                                  x.lValue   =   x.oREL.Width   -   (x.oCTL.Left   +   x.oCTL.Width)  
                  Case   tCONTAINER_HEIGHT_DELTA_BOTTOM:  
                                  x.lValue   =   x.oREL.Height   -   (x.oCTL.Top   +   x.oCTL.Height)  
                                   
                  Case   tCONTROL_RELATIVE_SAME_POS_VERTICAL:  
                                  x.lValue   =   x.oCTL.Left   -   x.oREL.Left  
                  Case   tCONTROL_RELATIVE_SAME_POS_HORIZONTAL:  
                                  x.lValue   =   x.oCTL.Top   -   x.oREL.Top  
                                   
          End   Select  
          m_oAssignments.Add   x  
  End   Function  
  Public   Function   RefreshPositions()  
          Dim   i   As   Long  
          Dim   x   As   clsAutoPositionerItem  
          Dim   erg   As   Long  
           
          For   i   =   1   To   m_oAssignments.Count  
                  Set   x   =   m_oAssignments.Item(i)  
                  Select   Case   x.tPosType  
                          Case   tCONTAINER_RELATIVE_POS_RIGHT:  
                                  erg   =   x.oREL.Width   -   x.lValue  
                                  If   (erg   >   0)   Then   x.oCTL.Left   =   erg  
                          Case   tCONTAINER_RELATIVE_POS_BOTTOM:  
                                  erg   =   x.oREL.Height   -   x.lValue  
                                  If   (erg   >   0)   Then   x.oCTL.Top   =   erg  
                                   
                          Case   tCONTAINER_WIDTH_DELTA_RIGHT:  
                                  erg   =   x.oREL.Width   -   x.oCTL.Left   -   x.lValue  
                                  If   (erg   >   0)   Then   x.oCTL.Width   =   erg  
                          Case   tCONTAINER_HEIGHT_DELTA_BOTTOM:  
                                  erg   =   x.oREL.Height   -   x.oCTL.Top   -   x.lValue  
                                  If   (erg   >   0)   Then  
                                          x.oCTL.Height   =   erg  
                                  Else  
                                          erg   =   erg  
                                  End   If  
                                   
                          Case   tCONTROL_RELATIVE_SAME_POS_VERTICAL:  
                                  erg   =   x.oREL.Left   +   x.lValue  
                                  x.oCTL.Left   =   erg  
                          Case   tCONTROL_RELATIVE_SAME_POS_HORIZONTAL:  
                                  erg   =   x.oREL.Top   +   x.lValue  
                                  x.oCTL.Top   =   erg  
                  End   Select  
          Next  
  End   Function  
   
  ’//                                                                  
  ’类模块:clsAutoPositionerItem  
  Public   Enum   tPOSITION_TYPE  
          tCONTAINER_RELATIVE_POS_RIGHT  
          tCONTAINER_RELATIVE_POS_BOTTOM  
          tCONTAINER_WIDTH_DELTA_RIGHT  
          tCONTAINER_HEIGHT_DELTA_BOTTOM  
          tCONTROL_RELATIVE_SAME_POS_VERTICAL  
          tCONTROL_RELATIVE_SAME_POS_HORIZONTAL  
  End   Enum  
   
   
  Public   oCTL   As   Object  
  Public   oREL   As   Object  
  Public   tPosType   As   tPOSITION_TYPE  
  Public   lValue   As   tPOSITION_TYPE  
   
  ’//      
  ’窗体代码:  
   
  Option   Explicit  
  Dim   m_oAutoPos   As   New   clsAutoPositioner  
   
   
  Private   Sub   Form_Load()  
  ’   Always   relative   to   container’s   right   border  
  m_oAutoPos.AddAssignment   Me.Command1,   Me,   tCONTAINER_RELATIVE_POS_RIGHT  
   
  ’   Auto   resizing   horizontally  
  m_oAutoPos.AddAssignment   Me.Command2,   Me,   tCONTAINER_WIDTH_DELTA_RIGHT  
   
  ’   Auto   resizing   vertically  
  m_oAutoPos.AddAssignment   Me.Command3,   Me,   tCONTAINER_HEIGHT_DELTA_BOTTOM  
   
  ’   Always   relative   to   container’s   bottom   border  
  m_oAutoPos.AddAssignment   Me.Command4,   Me,   tCONTAINER_RELATIVE_POS_BOTTOM  
   
  ’   Auto   resizing   horizontally   +   Auto   resizing   vertically  
  m_oAutoPos.AddAssignment   Me.Command5,   Me,   tCONTAINER_WIDTH_DELTA_RIGHT  
  m_oAutoPos.AddAssignment   Me.Command5,   Me,   tCONTAINER_HEIGHT_DELTA_BOTTOM  
   
   
  End   Sub  
   
  Private   Sub   Form_Resize()  
  m_oAutoPos.RefreshPositions  
  End   Sub  

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值