Personal Computer World 2002 March/PCWMAR02.iso/software/turbocad/V4/tcw.z/Smiley.bas

BASIC Source File | 1997-10-28 | 5KB | 172 lines

' This sample program is to illustrate how to create simple scripts for TurboCAD
'
' Author    : Mike Cartwright, Tamara Cartwright updated script for 4.0
' Date        : 11/27/95    01/23/97
'
' Global Const BrushSolid = 1
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 = 0 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 15,  79, 35, 14, "Cancel"       ' CancelID = 0
          PushButton 135, 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 faceg As Long
    Dim faceg1 As Long
    Dim eyeg1 As Long
    Dim eyeg2 As Long
    Dim mouthg As Long
    Dim i As Long
    Dim x As Double
    Dim rad As Double

    dActive = TCWDrawingActive ()

    xc = (TCWViewExtentsGetX1() + TCWViewExtentsGetX2())/2
    yc = (TCWViewExtentsGetY1() + TCWViewExtentsGetY2())/2
    rad=yc*2/3
    ' Create the empty circle graphic
    faceg = TCWCircleCenterAndPoint(xc, yc, 0.0, xc, yc+rad,0.0)

    If (faceg = 0) Then
       Result = TCWLastErrorGet(errorstr)
       MsgBox "Error creating circle : " & errorstr
       Stop
    End If

    ' Color is set as 0x00bbggrr
    Result = TCWGraphicPropertySet( faceg, "PenColor", &H0000FFFF)

    ' Fill Pattern is a style. We know that style 1 is always solid
    Result = TCWGraphicPropertySet( faceg, "BrushStyle", "Solid")

    'Select the graphic so we can move it to the back
    Result = TCWGraphicPropertySet( faceg, "Selected", 1)
    TCWSendToBack
    Result = TCWGraphicPropertySet( faceg, "Selected", 0)

    ' Create the empty circle graphic
    faceg1 = TCWCircleCenterAndPoint(xc, yc, 0.0, xc, yc+rad,0.0)

    If (faceg1 = 0) Then
       Result = TCWLastErrorGet(errorstr)
       MsgBox "Error creating circle : " & errorstr
       Stop
    End If

    ' Color is set as 0x00bbggrr
    Result = TCWGraphicPropertySet( faceg1, "PenColor", &H000000FF)

    ' Do eyes
    For i = 0 to 2
       if i <> 1 Then
          x = xc - rad/2 * (i-1)

          ' Create the empty circle graphic
          g = TCWCircleCenterAndPoint(x, yc+rad/3,0.0, x+rad*0.1, yc+rad/3,0.0)
          If (g = 0) 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", "Solid")
       End If
if eyeg1=0 then
eyeg1=g
else
eyeg2=g
end if
    Next i

    ' Do Mouth

    ' Create the empty arc graphic
    ' Set the parameters of the background arc
    if Mood = Sad Then
        mouthg = TCWArcCenterAndPoint(xc, yc-rad, 0.0, xc+rad/3, yc-rad, 0.0, Pi/4, Pi*3/4)
    Else
        mouthg = TCWArcCenterAndPoint(xc, yc, 0.0, xc+rad/3, yc+rad/3, 0.0, Pi*5/4, Pi*7/4)
    End If

    If (mouthg = 0) Then
        Result = TCWLastErrorGet(errorstr)
        MsgBox "Error creating arc for mouth : " & errorstr
        Stop
    End If

    ' Color is set as 0x00bbggrr
     Result = TCWGraphicPropertySet( mouthg, "PenColor", &H000000FF)

    ' Make all the graphics into a group
    Result = TCWGraphicPropertySet( faceg, "Selected", 1)
    Result = TCWGraphicPropertySet( faceg1, "Selected", 1)
    Result = TCWGraphicPropertySet( eyeg1, "Selected", 1)
    Result = TCWGraphicPropertySet( eyeg2, "Selected", 1)
    Result = TCWGraphicPropertySet( mouthg, "Selected", 1)
    TCWGroupCreate("smiley")
    TCWDeselectAll

End Sub