WYGIWYG Scratch Pad

Sub Macro1()
'
'   Circle with waves.xls
' Macro recorded 2002-11-10 by Gunnar Klevedal
' All you need to add is an X-Y plotting chart
'
For k = 1 To 3
    For X = 0 To 126
    'Dim PauseTime, Start, Finish, TotalTime
    PauseTime = 0.03  ' Set duration.
    Start = Timer   ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
Worksheets("sheet1").Activate
For z = 1 To 200
   z1 = z / 15
   Cells(1, z).Value = Sin(1 * z1)
   Cells(2, z).Value = Cos(1 * z1) + Sin(0.035 * X) * 0.15 * Sin(5 * z1 + 0.3 * X)
Next z
Next X
Next k
End Sub

Sub Macro1()
'
'   Circle with waves.xls
' Macro recorded 2002-11-10 by Gunnar Klevedal
' All you need to add is an X-Y plotting chart
'
For k = 1 To 3
    For X = 0 To 126
    'Dim PauseTime, Start, Finish, TotalTime
    PauseTime = 0.03  ' Set duration.
    Start = Timer   ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
Worksheets("sheet1").Activate
For z = 1 To 200
   z1 = z / 15
   Cells(1, z).Value = Sin(1 * z1)
   Cells(2, z).Value = Cos(1 * z1) + Sin(0.035 * X) * 0.15 * Sin(5 * z1 + 0.3 * X)
Next z
Next X
Next k
End Sub

 

Programming education

For educational purposes I suggest a language with strong type control. You should also be forced to declare all your variables explicitly.

The rules for scope of variables, functions and procedures should be clear. It should also be clear what happens when you pass a variable by reference or by value.

Some languages permit you to put a lot of functionality into one line, but I suggest you be a bit more verbose. Type conversions should be out of bounds the first months. The same goes for variant types.

OOP, Object Oriented Programming, is an option only, and I suggest you leave objects and inheritance et cetera out in the beginning

If your code is not self-documenting, do add comments.

Regards

Gunnar Klevedal

 

Public Sub pendulum()

'************************************

'* Macro created by Gunnar Klevedal           *

'* filename DocVBA01.doc                           *

'************************************

' All you need to create is a scrollbar

 

For x = 1 To 6

 

For y = 0 To 32600 Step 300

ScrollBar1.Value = y

Pausetime = 0.03

Start = Timer

Do While Timer < Start + pausetime

DoEvents

Loop

Next y

 

For y = 32600 To 0 Step -600

ScrollBar1.Value = y

Pausetime = 0.03 + 0.03 * x / 6

Start = Timer

Do While Timer < Start + pausetime

DoEvents

Loop

Next y

 

Next x

End Sub

 

This MS Word macro creates new sentences from old sentences of your choice. You supply the texts. Just paste the macro into your Visual Basic editor, and have fun.

 

Sub Macro2()

'

' Macro created by Gunnar Klevedal

' sentence generator, DocVBA02g.doc

'

Const lines_1 = 7

Dim temp$(lines_1)

temp$(1) = "Mr Benjamin Franklin ;flew a kite ;during a thunderstorm.;"

temp$(2) = "My Volvo 240 ;starts with a roar ;in my garage.;"

temp$(3) = "The Prime Minister ;held an interesting speech ;in the parliament.;"

temp$(4) = "Dr Lissajou ;studied his curves ;in the light of a kerosene lamp.;"

temp$(5) = "My wife ;gave me a passionate kiss ;in the park.;"

temp$(6) = "The janitor ;fixed a leaky faucet ;in our bathroom.;"

temp$(7) = "Donald Duck ;never walked the streets ;in the city of Gothenburg.;"

Dim parse$(lines_1, 3)

For x = 1 To lines_1

   pos1 = 0

   pos2 = 0

   pos3 = 0

   For p = 1 To Len(temp$(x))

     If Mid$(temp$(x), p, 1) = ";" Then

     If pos1 = 0 Then pos1 = p Else

     If (p > pos1) And (pos2 = 0) Then pos2 = p Else

     If (p > pos1) And (p > pos2) And (pos3 = 0) Then pos3 = p

     End If

   Next p

   parse$(x, 1) = Mid$(temp$(x), 1, pos1 - 1)

   parse$(x, 2) = Mid$(temp$(x), pos1 + 1, pos2 - pos1 - 1)

   parse$(x, 3) = Mid$(temp$(x), pos2 + 1, pos3 - pos2 - 1)

Next x

Randomize

Const lines_2 = 20

Dim sentence$(lines_2, 3)

