form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "窗体动态形状转换"
   ClientHeight    =   5745
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   5880
   LinkTopic       =   "Form1"
   Picture         =   "Form1.frx":0000
   ScaleHeight     =   383
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   392
   StartUpPosition =   1  '所有者中心
   Begin VB.Timer Timer1 
      Interval        =   10
      Left            =   285
      Top             =   660
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "请点击鼠标右键"
      Height          =   255
      Left            =   2235
      TabIndex        =   0
      Top             =   585
      Width           =   1560
   End
   Begin VB.Menu ctzh 
      Caption         =   "窗体转换"
      Begin VB.Menu onewin 
         Caption         =   "扇形转圆形"
      End
      Begin VB.Menu twowin 
         Caption         =   "圆形转扇形"
      End
      Begin VB.Menu thrwin 
         Caption         =   "圆形转半圆"
      End
      Begin VB.Menu fouwin 
         Caption         =   "半圆转圆形"
      End
      Begin VB.Menu fivwin 
         Caption         =   "扇形转半圆"
      End
      Begin VB.Menu sixwin 
         Caption         =   "半圆转扇形"
      End
      Begin VB.Menu end 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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 Long) As Long

Dim i As Long
Dim j As Long

Private Sub Form_Load()
  Dim hr&, dl&
  Dim usew&, useh&
  Me.Height = Me.Width
  Me.Refresh
  usew& = Me.Width / Screen.TwipsPerPixelX
  useh& = Me.Height / Screen.TwipsPerPixelY
  hr& = CreateEllipticRgn(0, 0, usew, useh)
  dl& = SetWindowRgn(Me.hWnd, hr, True)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'鼠标右键弹出菜单
  If Button = 2 Then PopupMenu Form1.ctzh
End Sub

Private Sub onewin_Click()
  j = 1
  i = 1
End Sub
Private Sub twowin_Click()
  j = 2
  i = 1
End Sub
Private Sub thrwin_Click()
  j = 3
  i = 1
End Sub
Private Sub fouwin_Click()
  j = 4
  i = 1
End Sub
Private Sub fivwin_Click()
  j = 5
  i = 1
End Sub
Private Sub sixwin_Click()
  j = 6
  i = 1
End Sub

Private Sub Timer1_Timer()
  i = i + 20
  Timer1.Interval = 0
' 扇形转圆形
  If j = 1 Then
     Me.Height = Me.Height + i
     Me.Width = Me.Width + i
  End If
' 圆形转扇形
  If j = 2 Then
     If Me.Height > 3000 Then
        Me.Height = Me.Height - i
        Me.Width = Me.Width - i
     End If
  End If
' 圆形转半圆
  If j = 3 Then
     If Me.Height > 3000 Then
        Me.Height = Me.Height - i
     End If
  End If
' 半圆转圆形
  If j = 4 Then
     Me.Height = Me.Height + i
  End If
' 扇形转半圆
  If j = 5 Then
     Me.Width = Me.Width + i
  End If
' 半圆转扇形
  If j = 6 Then
     If Me.Width > 3000 Then
        Me.Width = Me.Width - i
     End If
  End If
  Timer1.Interval = 50
End Sub

Private Sub end_Click()
  End
End Sub