控件随窗体大小而变化

 '当窗体大小改变时，如何动态的改变控件的大小是许多VB程序员头痛的  
  '事。有的人设置窗体Resizable但却不改变控件的大小；有的人则根据控件的  
  '绝对位置与窗口大小相加减的办法来重新定位控件与改变大小，这种办法比  
  '较繁琐，且不可重用；当然也有人则限定窗口干脆不让改变。  
  '下面给出一个一劳永逸的办法，源程序如下:  
   
  Private   FormOldWidth   As   Long  
  '原始宽度  
  Private   FormOldHeight   As   Long  
  '原始高度  
   
  '在调用ResizeForm前先调用本函数  
  Public   Sub   ResizeInit(FormName   As   Form)  
  Dim   Obj   As   Control  
  FormOldWidth   =   FormName.ScaleWidth  
  FormOldHeight   =   FormName.ScaleHeight  
  On   Error   Resume   Next  
  For   Each   Obj   In   FormName  
  Obj.Tag   =   Obj.Left   &   "   "   &   Obj.Top   &   "   "   &   Obj.Width   &   "   "   &   Obj.Height   &   "   "  
  Next   Obj  
  On   Error   GoTo   0  
  End   Sub  
   
  '按比例改变表单内各元件的大小，  
  '在调用ReSizeForm前先调用ReSizeInit函数  
  Public   Sub   ResizeForm(FormName   As   Form)  
  Dim   Pos(4)   As   Double  
  Dim   i   As   Long,   TempPos   As   Long,   StartPos   As   Long  
  Dim   Obj   As   Control  
  Dim   ScaleX   As   Double,   ScaleY   As   Double  
   
  ScaleX   =   FormName.ScaleWidth   /   FormOldWidth  
  '保存窗体宽度缩放比例  
  ScaleY   =   FormName.ScaleHeight   /   FormOldHeight  
  '保存窗体高度缩放比例  
  On   Error   Resume   Next  
  For   Each   Obj   In   FormName  
  StartPos   =   1  
  For   i   =   0   To   4  
  '读取控件的原始位置与大小  
   
  TempPos   =   InStr(StartPos,   Obj.Tag,   "   ",   vbTextCompare)  
  If   TempPos   >   0   Then  
  Pos(i)   =   Mid(Obj.Tag,   StartPos,   TempPos   -   StartPos)  
  StartPos   =   TempPos   +   1  
  Else  
  Pos(i)   =   0  
  End   If  
  '根据控件的原始位置及窗体改变大小  
  '的比例对控件重新定位与改变大小  
  Obj.Move   Pos(0)   *   ScaleX,   Pos(1)   *   ScaleY,   Pos(2)   *   ScaleX,   Pos(3)   *   ScaleY  
  Next   i  
  Next   Obj  
  On   Error   GoTo   0  
  End   Sub  
   
  Private   Sub   Form_Load()  
  Call   ResizeInit(Me)   '在装入时必须加入  
  End   Sub  
   
  Private   Sub   Form_Resize()  
    Call   ResizeForm(Me)   '控件随之改变  
  End   Sub  
   
  方法二  
   
  　　WINDOWS下的窗口一般都可以通过鼠标拖动来扩   大，有些时候我们需要控制窗口的比例不变，以防窗口比例失调时造成界面的不协调。要做   到这一点，可以利用API函数CallWindwosProc，当得到用户调整窗口的消息时，判断X或Y方   向上的比例是否和原来的比例一样，如果不一样，则调整为一样。下面是一个例子。    
  Private   Sub   Command1_Click()  
  UnloadMe  
  EndSub  
   
  Private   Sub   Form_Load()  
  OldWindowProc=SetWindowLong(hwnd,GWL_WNDPROC,AddressOf   NewWindowProc)  
  EndSub  
   
  模块中：    
   
  Public   OldWindowProc   As   Long  
  声明API函数如下：  
  Declare   Function   CallWindowProc   Lib"user32"Alias"CallWindowProcA"(ByVal   lpPrevWndFunc   As    
  Long,ByVal   hwnd   As   Long,ByValmsg   As   Long,ByVal   wParam   As   Long,lParam   As   WINDOWPOS)As   Long  
  Declare   Function   SetWindowLong   Lib   "user32"Alias"SetWindowLongA"   (alhwnd   As    
  Long,ByValnIndex   As   Long,ByVal   dwNewLong   As   Long)As   Long  
   
  Const   GWL_WNDPROC=-4  
  定义一个窗口位置数据类型  
  Type   WINDOWPOS  
  hwnd   As   Long  
  hWndInsertAfter   As   Long  
  x   As   Long  
  y   As   Long  
  cx   As   Long  
  cy   As   Long  
  flags   As   Long  
  End   Type  
  Const   WM_WINDOWPOSCHANGING=&H46  
  Const   WM_WINDOWPOSCHANGED=&H47  
  处理窗口变化的函数  
  PublicFunctionNewWindowProc(ByVal   hwnd   As   Long,ByVal   msg   As   Long,ByVal   wParam   As    
  Long,lParam   As   WINDOWPOS)As   Long  
  Static   done_before   As   Boolean  
  Static   aspect   As   Single  
  Dim   new_aspect   As   Single  
   
  If   msg=WM_WINDOWPOSCHANGING   Then  
  If   lParam.cy>0   Then  
  保存原来的比例  
  If   Notdone_before   Then  
  aspect=lParam.cx/lParam.cy  
  done_before=True  
  End   If  
   
  new_aspect=lParam.cx/lParam.cy  
  If   new_aspect>aspect   Then  
  lParam.cy=lParam.cx/aspect  
  Else  
  lParam.cx=aspect*lParam.cy  
  End   If  
  End   If  
  End   If  
   
  NewWindowProc=CallWindowProc  
  (OldWindowProc,hwnd,msg,wParam,lParam)  
   
  End   Function