For x = 1 To lines_2

   Do

      For y = 1 To 3

         sentence$(x, y) = parse$(Int(Rnd * lines_1 + 1), y)

      Next y

   Loop Until (sentence$(x, 1) <> sentence$(x - 1, 1)) And _

              (sentence$(x, 2) <> sentence$(x - 1, 2)) And _

              (sentence$(x, 3) <> sentence$(x - 1, 3))

  

   Selection.TypeText Text:= _

      sentence$(x, 1) + sentence$(x, 2) + sentence$(x, 3)

   Selection.TypeParagraph

Next x

End Sub

 

 

NB! Macro code may contain empty lines, but the combination  space-underscore  ( _) cannot be followed by an empty line.

Regards

Gunnar Klevedal

'When you receive a document containing macros, read them through before you enable macros. If they are not from a 'trusted source and you are not shure if they are malware or not, just discard them. Gunnar Klevedal

 

Public Sub colorbox()
'******************************
'* Macro Colorbox             *
'* created by Gunnar Klevedal *
'* December 2005              *
'******************************
Columns.ColumnWidth = 8
Rows.RowHeight = 12
Cells.Interior.colorindex = 0
    seconds = 4
    PauseTime = seconds  ' Set duration.
    Start = Timer   ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
x = 50
Do While x > 2
    x = x * 0.95
    'Dim PauseTime, Start, Finish, TotalTime
    seconds = 0.07
    PauseTime = seconds  ' Set duration.
    Start = Timer   ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop   'Timer
    Columns.ColumnWidth = x / 6.5 'g?r alla rutor lagom breda
    Rows.RowHeight = x
Loop   'While x
    seconds = 2
    PauseTime = seconds  ' Set duration.
    Start = Timer   ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
Cells.Interior.colorindex = 1
Do While 1 = 1
    'Dim PauseTime, Start, Finish, TotalTime
    seconds = 0.07
    PauseTime = seconds  ' Set duration.
    Start = Timer   ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop   'Timer

    Cells(Int(Rnd * 100 + 50), Int(Rnd * 120 + 40)).Interior.colorindex = 36
    Cells(Int(Rnd * 100 + 50), Int(Rnd * 120 + 40)).Interior.colorindex = 37
    Cells(Int(Rnd * 100 + 50), Int(Rnd * 120 + 40)).Interior.colorindex = 38
    Cells(Int(Rnd * 100 + 50), Int(Rnd * 120 + 40)).Interior.colorindex = 1
    Cells(Int(Rnd * 100 + 50), Int(Rnd * 120 + 40)).Interior.colorindex = 1
 Loop   'While 1=1

End Sub

Wonder why those old TurboPascal programs, with delays, began to run too fast on a newer PC? TurboPascal has a good feature, the built-in procedure Delay (milliseconds). However it does not work on P II and faster. All delays become much shorter than you intended. All sounds you invented became distorted.

This Turbo Pascal unit takes care of the problem.

Borland offers Turbo Pascal 5.5 for free, from its home page, museum.

Pascal is a good language for educational purpuses. With its strong Type control and declaration of variables it is easier to avoid many mistakes you can do in other languages.

(*
Unit to test Procedure delayed(). Must be compiled with
Range checking = on, under TP 5.5
repeatability approx 2%
accuracy approx within 25% from 486 33 MHz to P4 1.9 GHz

*)
UNIT GKDELAY;

INTERFACE

USES
   Dos, Crt;

PROCEDURE Delayed (millisec : Word) ;

 

IMPLEMENTATION

Procedure Delayed (millisec : Word) ;
(*   Author : Gunnar Klevedal, Gothenburg, Sweden
     Version : 5.1 , April 11 2002
     Objective: Borland TP55 Procedure Delay() runs
                much too fast on newer PCs.
     Usage : Delayed(0);  must be first line in  main program.
            compiled with Range checking on.
*)

