file_id.diz
' Import some windows stuff...
' Easy to read :)
' Will only use Windows Native things here...
' Here are some nice speed improvement things... http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html
Option Explicit
Private CurrentCellX As Integer
Private CurrentCellY As Integer
Private N As Integer
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems
#End If
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=965
#If VBA7 Then
Public Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#Else
Public Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#End If
Public Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Sub Invitro()
Application.DisplayScreenTips = False
sndPlaySound32 "C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\snespling.wav", &H1
Clippy "It looks like you're tryint to writing a demo. Would you like some help?" & vbCrLf & vbCrLf & _
"* Insert rotating cube" & vbCrLf & _
"* Configure sine scroller" & vbCrLf & _
"* Choose rotozoom image" & vbCrLf & ""
DoEvents
' below this line the demo is in correct order. ORDER! UNACCEPTABLLLLEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
Sleep 5000
DoEvents
gotoPage (2)
WriteIntro
Sleep 3000
StartMusic
' todo: trim about 15 seconds from this part if possible...
' todo: text fields are probably misplaced.
gotoPage 3
Scroller2 "Hello Outline"
Scroller2 "SCREAM LOUDER!!!"
Scroller2 "I CAN'T HEAR YOU!"
Scroller2 "TURN UP THE BASS"
gotoPage 4
createTable 4, 4
gotoPage 4
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ColorSomeCells 4, 4
gotoPage 5
showAwesomeSpaceLogo
gotoPage 6
AwesomeSpaceSlideShow
gotoPage 7
showAwesomeSpaceLogo
gotoPage 8
DrawSpaceInvaders
TitleBox "3Ghz+ is futile"
Scroller "Performance of Champions"
gotoPage 9
TitleBox "Better use an Atari ;)"
gotoPage 10
OutlineLogo
PageLoops
TitleBox "HYPERSPEED"
gotoPage 11
RickRoll
RotatingCube
gotoPage 12
awesomeSpaceLogoOutro
DoEvents
Sleep 1000
End Sub
Sub WriteIntro()
Selection.Font.Name = "Comic Sans MS"
SimulateTyping "No demo experience whatsoever"
CheckText
SimulateTyping "Entering a world of PAIN!"
CheckText
SimulateTyping "A technology not listed on Pouet"
CheckText
SimulateTyping "Unreliable Piss Poor Perfomance, after all tutorials..."
CheckText
SimulateTyping "Word-art as a native construct"
CheckText
SimulateTyping "1 MILLION objects without sane documentation"
CheckText
SimulateTyping "Every line is over 9000 cycles!"
CheckText
SimulateTyping "Coded at Outline 2015, 100% drunk"
CheckText
SimulateTyping "Everything you would expect."
CheckText
End Sub
Sub CheckText()
Sleep 400
SimulateTyping " - CHECK!" & vbCrLf
Sleep 600
End Sub
Sub ClearPage(pageNumber As Integer)
Selection.Select
MsgBox ("Not Implemented Yet")
End Sub
Sub gotoPage(pageNumber As Integer)
Selection.GoTo wdGoToPage, wdGoToAbsolute, pageNumber
Sleep 1
End Sub
'todo: add nice squigly lines below
' http://www.vbforums.com/showthread.php?430740-Looping-through-Characters-in-a-string
Sub SimulateTyping(Text As String)
' Loop through the caracters, place each of them with a sleep of 10ms.
Dim M As Long, b() As Byte
b = Text
For M = 0 To UBound(b) Step 2
Selection.TypeText Chr(b(M))
'Beep 3400, 50
' Const SND_ASYNC = &H1
sndPlaySound32 "C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\beep.wav", &H1
Sleep (10)
DoEvents
Next M
End Sub
' create some font/style object, so you can quickly change fonts
' create a table and have their cells change random colors
' then have a pattern in these cells
' then add a plasma to the cells
' then scale down the cell size
' Beep 440, 50 'beep does not work, it hangs the system (system call) so word hangs. This is not the way to go.
' although it sounds cool.
' http://www.cpearson.com/excel/PlaySound.aspx
Sub SetCellColor(myCells As Cells, color As Variant)
With myCells
With .Shading
.BackgroundPatternColor = color
End With
End With
' without these options the screen doesn't refresh. keep em.
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
DoEvents
Sleep 15
End Sub
Sub Left()
Selection.MoveLeft Unit:=wdCell
SetCellColor Selection.Cells, RandomColor
End Sub
Sub Right()
Selection.MoveRight Unit:=wdCell
SetCellColor Selection.Cells, RandomColor
End Sub
Sub Down()
Selection.Move Unit:=wdCell, Count:=4
SetCellColor Selection.Cells, RandomColor
End Sub
Sub Up()
'Selection.MoveDown Unit:=wdCell
'Selection.SelectCell
SetCellColor Selection.Cells, RandomColor
End Sub
Function ColorSomeCells(X As Integer, Y As Integer)
' reset the cell-counters.
CurrentCellX = 0
Dim Max As Double
Max = X * Y - 1
For N = 0 To 400 Step 1
GotoCell getRandomInteger(0, Max)
SetCellColor Selection.Cells, RandomColor
Next N
End Function
' you have to move the selection which is an relative position to an absolute position.
' therefore you need to know your current position, and then its easy to calculate where
' the selection should move to.
Function GotoCell(X As Integer)
' X = 5, Current = 1
' 5 - 1 = + 4;
' X = 1, Current = 5
' 1 - 5 = -4
If (X <> CurrentCellX) Then
Selection.MoveRight Unit:=wdCell, Count:=X - CurrentCellX
End If
CurrentCellX = X
End Function
' abstract to go to a certain cell.
Function RandomColor() As Double
Select Case getRandomInteger(0, 10)
Case 1
RandomColor = wdColorAqua
Case 2
RandomColor = wdColorRed
Case 3
RandomColor = wdColorGreen
Case 4
RandomColor = wdColorYellow
Case 5
RandomColor = wdColorIndigo
Case 6
RandomColor = wdColorLavender
Case 7
RandomColor = wdColorRose
Case 8
RandomColor = wdColorOrange
Case 9
RandomColor = wdColorPink
Case 10
RandomColor = wdColorSkyBlue
Case Else
RandomColor = wdColorBlack
End Select
End Function
Function getRandomInteger(low As Double, high As Double) As Integer
getRandomInteger = (high - low) * Rnd() + low
End Function
Sub DrawSpaceInvaders()
For N = 0 To 40 Step 1
InvaderBox getRandomInteger(0, 500), getRandomInteger(0, 400), getRandomInteger(-10, 10)
'InvaderBox 50, 50, 4
DoEvents
Next N
End Sub
Sub InvaderBox(X As Integer, Y As Integer, R As Integer)
Application.ScreenUpdating = False
Dim Box As Shape
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=X, Top:=Y, Width:=220, Height:=220)
With Box
.Line.Visible = msoFalse
.TextFrame.TextRange.Font.Name = "Invaders": .TextFrame.TextRange.Font.Size = 100: .TextFrame.TextRange.Font.TextColor = RandomColor: .Rotation = R
End With
Application.ScreenUpdating = True
Select Case getRandomInteger(0, 3)
Case 0
Box.TextFrame.TextRange.Text = "A"
Case 1
Box.TextFrame.TextRange.Text = "F"
Case 2
Box.TextFrame.TextRange.Text = "B"
Case 3
Box.TextFrame.TextRange.Text = "E"
Case Else
Box.TextFrame.TextRange.Text = "C"
End Select
End Sub
Sub TitleBox(T As String)
Application.ScreenUpdating = False
Dim Box As Shape
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=50, Top:=200, Width:=500, Height:=260)
With Box
.TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorWhite: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Line.Visible = msoFalse
End With
Application.ScreenUpdating = True
'The line of the box and everything above is built up invisibly.
Box.TextFrame.TextRange.Text = T
' blink it
For N = 0 To 15 Step 1
Sleep 15
Box.TextFrame.TextRange.Font.TextColor = wdColorBlack
Sleep 15
Box.TextFrame.TextRange.Font.TextColor = wdColorWhite
DoEvents
Next N
Box.TextFrame.TextRange.Font.TextColor = wdColorBlack
End Sub
Sub createTable(X As Integer, Y As Integer)
'
' csdfsdfsdf Macro
'
'
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=Y, NumColumns:= _
X, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Tabelraster" Then
.Style = "Tabelraster"
End If
.ApplyStyleHeadingRows = True: .ApplyStyleLastRow = False: .ApplyStyleFirstColumn = True: .ApplyStyleLastColumn = False: .ApplyStyleRowBands = True: .ApplyStyleColumnBands = False
End With
For N = 0 To Y Step 1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.MoveDown Unit:=wdLine, Count:=1
DoEvents
Next N
'close it off...
End Sub
Sub showAwesomeSpaceLogo()
Dim BackgroundSquare As Shape
Set BackgroundSquare = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=115, Top:=50, Width:=400, Height:=400)
BackgroundSquare.Line.Visible = msoFalse
BackgroundSquare.Fill.BackColor.RGB = wdColorLime
Dim Invader As Shape
Set Invader = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=180, Top:=100, Width:=250, Height:=150)
With Invader
.Line.Visible = msoFalse: .TextFrame.TextRange.Font.Name = "Invaders": .TextFrame.TextRange.Font.Size = 144: .TextFrame.TextRange.Font.TextColor = wdColorWhite: .Rotation = -10: .TextFrame.TextRange.Text = "C"
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
Dim AwesomeSpace As Shape
Set AwesomeSpace = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=250, Width:=500, Height:=360)
With AwesomeSpace
.TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 42: .TextFrame.TextRange.Font.TextColor = wdColorWhite: .TextFrame.TextRange.Text = "AWESOME " & vbCrLf & "-SPACE-": .Rotation = -10
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter:
.Line.Visible = msoFalse
End With
' line is not always properly removed
AwesomeSpace.Line.Visible = msoFalse
DoEvents
Sleep 1000
BackgroundSquare.Fill.BackColor.RGB = wdColorOrange
Sleep 200
BackgroundSquare.Fill.BackColor.RGB = wdColorPink
Sleep 200
BackgroundSquare.Fill.BackColor.RGB = wdColorAqua
Sleep 200
BackgroundSquare.Fill.BackColor.RGB = wdColorBrightGreen
Sleep 200
BackgroundSquare.Fill.BackColor.RGB = wdColorRed
Sleep 200
BackgroundSquare.Fill.BackColor.RGB = wdColorTurquoise
Sleep 200
BackgroundSquare.Fill.BackColor.RGB = wdColorBlueGray
Sleep 200
DoEvents
End Sub
Sub Scroller(Text As String)
Application.ScreenUpdating = False
' make a scroller... it is required
Dim AwesomeSpace As Shape
Set AwesomeSpace = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=500, Top:=150, Width:=500, Height:=260)
With AwesomeSpace
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
.TextFrame.TextRange.Text = Text: .Rotation = 30
End With
Application.ScreenUpdating = True
'try to make it more efficient, lol, futile
For N = 0 To 30 Step 1
With AwesomeSpace
.Rotation = AwesomeSpace.Rotation - 2: .Left = AwesomeSpace.Left - 30: .TextFrame.TextRange.Font.TextColor = RandomColor
End With
If (N Mod 5 = 0) Then
DoEvents
End If
Next N
End Sub
' todo: some optimizations: precalculate things
' make the text area smaller, so less time is wasted.
Sub Scroller2(Text As String)
Application.ScreenUpdating = False
' make a scroller... it is required
Dim Line1 As Shape
Set Line1 = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=-600, Top:=100, Width:=2000, Height:=50)
With Line1
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
End With
'using the Duplicate operation on the lines causes word to crash
Dim Line2 As Shape
Set Line2 = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=-600, Top:=105, Width:=2000, Height:=50)
With Line2
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
End With
Dim Line3 As Shape
Set Line3 = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=-600, Top:=110, Width:=2000, Height:=50)
With Line3
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
End With
Dim Line4 As Shape
Set Line4 = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=-600, Top:=115, Width:=2000, Height:=50)
With Line4
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
End With
Dim Line5 As Shape
Set Line5 = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=-600, Top:=120, Width:=2000, Height:=50)
With Line5
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
End With
Dim Dummy As Shape
Set Dummy = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=-600, Top:=120, Width:=2000, Height:=50)
With Dummy
.Line.Visible = msoFalse: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft: .TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 36: .TextFrame.TextRange.Font.TextColor = wdColorBlack
End With
Dim Text1 As String
Dim Text2 As String
Dim Text3 As String
Dim Text4 As String
Dim Text5 As String
Text2 = " "
Text3 = " "
Text4 = " "
Text5 = " "
'binary safe... ... ehm... no
Dim M As Long, b() As Byte
b = Text
For M = 0 To UBound(b) Step 2
If (M Mod 10 = 0) Then
Text1 = Text1 & Chr(b(M)) & " "
End If
If (M Mod 10 = 2) Then
Text2 = Text2 & Chr(b(M)) & " "
End If
If (M Mod 10 = 4) Then
Text3 = Text3 & Chr(b(M)) & " "
End If
If (M Mod 10 = 6) Then
Text4 = Text4 & Chr(b(M)) & " "
End If
If (M Mod 10 = 8) Then
Text5 = Text5 & Chr(b(M)) & " "
End If
Next M
Application.ScreenUpdating = True
Line1.TextFrame.TextRange.Text = Text1
Line2.TextFrame.TextRange.Text = Text2
Line3.TextFrame.TextRange.Text = Text3
Line4.TextFrame.TextRange.Text = Text4
Line5.TextFrame.TextRange.Text = Text5
Dim Switch As Integer
Dim TopDistance As Integer
For N = 0 To 36 Step 1
'double rainbow
Application.ScreenUpdating = False
If (TopDistance > 4) Then
Switch = 0
End If
If (TopDistance < 1) Then
Switch = 1
End If
If Switch = 0 Then
TopDistance = TopDistance - 1
Else
TopDistance = TopDistance + 1
End If
'calculations should be optimized
With Line1
.TextFrame.TextRange.InsertBefore " ": .Top = (TopDistance - ((N - 0) Mod 3)) * 5
End With
With Line2
.TextFrame.TextRange.InsertBefore " ": .Top = (TopDistance - ((N - 1) Mod 3)) * 5
End With
With Line3
.TextFrame.TextRange.InsertBefore " ": .Top = (TopDistance - ((N - 2) Mod 3)) * 5
End With
With Line4
.TextFrame.TextRange.InsertBefore " ": .Top = (TopDistance - ((N - 1) Mod 3)) * 5
End With
With Line5
.TextFrame.TextRange.InsertBefore " ": .Top = (TopDistance - ((N - 0) Mod 3)) * 5
End With
'it may look like spaces are in the wrong place if you update the screen during line alterations.
'so do something simple to the screen here
Application.ScreenUpdating = True
Dummy.TextFrame.TextRange.Text = N
DoEvents
'makes it shock less, so it's slower but looks better.
Sleep 50
Next N
Line1.Delete
Line2.Delete
Line3.Delete
Line4.Delete
Line5.Delete
End Sub
Sub InsertAwesomePicture()
'
' Macro1 Macro
'
'
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Dim X As Shape
Set X = ActiveDocument.Shapes.AddPicture(FileName:= _
"C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\awesomespace-pamflet-v2.png", LinkToFile:=False, _
SaveWithDocument:=True)
Dim M As Integer
For M = 0 To 3 Step 1
For N = 0 To 10 Step 1
With X
'this will keep ratio
.LockAnchor = msoTrue: .LockAspectRatio = msoTrue: .Width = X.Width * 0.9: .Rotation = X.Rotation + 5
End With
DoEvents
Next N
For N = 0 To 10 Step 1
With X
'this will keep ratio
.LockAnchor = msoTrue: .LockAspectRatio = msoTrue: .Width = X.Width * 1.1: .Rotation = X.Rotation + 5
End With
DoEvents
Next N
Next M
X.Delete
' full width
'Application.Resize Width:=852, Height:=761
End Sub
Sub RickRoll()
sndPlaySound32 "C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\Never Gonna Give You Up.wav", &H1
Dim X As Shape
Set X = ActiveDocument.Shapes.AddPicture(FileName:= _
"C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\rick.jpg", LinkToFile:=False, _
SaveWithDocument:=True, Height:=505, Width:=447)
With X
.LockAspectRatio = msoTrue:
End With
End Sub
Sub RotatingCube()
Dim X As Shape
'Set X = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 100, 100, 250, 250)
Set X = ActiveDocument.Shapes.AddPicture(FileName:= _
"C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\rick.jpg", LinkToFile:=False, _
SaveWithDocument:=True, Top:=100, Left:=50, Width:=250, Height:=250)
With X
'.TextFrame.TextRange.text = "C": .TextFrame.TextRange.Font.Name = "Invaders": .TextFrame.TextRange.Font.Size = 110: .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter: .TextFrame.TextRange.Font.TextColor = wdColorWhite
.ThreeD.Depth = 250
End With
For N = 0 To 75 Step 1
With X
.ThreeD.IncrementRotationZ 3: .ThreeD.IncrementRotationX 3: .ThreeD.IncrementRotationY 3
End With
DoEvents
Next N
End Sub
Sub Clippy(Text As String)
Dim ClippyImage As Shape
Set ClippyImage = ActiveDocument.Shapes.AddPicture(FileName:="C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\clippy.png", _
LinkToFile:=False, SaveWithDocument:=True, Left:=50, Top:=400)
Dim Balloon As Shape
Set Balloon = ActiveDocument.Shapes.AddShape(msoShapeBalloon, Left:=200, Top:=300, Width:=250, Height:=200)
DoEvents
With Balloon
.TextFrame.TextRange.Text = Text
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = 18
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft
.TextFrame.TextRange.Font.TextColor = wdColorBlack
.Fill.BackColor = wdColorYellow
.Fill.ForeColor = wdColorYellow
.ThreeD.Depth = 250
End With
DoEvents
End Sub
Sub Slide(pictureName As String, Text As String)
Dim SlideImage As Shape
Set SlideImage = ActiveDocument.Shapes.AddPicture(FileName:="C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\" & pictureName & "", _
LinkToFile:=False, SaveWithDocument:=True, Left:=20, Top:=100)
Dim SlideText As Shape
Set SlideText = ActiveDocument.Shapes.AddShape(msoShape10pointStar, Left:=270, Top:=0, Width:=300, Height:=300)
DoEvents
With SlideText
.TextFrame.TextRange.Text = Text
.TextFrame.TextRange.Font.Name = "Emulogic"
.TextFrame.TextRange.Font.Size = 16
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TextFrame.TextRange.Font.TextColor = wdColorWhite
End With
Sleep 2000
SlideText.Delete
SlideImage.Delete
DoEvents
End Sub
Sub AwesomeSpaceSlideShow()
Slide "space_building.png", "AwesomeSpace Utrecht"
Slide "space_certified.jpg", "100% certified!"
Slide "space_ducks.jpg", "Kill MF ducks!"
Slide "space_computers.jpg", "Systems to abuse!"
Slide "space_consoles.jpg", "And so much more!"
Slide "space_toilet.jpg", "We have toilets!"
Slide "space_building.png", "Uniting Communities!"
Sleep 2000
End Sub
' https://msdn.microsoft.com/en-us/library/office/hh965406(v=office.14).aspx
Sub OutlineLogo()
Dim OutlineImage As Shape
Set OutlineImage = ActiveDocument.Shapes.AddPicture(FileName:="C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\outline logo.png", _
LinkToFile:=False, SaveWithDocument:=True, Left:=20, Top:=0, Width:=400, Height:=300)
With OutlineImage
.Fill.PictureEffects.Insert (msoEffectMosiaicBubbles)
.PictureFormat.ColorType = msoPictureBlackAndWhite
End With
'diverse kleurenfilters en shit er overheen halen
DoEvents
Sleep 2000
End Sub
Sub OutlineLogoVariants(effect As MsoPictureEffectType, Text As String)
Dim OutlineImage As Shape
Set OutlineImage = ActiveDocument.Shapes.AddPicture(FileName:="C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\outline logo.png", _
LinkToFile:=False, SaveWithDocument:=True, Left:=20, Top:=0, Width:=400, Height:=300)
With OutlineImage
.Fill.PictureEffects.Insert (effect)
'.PictureFormat.ColorType = msoPictureGrayscale
End With
'diverse kleurenfilters en shit er overheen halen
Dim Taunt As Shape
Set Taunt = ActiveDocument.Shapes.AddShape(msoShapeRectangle, Left:=100, Top:=400, Width:=400, Height:=50)
With Taunt
.TextFrame.TextRange.Text = Text
.TextFrame.TextRange.Font.Name = "Emulogic"
.TextFrame.TextRange.Font.Size = 32
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TextFrame.TextRange.Font.TextColor = RandomColor
End With
DoEvents
End Sub
Sub StartMusic()
sndPlaySound32 "C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\True Survivor - Kung Fury - 8 bit Remix SidTracker64.wav", &H1
End Sub
' need this sometimes :))
Sub StopMusic()
sndPlaySound32 "C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\beep.wav", &H1
End Sub
Sub PageLoops()
gotoPage 20
OutlineLogoVariants msoEffectMosiaicBubbles, "Outline"
gotoPage 21
OutlineLogoVariants msoEffectBlur, "Hyperspeed"
gotoPage 22
OutlineLogoVariants msoEffectCrisscrossEtching, "Insane"
gotoPage 23
OutlineLogoVariants msoEffectSharpenSoften, "FUcking fast"
gotoPage 24
OutlineLogoVariants msoEffectCement, "AMAZING"
gotoPage 25
OutlineLogoVariants msoEffectBackgroundRemoval, "Over 9000"
Dim SleepTime As Integer
SleepTime = 200
For N = 0 To 40 Step 1
gotoPage 20
Sleep SleepTime
gotoPage 21
Sleep SleepTime
gotoPage 22
Sleep SleepTime
gotoPage 23
Sleep SleepTime
gotoPage 24
Sleep SleepTime
gotoPage 25
Sleep SleepTime
DoEvents
' dont make it go negative or word will hang forever :')
If (SleepTime - 10 > 10) Then
SleepTime = SleepTime - 10
End If
Next N
End Sub
Sub awesomeSpaceLogoOutro()
sndPlaySound32 "C:\Users\stitch\Documents\2015 05 AwesomeSpace Invite\smb_stage_clear.wav", &H1
Dim BackgroundSquare As Shape
Set BackgroundSquare = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=115, Top:=50, Width:=400, Height:=400)
BackgroundSquare.Line.Visible = msoFalse
BackgroundSquare.Fill.BackColor.RGB = wdColorBlack
Dim Invader As Shape
Set Invader = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=180, Top:=100, Width:=250, Height:=150)
With Invader
.Line.Visible = msoFalse: .TextFrame.TextRange.Font.Name = "Invaders": .TextFrame.TextRange.Font.Size = 144: .TextFrame.TextRange.Font.TextColor = wdColorWhite: .Rotation = -10: .TextFrame.TextRange.Text = "C"
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
Dim AwesomeSpace As Shape
Set AwesomeSpace = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=250, Width:=500, Height:=360)
With AwesomeSpace
.TextFrame.TextRange.Font.Name = "Emulogic": .TextFrame.TextRange.Font.Size = 42: .TextFrame.TextRange.Font.TextColor = wdColorWhite: .TextFrame.TextRange.Text = "AWESOME " & vbCrLf & "-SPACE-": .Rotation = -10
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter:
.Line.Visible = msoFalse
End With
' line is not always properly removed
AwesomeSpace.Line.Visible = msoFalse
DoEvents
Sleep 1000
BackgroundSquare.Fill.BackColor.RGB = wdColorGray95
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray90
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray85
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray80
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray75
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray70
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray65
Sleep 100
DoEvents
BackgroundSquare.Fill.BackColor.RGB = wdColorGray60
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray55
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray50
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray45
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray40
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray35
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray30
Sleep 100
DoEvents
BackgroundSquare.Fill.BackColor.RGB = wdColorGray25
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray20
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray15
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray10
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorGray05
Sleep 100
BackgroundSquare.Fill.BackColor.RGB = wdColorWhite
Sleep 100
BackgroundSquare.Delete
End Sub