学步园

Option  Explicit  
 
       Private  myForm  As  Form      '应用窗体  
       Private  picP  As  Object      '做为分隔条的控件  
       Private  objBox1  As  Object  '分隔条左边控件  
       Private  objBox2  As  Object  '分隔条右边控件  
Private  Sub  Class_Terminate()  
       Set  myForm  =  Nothing  
       Set  picP  =  Nothing  
       Set  objBox1  =  Nothing  
       Set  objBox2  =  Nothing  
End  Sub  
Public  Sub  myInit(inForm  As  Form,  pic  As  Object,  obj1  As  Object,  obj2  As  Object)  
On  Error  GoTo  err1  
       '初始化各控件位置  
       Set  myForm  =  inForm  
       Set  picP  =  pic  
       Set  objBox1  =  obj1  
       Set  objBox2  =  obj2  
       picP.MousePointer  =  9  
       picP.Appearance  =  0  
       picP.BackColor  =  &H8000000F  
       picP.BorderStyle  =  0  
       picP.Width  =  50  
       objBox1.Top  =  0  
       objBox1.Left  =  0  
       objBox1.Width  =  3000  
       objBox1.Height  =  myForm.Height  
       picP.Top  =  0  
       picP.Left  =  objBox1.Width  
       picP.Height  =  myForm.Height:      objBox2.Top  =  0  
       objBox2.Left  =  objBox1.Width  +  picP.Width  
       objBox2.Height  =  myForm.Height  
       objBox2.Width  =  myForm.Width  -  objBox1.Width  -  picP.Width  
       picP.ZOrder  (0)  
Exit  Sub  
err1:  
End  Sub  
Public  Sub  myMouseMove(MouseButton  As  Integer,  X  As  Single)  
On  Error  GoTo  err1  
       '在picP控件的mouseMove事件中调用  
       If  MouseButton  =  1  Then  
               picP.Move  picP.Left  +  X  
               objBox1.Width  =  picP.Left  
               objBox2.Left  =  picP.Left  +  50  
               objBox2.Width  =  myForm.Width  -  picP.Left  
               picP.ZOrder  (0)  
       End  If  
Exit  Sub  
err1:  
End  Sub  
Public  Sub  myMouseUp(MouseButton  As  Integer)  
On  Error  GoTo  err1  
       '在picP控件的mouseUp事件中调用  
       If  MouseButton  =  1  Then  
               objBox1.Left  =  0  
               If  picP.Left  <  1000  Then  
                       objBox1.Width  =  1000  
                       picP.Left  =  1000  
               Else  
                       If  picP.Left  >  myForm.Width  Then  
                               objBox1.Width  =  myForm.Width  -  1000  
                               picP.Left  =  objBox1.Width  
                       Else  
                               objBox1.Width  =  picP.Left  
                       End  If  
               End  If  
               objBox2.Left  =  objBox1.Width  +  picP.Width  
               objBox2.Width  =  myForm.Width  -  objBox1.Width  -  picP.Width  
End  If  
Exit  Sub  
err1:  
End  Sub  
 
 
'以下是窗口代码,添加一个Picturebox控件和两个textbox控件.  
Option  Explicit  
Dim  a  As  Class1  
 
Private  Sub  Form_Load()  
Set  a  =  New  Class1  
a.myInit  Me,  Picture1,  Text1,  Text2  
End  Sub  
 
Private  Sub  Picture1_MouseMove(Button  As  Integer,  Shift  As  Integer,  X  As  Single,  Y  As  Single)  
a.myMouseMove  Button,  X  
End  Sub