Const firstrun : Boolean = true;
Const arspeed  : Double = 0;
Var
   x, y, z, zx, a1, a2 : Word;
   temp, zy, zz        : Longint;
   hour,min,sec,sec100 : Word;
   time1,time2         : Double;
   ch                  : Char;

   Begin  { delayed }
      If firstrun then begin {first run}
         firstrun := false;
         ClrScr;
         Writeln('Initializing...     This may take a few seconds.');
         Writeln;
         temp := 0;
         x := 100;
         y := 100;
         GetTime(hour,min,sec,sec100);
         time1 := 3600.0 * hour + 60.0 * min + sec + 0.01 * sec100;
         Repeat
            For a1 := 1 to 380 do
               for a2 := 1 to 100 do
                  zx:=x*y + 50*x - 50*x - x*y;
         temp := temp + 1;
         if temp > 2000000000 then begin
            Writeln('Your computer is too fast for this program.');
            Writeln;
            Writeln('Press any key to continue...');
            Repeat until Keypressed;
            While Keypressed do ch := Readkey;
            Halt(1);
         end;
         GetTime(hour,min,sec,sec100);
         time2 := 3600.0 * hour + 60.0 * min + sec + 0.01 * sec100;
         Until (time2 > time1 + 2.0) or (time1 > time2);
         if time1 > time2 then time2 := time2 + 24 * 3600;
         arspeed := temp / (time2 - time1);
         Writeln('Number of cycles = ', temp);
         Writeln('Time for ', temp, ' cycles = ', time2 - time1 :0 :2, ' seconds');
         Writeln('Arithmetic speed = ', arspeed :0 :2);
         Writeln;
         Writeln('Press any key to continue');
         Repeat until Keypressed;
         While Keypressed do ch := Readkey;
         end        {firstrun}
         else begin {next run}
            x:=100;
            y:=100;
            if arspeed > 4.0 then begin
               zz := round(arspeed);
                  for x := 1 to millisec do
                     for zy := 1 to zz do
                        for z := 1 to 43 do
                           temp := x*y + 50*x - 50*x - x*y;
            end
            else
               delay(millisec);  {arspeed <= 4, probably an 80386 CPU}
            end; {if arspeed > 4.0}
      end;  {Delayed}

Begin
end.

 

 

 

(*----------------------------------------------------------------------*)

 

Many people confuse hackers with crackers.

 

In my opinion hacking is a programming method. It is an alternative to Top ? Down and Bottom ? Up programming, You may or may or may not use a flow scheme. It works best for short programs. By trial and error you write some code and test it, write a little more, change a few lines, comment out something, test again. When you are hacking, you might use skeletons and dummies for procedures and functions.

 

Gunnar Klevedal

 

Public Sub ellips()

'******************************

'* Macro ellips               *

'* created by Gunnar Klevedal *

'* December 2005              *

'******************************

 

'Watch the cells shrink to almost nothing.

'Watch the ellips grow gradually.

'Watch the blinking lights in different colors.

 

Columns.ColumnWidth = 8

Rows.RowHeight = 12

Cells.Interior.colorindex = 0

    seconds = 2 '4

    PauseTime = seconds  ' Set duration.

    Start = Timer   ' Set start time.

    Do While Timer < Start + PauseTime

        DoEvents    ' Yield to other processes.

    Loop

   

s = 50

Do While s > 2   ' shrink cells

    s = s * 0.95

    'Dim PauseTime, Start, Finish, TotalTime

    seconds = 0.07

    PauseTime = seconds  ' Set duration.

    Start = Timer   ' Set start time.

    Do While Timer < Start + PauseTime

        DoEvents    ' Yield to other processes.

    Loop   'Timer

    Columns.ColumnWidth = s / 6.5 'g?r alla rutor lagom breda

    Rows.RowHeight = s

Loop   'While s

   

    seconds = 1 '2

    PauseTime = seconds  ' Set duration.

    Start = Timer   ' Set start time.

    Do While Timer < Start + PauseTime

        DoEvents    ' Yield to other processes.

    Loop

Cells.Interior.colorindex = 1  'black color, all cells

Do While 1 = 1   'continue until CTRL + BREAK is pressed

    'Dim PauseTime, Start, Finish, TotalTime

    seconds = 0.05   '0.07

    PauseTime = seconds  ' Set duration.

    Start = Timer   ' Set start time.

    Do While Timer < Start + PauseTime

        DoEvents    ' Yield to other processes.

    Loop   'Timer

   

    x = Int(Rnd * 161 - 80) 'draw an ellips

   

    y1 = -0.8 * Sqr(6400 - x * x)   'upper half

    offset1 = -Int(Rnd * 2) * Int(Rnd * 10)

    color1 = Int(Rnd * 2) * Int(Rnd * 3 + 35) + 1

    Cells(Int(y1 + 101) + offset1, x + 90).Interior.colorindex = color1

   

    y2 = 0.8 * Sqr(6400 - x * x) ' lower half

    offset2 = Int(Rnd * 2) * Int(Rnd * 6)

    color2 = Int(Rnd * 2) + 1   'black or white

    Cells(Int(y2 + 101) + offset2, x + 90).Interior.colorindex = color2

 

 Loop   'While 1=1

 

