frmdraw.frm

菜单浏览系统 vb环境开发 界面做的非常好 是vb学习的绝佳素材 this vbsystem is very useful

VERSION 5.00
Begin VB.Form frmDraw 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "菜单示例"
   ClientHeight    =   2955
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   3600
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   197
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   240
   StartUpPosition =   2  '屏幕中心
   Begin VB.Menu mnuShape 
      Caption         =   "图形(&S)"
      Begin VB.Menu mnuShapeCircle 
         Caption         =   "画圆(&I)"
         Shortcut        =   ^I
      End
      Begin VB.Menu mnuShapeRect 
         Caption         =   "画矩形(&R)"
         Shortcut        =   ^R
      End
      Begin VB.Menu mnuShapeLine 
         Caption         =   "画对角线(&L)"
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuShapeBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuShapeClear 
         Caption         =   "清除(&C)"
         Shortcut        =   {DEL}
      End
      Begin VB.Menu mnuShapeBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuShapeExit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^X
      End
   End
End
Attribute VB_Name = "frmDraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = vbRightButton Then
      ''隐藏某些菜单项
      mnuShapeBar2.Visible = False
      mnuShapeExit.Visible = False
      
      PopupMenu mnuShape              ''弹出菜单
      
      ''重新显示出所隐藏的菜单项
      mnuShapeBar2.Visible = True
      mnuShapeExit.Visible = True
   End If
End Sub

Private Sub mnuShapeCircle_Click()
   Me.Cls   ''清空窗体的客户区
   ''设置窗体的背景填充模式为透明
   Me.FillStyle = vbFSTransparent
   
   Dim cx, cy, radius, i
   
   ''取得圆心位置
   cx = ScaleWidth / 2
   cy = ScaleHeight / 2
   
   ''取得圆的最大半径
   If cx > cy Then
      radius = cy
   Else
      radius = cx
   End If
   
   ''以(cx,cy)为圆心，采用不同的半径，以随机的颜色画圆。
   For i = 0 To radius
      Circle (cx, cy), i, RGB(Rnd * 255, Rnd * 255, Rnd * 255)
   Next i
   
   ''设置“画圆”菜单项的复选状态，表示当前图像为圆形；
   ''并清除其它菜单项的复选标记
   mnuShapeCircle.Checked = True
   mnuShapeRect.Checked = False
   mnuShapeLine.Checked = False
End Sub

Private Sub mnuShapeClear_Click()
   Me.Cls
   
   ''清除用以画图的菜单项的复选状态
   mnuShapeCircle.Checked = False
   mnuShapeRect.Checked = False
   mnuShapeRect.Checked = False
End Sub

Private Sub mnuShapeExit_Click()
   Unload Me
End Sub

Private Sub mnuShapeLine_Click()
   Me.Cls

   Me.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
   ''设置窗体的背景填充模式为：交叉对角线
   Me.FillStyle = vbDiagonalCross
   
   Me.Line (0, 0)-(ScaleWidth, ScaleHeight), Me.FillColor, B
   
   ''设置“画直线”菜单项的复选状态，表示当前图像为直线；
   ''并清除其它菜单项的复选标记
   mnuShapeCircle.Checked = False
   mnuShapeRect.Checked = False
   mnuShapeLine.Checked = True
End Sub

Private Sub mnuShapeRect_Click()
   Me.Cls
   
   Dim cx, cy
   cx = ScaleWidth / 5
   cy = ScaleHeight / 5
   
   Me.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
   ''设置窗体的背景填充模式为：实线
   Me.FillStyle = vbFSSolid
   
   Me.Line (cx, cy)-(ScaleWidth - cx, ScaleHeight - cy), RGB(Rnd * 255, Rnd * 255, Rnd * 255), B
   
   ''设置“画矩形”菜单项的复选状态，表示当前图像为矩形；
   ''并清除其它菜单项的复选标记
   mnuShapeCircle.Checked = False
   mnuShapeRect.Checked = True
   mnuShapeLine.Checked = False
End Sub