www.pudn.com > Ball００１.rar > Ball.frm

VERSION 5.00 
Begin VB.Form Form1  
   BorderStyle     =   0  'None 
   Caption         =   "跟着鼠标的小球" 
   ClientHeight    =   3630 
   ClientLeft      =   3315 
   ClientTop       =   2850 
   ClientWidth     =   4800 
   LinkTopic       =   "Form1" 
   Picture         =   "Ball.frx":0000 
   ScaleHeight     =   242 
   ScaleMode       =   3  'Pixel 
   ScaleWidth      =   320 
   ShowInTaskbar   =   0   'False 
   Begin VB.Menu mnu_PopUp  
      Caption         =   "" 
      Enabled         =   0   'False 
      Visible         =   0   'False 
      Begin VB.Menu mnu_Exit  
         Caption         =   "退出" 
      End 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Private Declare Function ReleaseCapture Lib "user32" () As Long 
Private Const WM_NCLBUTTONDOWN = &HA1 
Private Const HTCAPTION = 2 
 
Dim StartX, StarY As Single 
Dim Moving As Boolean 
 
Dim vY As Single 
Private Const g = 9.8 
 
Dim Border_Width As Single 
Dim Title_Height As Single 
 
Private Sub Form_Load() 
Dim hRgn As Long 
 
Dim wid As Single 
Dim hgt As Single 
 
If Form1.WindowState = vbMinimized Then Exit Sub 
 
wid = ScaleX(Form1.Width, vbTwips, vbPixels) 
hgt = ScaleY(Form1.Height, vbTwips, vbPixels) 
 
Border_Width = (wid - Form1.ScaleWidth) / 2 
Title_Height = hgt - Border_Width - Form1.ScaleHeight 
 
hRgn = CreateEllipticRgn(Border_Width + 1, Title_Height + 1, Border_Width + 50, Title_Height + 50) 
SetWindowRgn Form1.hwnd, hRgn, True 
Moving = False 
vY = 0 
 
 
 
End Sub 
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
If (Button And vbLeftButton) <> 0 Then 
   StartX = X 
   StartY = Y 
   Moving = True 
End If 
 
If (Button And vbRightButton) <> 0 Then 
   Form1.PopupMenu mnu_PopUp 
End If 
 
End Sub 
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
If Moving Then 
   Me.Move Left + X - StartX, Top + Y - StartY 
   Form1.Refresh 
End If 
 
End Sub 
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 
If Moving Then 
   Moving = False 
   vY = 0 
End If 
 
End Sub 
 
Private Sub mnu_Exit_Click() 
Unload Me 
 
End Sub