End Sub   'ellips

 

 

'Gunnar Klevedal

 

Public Sub Sines_2()

'**************************************

'* Macro Created by Gunnar Klevedal   *

'* January 2006                       *

'* Program : Sinewaves with overtones *

'**************************************

' Watch the moving chart. (graph)

' Watch the graph change as time goes by

? Fourier analysis backwards

' All you need to add is a line chart ' with x-axis ranging  -1 to + 1,

 ? (in fact it will become -1.5 to +1.5)

' =Sheet1!$A$51:$GR$54

For t = 1 To 200

Cells(53, t).Value = 0

Next t

'yellow straight line in line chart

   

For X = 1 To 10   'part 1, red line

'Dim PauseTime, Start, Finish, TotalTime PauseTime = 0.3  ' Set duration.  Start = Timer   ' Set start time.

Do While Timer < Start + PauseTime

DoEvents    ' Yield to other processes.

Loop  'timer

For z = 1 To 200

z1 = (z + 0.5 * X) * 1.5 / 15

Cells(52, z).Value = (1 / 10 * X) * _

(0.7 * Sin(z1) + _ 0.5 * Sin(16 * z1))

Next z

Next X

'end part 1,  red line

 

'------------

 

For X = 1 To 130     'part 2,  red line

'Dim PauseTime, Start, Finish, TotalTime PauseTime = 0.1  ' Set duration.  Start = Timer   ' Set start time.

Do While Timer < Start + PauseTime

        DoEvents    ' Yield to other processes.

    Loop   'timer

 

 

For z = 1 To 200

z1 = (z + X) * 1.5 / 15

z7 = 1 / 2500 * (X - 130) * (X - 130) + 1 start1 = (1 + 2 / (1 + X)) total4 = (start1 * z7)

Cells(52, z).Value = 1 * _

(0.7 * Sin(z1) + 0.5 * _

Cos(0.4 * z1) * _

Sin(total4 * z1))

Next z

  

Next X

' End part 2, red in line chart

 

'NB  empty lines are ok in the code

'but the combination "space+underscore"

'" _" must not be followed by empty line

End Sub

 

 

Public Sub Blobs()

'******************************

'* Macro Blobs                *

'* created by Gunnar Klevedal *

'* January 2006               *

'******************************

'Watch the colors

'Watch the blobs grow

'Watch the blobs fight for space

'If you feel unsure - use 'Option Explicit'!

'Use  CTRL + BREAK to stop any macro

'that is running.

'

 Randomize

    Columns.ColumnWidth = 0.35    'small cells

    Rows.RowHeight = 3            'small cells

    Cells.Interior.colorindex = 1 'black background

    fargOffset = 12 + Int(Rnd * 5)

    'do not use same colors all the time

   For p = 1 To 17 '9        'number of blobs

     x = Int(Rnd * 170 + 10) 'resolution 800 x 600!

     y = Int(Rnd * 90 + 5)   'resolution 800 x 600!

     farg = Int(Rnd * 5) + fargOffset

     For j = 0 To 3 '4    'make initial blobs smaller

       For k = 0 To 3 '4  'make initial blobs smaller

        Cells(y + j, x + k).Interior.colorindex = farg

       Next k

     Next j

   Next p

  

  Do While 1 = 1     'do not worry

    For p = 1 To 1000  ' 100 'speed it up a little

     x = Int(Rnd * 174 + 10) 'resolution 800 x 600!

     y = Int(Rnd * 94 + 5)   'resolution 800 x 600!

     farg = Cells(y, x).Interior.colorindex

     If farg <> 1 Then       'anything but black

       Cells(y + 1, x).Interior.colorindex = farg

       Cells(y - 1, x).Interior.colorindex = farg

       Cells(y, x + 1).Interior.colorindex = farg

       Cells(y, x - 1).Interior.colorindex = farg

      End If

     Next p

    seconds = 0.1  '0.05   'wait a moment, yield

    PauseTime = seconds    'Set duration.

    Start = Timer          'Set start time.

    Do While Timer < Start + PauseTime

        DoEvents    ' Yield to other processes.

    Loop  'timer

  Loop    'wile 1=1

End Sub   'Blobs

Hi

During two hours, when my PC was doing nothing, i noted some curious outbond traffic. I had no apps rruning, xcept for AV, Firewall and MS Update. These IPs do not resolve correctly, so i had to use 'all who is'

I guess that not all of them are legitimate

 

\Local support

 

208.175.160.126    OrgAbuseEmail: abuse@savvis.net

