frmcomdg.frm

Visual Basic 6 大学教程的代码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmComDlg 
   BackColor       =   &H00FFFFFF&
   Caption         =   "Fig. 9.29: Demonstrating Color Dialog"
   ClientHeight    =   3195
   ClientLeft      =   2865
   ClientTop       =   1950
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   Begin MSComDlg.CommonDialog dlgColor 
      Left            =   240
      Top             =   1200
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdColorChoose 
      Caption         =   "Color..."
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Timer tmrTimer 
      Interval        =   500
      Left            =   240
      Top             =   240
   End
End
Attribute VB_Name = "frmComDlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Fig. 9.29
' Demonstrating the color Common Dialog
Option Explicit

Private Sub DrawShape()
   Dim x As Single, y As Single
   Dim totalRadians As Single, r As Single
   Dim a As Single, theta As Single
   Dim b As Single
   
   Call Randomize
   Scale (3, -3)-(-3, 3)         ' Change scale
   totalRadians = 8 * Atn(1)     ' Circle in Radians
      
   a = 3 * Rnd()  ' Offset used in equation
   b = 2 * Rnd()  ' Offset used in equation
   
   For theta = 0 To totalRadians Step 0.01
      r = b - a * Cos(theta)
      x = r * Cos(theta)      ' y coordinate
      y = r * Sin(theta)      ' x coordinate
      PSet (x, y)             ' Turn pixel on
   Next theta
   
End Sub

Private Sub tmrTimer_Timer()
   Call DrawShape   ' Call when time interval expires
End Sub

Private Sub cmdColorChoose_Click()
   dlgColor.ShowColor          ' Display color common dialog
   ForeColor = dlgColor.Color  ' Assign color to ForeColor
End Sub