shape.frm

vb源码大全

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Shape"
   ClientHeight    =   3510
   ClientLeft      =   60
   ClientTop       =   390
   ClientWidth     =   4680
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   3510
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.ListBox BorderS 
      Height          =   240
      Left            =   2880
      TabIndex        =   12
      Top             =   3240
      Width           =   1455
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      Left            =   2880
      Max             =   6
      Min             =   1
      TabIndex        =   11
      Top             =   2520
      Value           =   1
      Width           =   1455
   End
   Begin VB.ListBox FillS 
      Height          =   240
      Left            =   2880
      TabIndex        =   9
      Top             =   2880
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   255
      Index           =   6
      Left            =   120
      TabIndex        =   7
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "圆角正方形"
      Height          =   255
      Index           =   5
      Left            =   120
      TabIndex        =   5
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "圆角矩形"
      Height          =   255
      Index           =   4
      Left            =   120
      TabIndex        =   4
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "圆"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   3
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "椭圆"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   2
      Top             =   1200
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "正方形"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "矩形"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "边框样式"
      Height          =   255
      Left            =   1920
      TabIndex        =   13
      Top             =   3240
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "边框宽度"
      Height          =   255
      Left            =   1920
      TabIndex        =   10
      Top             =   2520
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "填充方式"
      Height          =   255
      Left            =   1920
      TabIndex        =   8
      Top             =   2880
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   " "
      Height          =   255
      Left            =   1920
      TabIndex        =   6
      Top             =   2040
      Width           =   2415
   End
   Begin VB.Shape Shape1 
      Height          =   1695
      Left            =   1920
      Top             =   240
      Width           =   2415
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'  设置Shape控件外观
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0   '  绘制矩形
        Shape1.Shape = 0
        Case 1   '  绘制正方形
        Shape1.Shape = 1
        Case 2   '  绘制椭圆
        Shape1.Shape = 2
        Case 3   '  绘制圆
        Shape1.Shape = 3
        Case 4   '  绘制圆角矩形
        Shape1.Shape = 4
        Case 5   '  绘制圆角正方形
        Shape1.Shape = 5
        Case 6   '  结束退出
        End
    End Select
End Sub

Private Sub BorderS_Scroll()
    Call BorderS_Click
End Sub

Private Sub BorderS_Click()
    If BorderS.ListIndex <> "-1" Then
        '  设置边框样式
        Shape1.BorderStyle = BorderS.ListIndex
    End If
End Sub

Private Sub FillS_Scroll()
    Call FillS_Click
End Sub

Private Sub FillS_Click()
    If FillS.ListIndex <> "-1" Then
        '  设置填充方式
        Shape1.FillStyle = FillS.ListIndex
    End If
End Sub
 
'  设置边框宽度
Private Sub HScroll1_Change()
    Shape1.BorderWidth = HScroll1.Value
End Sub

' 初始话列表框选项
Private Sub Form_Load()
    '  初始话列表框选项
    With FillS
        .AddItem "0 实线"
        .AddItem "1 透明"
        .AddItem "2 水平直线"
        .AddItem "3 垂直直线"
        .AddItem "4 上斜对角线"
        .AddItem "5 下斜对角线"
        .AddItem "6 十字线"
        .AddItem "7 交叉对角线"
    End With
    With BorderS
        .AddItem "0 透明"
        .AddItem "1 实线"
        .AddItem "2 虚线"
        .AddItem "3 点线"
        .AddItem "4 点划线"
        .AddItem "5 双点划线"
        .AddItem "6 内收实线"
    End With
End Sub