213.155.195.95     abuse@telvia.it      

62.189.244.254     abuse@uk.uu.net

239.255.255.250    OrgAbuseEmail: abuse@iana.org

213.155.151.176    e-mail: ip-admin@akamai.com

213.155.151.184    ip-admin@akamai.com

64.4.23.190        abuse@microsoft.com and abuse@msn.com

65.55.192.61       abuse@hotmail.com , abuse@microsoft.com

 

Something unexpected happened. See the comment instead

 

 

 

Public Sub Sines_2() '************************************** '* Macro Created by Gunnar Klevedal   * '* January 2006                       * '* Program : Sinewaves with overtones * '************************************** ' Watch the mowing chart. ' Watch the graph change as time goes by ' All you need to add is a line chart ' with x-axis ranging  -1 to + 1, ' =Sheet1!$A$51:$GR$54For t = 1 To 200    Cells(53, t).Value = 0 Next t 'yellow straight line in line chart    For X = 1 To 10   'part 1, red line    'Dim PauseTime, Start, Finish, TotalTime     PauseTime = 0.3  ' Set duration.     Start = Timer   ' Set start time.     Do While Timer < Start + PauseTime         DoEvents    ' Yield to other processes.     Loop  'timer        For z = 1 To 200       z1 = (z + 0.5 * X) * 1.5 / 15       Cells(52, z).Value = (1 / 10 * X) * _                          (0.7 * Sin(z1) + _                           0.5 * Sin(16 * z1))    Next z Next X 'end part 1,  red line

'------------

For X = 1 To 130     'part 2,  red line

    'Dim PauseTime, Start, Finish, TotalTime     PauseTime = 0.1  ' Set duration.     Start = Timer   ' Set start time.     Do While Timer < Start + PauseTime         DoEvents    ' Yield to other processes.     Loop   'timer    For z = 1 To 200      z1 = (z + X) * 1.5 / 15      z7 = 1 / 2500 * (X - 130) * (X - 130) + 1      start1 = (1 + 2 / (1 + X))      total4 = (start1 * z7)         Cells(52, z).Value = 1 * _      (0.7 * Sin(z1) + 0.5 * _      Cos(0.4 * z1) * _      Sin(total4 * z1))    Next z    Next X ' End part 2, red in line chart'NB  empty lines are ok in the code 'but the combination "space+underscore" '" _" must not be followed by empty line End Sub

 

 

Public Sub halva02b()
'******************************
'* Excel Macro Staples        *
'* Created by Gunnar Klevedal *
'* February 2006              *
'******************************

Columns.ColumnWidth = 0.7     'small cells
Rows.RowHeight = 6            'small cells
Cells.Interior.ColorIndex = 1 'black background

bottom = 50  'bottom line
Randomize
farg = 2 + Int(Rnd * 6)   'color
For p = 1 To bottom
r1 = Rnd
If r1 <= 0.4 Then n = 1 Else n = farg
If n = 1 Then farg = 2 + Int(Rnd * 6)
Cells(p, 1).Value = n
Start = 10
Cells(p, 2) = Start
MaxLength = Start + Int(Rnd * 80) + 10
Cells(p, 3) = MaxLength
Position = Start
Cells(p, 4) = Position
Slope = 1
Cells(p, 5) = Slope
delay = Round(4 - MaxLength / 23)
Cells(p, 6) = delay
clock = delay
Cells(p, 7) = clock
Next p

'--------
Do While 1 = 1
For p = 1 To bottom
farg = Cells(p, 1)
If farg > 1 Then
delay = Cells(p, 6)
clock = Cells(p, 7)
clock = clock - 1
Cells(p, 7) = clock
If clock < 0 Then
   clock = delay
   Cells(p, 7) = clock
   Start = Cells(p, 2)
   Position = Cells(p, 4)
   Slope = Cells(p, 5)
   If Slope < 1 Then farg = 1 Else farg = Cells(p, 1)
   Cells(p, Position).Interior.ColorIndex = farg
   MaxLength = Cells(p, 3)
   Position = Position + Slope
   If Position = Start Then Slope = Slope * -1
   If Position = MaxLength Then Slope = Slope * -1
   Cells(p, 5) = Slope
   Cells(p, 4) = Position
End If
End If
'----------------------
   If Rnd < 0.2 Then
   seconds = 0.01 '0.05   'wait a moment, yield
    PauseTime = seconds    'Set duration.
    Start = Timer          'Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop  'timer
    End If
    Next p
  Loop    'while 1=1
End Sub