home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 11
/
BUGCD1998_02.ISO
/
aplic
/
turbocad
/
tcw.z
/
Smiley.bas
< prev
next >
Wrap
BASIC Source File
|
1997-05-05
|
5KB
|
158 lines
' This sample program is to illustrate how to create simple scripts for TurboCAD 3.0
'
' Author : Mike Cartwright, Tamara Cartwright updated script for 4.0
' Date : 11/27/95 01/23/97
'
Global Const BrushSolid = 1
Global Const NULL = 0
Global Const PI = 3.141
' Result is a global variable returned by each page to tell the
' state machine which button was pressed :
Global Const CancelID = 1
Global Const CreateID = 2
Global Const Happy = 0
Global Const Sad = 1
Dim Result As Long
Dim Mood As Long
Sub Main ()
Dim dActive As Long
' Active drawing
dActive = TCWDrawingActive ()
' Check for valid drawing
If dActive = NULL Then
MsgBox "Program requires active drawing. Open any drawing and try again."
' Terminate the program
Stop
End If
Mood = Happy ' Default is Happy
MoodDlg
if Result = CreateID Then
CreateSmiley
End If
End Sub
Sub MoodDlg ()
Begin Dialog MoodDialog 31, 32, 185, 96, "Create a Smiley!"
PushButton 24, 79, 35, 14, "Cancel" ' CancelID = 0
PushButton 144, 79, 35, 14, "&Finish" ' CreateID = 1
GroupBox 1, 75, 183, 1, ""
GroupBox 100, 12, 72, 48, "Mood"
OptionGroup .grp
OptionButton 108, 24, 55, 9, "&Happy" ' Option 0
OptionButton 108, 40, 55, 9, "&Sad" ' Option 1
GroupBox 10, 12, 82, 48, ""
Text 14, 18, 74, 40, "If you are in a great mood choose happy, obviously."
End Dialog
Dim Dlg As MoodDialog
Dlg.grp = Mood
' Run the dialog ..
Result = Dialog(Dlg)
Mood = Dlg.grp
End Sub
' Called on "Create" to actually create the graphics and add them
' to the drawing.
Sub CreateSmiley ()
Dim dActive As Long
Dim Result As Long
Dim xc As Double
Dim yc As Double
Dim errorstr As String
Dim g As Long
Dim i As Long
Dim x As Double
dActive = TCWDrawingActive ()
xc = (TCWViewExtentsGetX1() + TCWViewExtentsGetX2())/2
yc = (TCWViewExtentsGetY1() + TCWViewExtentsGetY2())/2
' Create the empty circle graphic
g = TCWCircleCenterAndPoint(xc, yc, 0.0, xc, yc+3, 0.0)
If (g = NULL) Then
Result = TCWLastErrorGet(errorstr)
MsgBox "Error creating circle : " & errorstr
Stop
End If
' Color is set as 0x00bbggrr
Result = TCWGraphicPropertySet( g, "PenColor", &H0000FFFF)
' Fill Pattern is a style. We know that style 1 is always solid
Result = TCWGraphicPropertySet( g, "BrushStyle", 1)
'Select the graphic so we can move it to the back
Result = TCWGraphicPropertySet( g, "Selected", 1)
TCWSendToBack
Result = TCWGraphicPropertySet( g, "Selected", 0)
' Create the empty circle graphic
g = TCWCircleCenterAndPoint(xc, yc, 0.0, xc, yc+3, 0.0)
If (g = NULL) Then
Result = TCWLastErrorGet(errorstr)
MsgBox "Error creating circle : " & errorstr
Stop
End If
' Color is set as 0x00bbggrr
Result = TCWGraphicPropertySet( g, "PenColor", &H000000FF)
' Do eyes
For i = 0 to 2
if i <> 1 Then
x = xc - 1.5 * (i-1)
' Create the empty circle graphic
g = TCWCircleCenterAndPoint(x, yc+1, 0.0, x+.35, yc+1, 0.0)
If (g = NULL) Then
Result = TCWLastErrorGet(errorstr)
MsgBox "Error creating circle for eyes : " & errorstr
Stop
End If
' Color is set as 0x00bbggrr
Result = TCWGraphicPropertySet (g, "PenColor", &H000000FF)
' Fill Pattern is a style. We know that style 1 is always solid
Result = TCWGraphicPropertySet (g, "BrushStyle", 1)
End If
Next i
' Do Mouth
' Create the empty arc graphic
' Set the parameters of the background arc
if Mood = Sad Then
g = TCWArcCenterAndPoint(xc, yc-3, 0.0, xc+1, yc-3, 0.0, Pi/4, Pi*3/4)
Else
g = TCWArcCenterAndPoint(xc, yc, 0.0, xc+1, yc+1, 0.0, Pi*5/4, Pi*7/4)
End If
If (g = NULL) Then
Result = TCWLastErrorGet(errorstr)
MsgBox "Error creating arc for mouth : " & errorstr
Stop
End If
' Color is set as 0x00bbggrr
Result = TCWGraphicPropertySet( g, "PenColor", &H000000FF)
' Make all the graphics into a group
TCWSelectAll
TCWGroupCreate("smiley")
TCWDeselectAll
End Sub