Search Tools Links Login

Office97 Assistant Plays Games!!!


This code makes the irritating office assistant a fun playmate, he play games of Paper, Scissors, Stone...and his expressions change according to your actions!!!!

Original Author: Ed Hockaday

Assumptions

You will need the ietimer.ocx (from ie4) to get this working, a none timer version can be easily built using this code...

API Declarations


Code

'This bit goes in a form
'To create the form follow these instructions
'1 Open word, go to the "tools" menu, select "macros" then "Visual Basic Editor"
'2 Make a form, call the form frmFight
'3 Add three Option buttons, call these optPaper, optScissors and optStone
'make sure the text on them says Paper, Scissors and Stone respectively
'4 Add two labels, call these lblWinsLossesDraws and lblTimerObject
'5 Add two Command buttons, call these cmdChosen and cmdExit
'6 Add the additional control "Timer Object" (ietimer.ocx)
'7 Add a timer control to the form call this tmrTimer
'8 Add the following code to the form
'Note1: This was designed to play against clipit assistant but you can use any,
'it is simple to change the animations and office97 has a full help file on this
'Note2: To convert in to Visual Basic just remove all reference to Assistant in the form
'code, and follow instructions above (for 6 just use the normal VBtimer)
'Note3: You will need the ietimer ocx to get this to work in office97 (it works in VB without)
'Note4: If you like this code please tell me at edhockaday@hotmail.com, have fun with it!!!
Option Explicit
Dim gVar1
Dim gVar2
Dim gDraw As Boolean
Dim gMessage
Dim gWins
Dim gLosses
Dim gDraws
Dim gTimerObject
Dim OptionChosen
'**************************************
'*    Macros by Ed Hockaday    *
'*       151298        *
'**************************************
Public Sub sDraw()
If gVar1 = gVar2 Then
  sConvertNumberToText
  MsgBox "You both chose " & gVar1
  gDraws = gDraws + 1
  gDraw = True
  Assistant.Visible = True
  Assistant.Animation = msoAnimationLookUp
End If
End Sub
Public Sub sConvertTextToNumber()
If gVar1 = "Paper" Then
  gVar1 = 1
ElseIf gVar1 = "Scissors" Then
  gVar1 = 2
ElseIf gVar1 = "Stone" Then
  gVar1 = 3
End If
If gVar2 = "Paper" Then
  gVar2 = 1
ElseIf gVar2 = "Scissors" Then
  gVar2 = 2
ElseIf gVar2 = "Stone" Then
  gVar2 = 3
End If
End Sub
Public Sub sConvertNumberToText()
If gVar1 = 1 Then
  gVar1 = "Paper"
ElseIf gVar1 = 2 Then
  gVar1 = "Scissors"
ElseIf gVar1 = 3 Then
  gVar1 = "Stone"
End If
If gVar2 = 1 Then
  gVar2 = "Paper"
ElseIf gVar2 = 2 Then
  gVar2 = "Scissors"
ElseIf gVar2 = 3 Then
  gVar2 = "Stone"
End If
End Sub
Public Sub sVar1Win()
Assistant.Visible = True
Assistant.Animation = msoAnimationGetArtsy
MsgBox "You win"
gWins = gWins + 1
End Sub
Public Sub sVar2Win()
Assistant.Visible = True
Assistant.Animation = msoAnimationCharacterSuccessMajor
MsgBox "You lose"
gLosses = gLosses + 1
End Sub
Public Sub sReconcile()
If gVar1 = 1 Then
  If gVar2 = 3 Then
    gMessage = " wraps "
    sVar1Win
  ElseIf gVar2 = 2 Then
    gMessage = " gets cut by "
    sVar2Win
  End If
ElseIf gVar1 = 2 Then
  If gVar2 = 1 Then
    gMessage = " cuts "
    sVar1Win
  ElseIf gVar2 = 3 Then
    gMessage = " is blunted by "
    sVar2Win
  End If
ElseIf gVar1 = 3 Then
  If gVar2 = 2 Then
    gMessage = " blunts "
    sVar1Win
  ElseIf gVar2 = 1 Then
    gMessage = " gets wrapped by "
    sVar2Win
  End If
End If
End Sub
Public Sub sTimerObject()
If gTimerObject = "Paper" Then
  gTimerObject = "Stone"
ElseIf gTimerObject = "Stone" Then
  gTimerObject = "Scissors"
ElseIf gTimerObject = "Scissors" Then
  gTimerObject = "Paper"
End If
End Sub
Public Sub sLanding()
gVar2 = Int((3 * Rnd) + 1)
If gVar2 = 1 Then
  gVar2 = "Paper"
ElseIf gVar2 = 2 Then
  gVar2 = "Scissors"
ElseIf gVar2 = 3 Then
  gVar2 = "Stone"
End If
lblTimerObject.Caption = "Clipit chooses " & gVar2
End Sub
Private Sub cmdChosen_Click()
Assistant.Visible = True
Assistant.Animation = msoAnimationIdle
gTimerObject = "Paper"
gDraw = False
gMessage = ""
gVar1 = ""
'gVar2 = Int((3 * Rnd) + 1)
If gWins = "" Then gWins = "0"
If gLosses = "" Then gLosses = "0"
If gDraws = "" Then gDraws = "0"
If optPaper.Value = True Then
  gVar1 = 1
