Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 328
  • Last Modified:

Drawing an oval and making it smaller with code

I want to create a falling down (or up) tunnel effect.

I want to have a form with about 20 ovals on it .
The first oval starting from the size of a dot, with each of the other ovels getting bigger with the last ovel filling the  screen.

I then want some code under a command button that will make the ovals get smaller until they are just a dot at the center  of the form. I also need create new outer ovals to take the place of each oval that disapears creating a continous falling effect.


I have provided some code that will demonstrate the type of effect I'm after using a shape control

Place two oval shape controls on a form one bigger than the other and put the following code under a command botton

Private Sub Command1_Click()
For x = 1 To 6000
    Shape1.Height = Shape1.Height - 1
    Shape1.Width = Shape1.Width - 1
    Shape2.Height = Shape2.Height - 1
    Shape2.Width = Shape2.Width - 1
 Next x
End Sub
0
backflash
Asked:
backflash
  • 2
  • 2
  • 2
1 Solution
 
craigewensCommented:
This sounds like a fun question to play with, but i really just dont have the time at the moment.
What you might like to investigate with though is the use of control arrays.
Generate your initial shape then copy + paste it. you'll be given the option of creating a control array of that object. You should select yes, you can then use code like this to reduce each object one at a time...

[code]
For x = 1780 To 0 Step -1     'Initial size of my object was 1780
    For y = 0 To 19       ' I have 20 ovals that i wish to reduce within my control array
        Shape1(y).Height = Shape1(y).Height - 1
    Next i
Next x
[/code]

Hope this is of some help.
Craig.
0
 
craigewensCommented:
Small oversight on one of the lines..

For y = 0 To 19

should really be something like

For y = Shape1.LBound To Shape1.UBound


Just makes things a little nicer :)
0
 
jimbobmcgeeCommented:
As craigewans suggests, a control array is the best method.  

Instead of creating 20 Shape objects (Shape1, Shape2, Shape3, etc) create a Shape object (shpOval) and set its Index property to 0.  Now create another Shape object (also called shpOval) and set its Index to 1.  Do the same for 2 to 21 and set them up with the initial sizes that you want.  You should now have 21 Shape objects (shpOval(0), shpOval(1), shpOval(2), etc.)

Now set shpOval(0) to be the biggest shape that you want and set it's Visible property to False (this is your template shape).

Add a command button (btnStartStop) and paste the following code into your Form:

    Private Const gc_nShrink As Long = 10
    Private Const gc_nDelay As Long = 100

    Private g_bIsRunning As Boolean

    Sub TunnelEffectLoop()

        Dim nShape As Long
        Dim nDelay As Long

        Do

            If g_bIsRunning And nDelay = gc_nDelay Then
         
                nDelay = 0

                For nShape = 1 To UBound(shpOval())

                    With shpOval(nShape)

                        If .Height > gc_nShrink And .Width > gc_nShrink Then
                            'SHRINK OVALS BY DESIRED AMOUNT
                            .Height = .Height - gc_nShrink
                            .Width = .Width - gc_nShrink
                            .Top = .Top + (gc_nShrink / 2)
                            .Left = .Left + (gc_nShrink / 2)
                        Else
                            'RESET OVAL TO TEMPLATE SIZE
                            .Height = shpOval(0).Height
                            .Width = shpOval(0).Width
                            .Top = shpOval(0).Top
                            .Left = shpOval(0).Left
                        End If

                    End With

                Next nShape      

            End If

            nDelay = nDelay + 1
            DoEvents               'ALLOW WINDOWS TO PROCESS ANY MESSAGES

        Loop

    End Sub

    Private Sub Form_Load()
        TunnelEffectLoop()     'START EFFECT CHECK
    End Sub

    Private Sub btnStartStop_Click()

        'TOGGLE EFFECT ON/OFF
        If g_bIsRunning Then
            btnStartStop.Caption = "Start"
            g_bIsRunning = False
        Else
            btnStartStop.Caption = "Stop"
            g_bIsRunning = True
        End If

    End Sub

Run the program and click the button.  It should start to cycle and recycle the ovals.  You should also be able to click the button again to stop it.

Fiddle with the values of gc_nDelay and gc_nShrink to affect the speed/magnitude of the effect...

HTH

J.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
jimbobmcgeeCommented:
One small amendment; change the following:

                nDelay = nDelay + 1

to:

                If g_bIsRunning Then nDelay = nDelay + 1

Rgds.

J.
0
 
backflashAuthor Commented:
Sorry about the delay in following up on your answers.

School Hollidays and a computer crash saw me  out of action for a little while. (Dam I wish I was rich)

craigewens I got your  little demo working ok

jimbob I couldn't  get your code to work.
have you  tried it out and had it working?  (not a critisism, it just the I'm not an advanced user Your code looke ok on the serface so perhaps I haven't transferred the code into my program properly)

kind regards

backflash
0
 
backflashAuthor Commented:
Thanks for the help  people

Much appreciated

backflash
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 2
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now