ElseIf optScissors.Value = True Then
  gVar1 = 2
ElseIf optStone.Value = True Then
  gVar1 = 3
End If
tmrTimer.Interval = 1
End Sub
Private Sub cmdExit_Click()
If gWins < gLosses Then
  With Assistant
  .Visible = True
  .Animation = msoAnimationGetAttentionMajor
    With .NewBalloon
    .Heading = "Quit while you're ahead...chicken"
    .Text = "...come on have another go?"
    .Labels(1).Text = "Yes!"
    .Labels(2).Text = "No!"
    .Mode = msoModeModal
    OptionChosen = .Show
    End With
  End With
  If OptionChosen = 1 Then
    Exit Sub
  ElseIf OptionChosen = 2 Then
    Assistant.Animation = msoAnimationDisappear
    Assistant.Visible = False
    MsgBox "Macros by Ed Hockaday - 151298"
    ' Pass these macros on, but change my name and I will find you and kill you
    ' Thank you kindly!!!
    Unload frmFight
  End If
ElseIf gWins > gLosses Then
  With Assistant
  .Visible = True
  .Animation = msoAnimationGetAttentionMajor
    With .NewBalloon
    .Heading = "Hahaha I beat you..."
    .Text = "...don't you want another go?"
    .Labels(1).Text = "Yes!"
    .Labels(2).Text = "No!"
    .Mode = msoModeModal
    OptionChosen = .Show
    End With
  End With
  If OptionChosen = 1 Then
    Exit Sub
  ElseIf OptionChosen = 2 Then
    Assistant.Animation = msoAnimationDisappear
    Assistant.Visible = False
    Unload frmFight
  End If
ElseIf gWins = gLosses Then
    With Assistant
  .Visible = True
  .Animation = msoAnimationGetAttentionMajor
    With .NewBalloon
    .Heading = "Come on it's a draw..."
    .Text = "...lets finish it..."
    .Labels(1).Text = "Yes!"
    .Labels(2).Text = "No!"
    .Mode = msoModeModal
    OptionChosen = .Show
    End With
  End With
  If OptionChosen = 1 Then
    Exit Sub
  ElseIf OptionChosen = 2 Then
    Assistant.Animation = msoAnimationDisappear
    Assistant.Visible = False
    Unload frmFight
  End If
End If
End Sub
Private Sub tmrTimer_Timer()
sTimerObject
lblTimerObject.Caption = gTimerObject
tmrTimer.Interval = tmrTimer.Interval + 10
If tmrTimer.Interval > 350 Then
  tmrTimer.Interval = 0
  sLanding
  sConvertTextToNumber
  sDraw
  If gDraw = True Then
    lblWinsLossesDraws.Caption = gWins & " wins, " & gLosses & " losses, " & gDraws & " draws."
    Exit Sub
  End If
  sReconcile
  sConvertNumberToText
  lblWinsLossesDraws.Caption = gWins & " wins, " & gLosses & " losses, " & gDraws & " draws."
  MsgBox gVar1 & gMessage & gVar2
End If
End Sub

'***************************************
'This bit goes in the ThisDocument part (found in the Microsoft word object folder in the project window...)
'**************************************
'*    Macros by Ed Hockaday    *
'*       151298        *
'**************************************
Sub docstart()
Dim OptionChosen As Integer
With Assistant
.Visible = True
.Animation = msoAnimationGetAttentionMajor
  With .NewBalloon
  .Heading = "Hi..."
  .Text = "...what to have some fun?"
  .Labels(1).Text = Chr(34) & "Yeah, OK!" & Chr(34)
  .Labels(2).Text = Chr(34) & "Not really!" & Chr(34)
  .Mode = msoModeModal
  OptionChosen = .Show
  End With
End With
If OptionChosen = 1 Then
  frmFight.Show
ElseIf OptionChosen = 2 Then
  No1
End If
End Sub
Private Sub Document_Open()
docstart
End Sub
Sub No1()
With Assistant
.Visible = True
.Animation = msoAnimationCharacterSuccessMajor
  With .NewBalloon
  .Heading = "Oh come on..."
  .Text = "...play with me..."
  .Labels(1).Text = "Play..."
  .Labels(2).Text = "Leave..."
  .Mode = msoModeModal
  OptionChosen = .Show
  End With
End With
If OptionChosen = 1 Then
  frmFight.Show
ElseIf OptionChosen = 2 Then
  Assistant.Animation = msoAnimationDisappear
  Assistant.Visible = False
End If
End Sub
Sub Yes1()
With Assistant
.Visible = True
.Animation = msoAnimationGetWizardy
  With .NewBalloon
  .Heading = "Fuck you small balls..."
  .Text = "...are you starting with me?"
  .Labels(1).Text = "Fight"
  .Labels(2).Text = "Run away"
  .Mode = msoModeModal
  OptionChosen = .Show
  End With
End With
If OptionChosen = 1 Then
  Fight
ElseIf OptionChosen = 2 Then
  Assistant.Animation = msoAnimationCharacterSuccessMajor
End If
End Sub
Sub Fight()
With Assistant
.Visible = True
.Animation = msoAnimationLookUp
End With
'frmFight.Show
End Sub
'*******************************************

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 103 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.