tunnel effect in vb5

hi all.....

similar to my previous thread.....can someone help me with the code that will give the impression of moving down a tunnel (either square or round)

thanks

john

[SteveCRM]

Sorry that I don't have code for you...this may be a little complicated to do (is for me) but, it sounds like you just need a starfield just altered...

[/\/\isanThr0p]

Hi

You mean a cool tunnel effect like the 3D tunnel shipped with the DX sdk?

Or just one like in those old games?

Just making circls getting smaller and smaller?

and make them bigger so it appears to move?
(the second one is very easy!)

hi...well i saw a graphics prog sometime back and it had a big square drawn full screen size.it then drew another one slightly smaller spaced about 5mm and then another...and so on.once the animation was run...its gave an impressive tunnel like effect.

can you help me by starting the code and i,ll finish it off

thanks

john

[/\/\isanThr0p]

I never tried this but it seems very easy to me, I just write some strange code in here, jsut as idea, you can put i to real code

I don't think there is a funciton drawrect, but you know what I mean
x1 =0
x2 =600
y1 =0
y2 =600

do
drawrect x1,y1,x2,y2
x1=x1+2
x2=x2-2
y1=y1+2
y2=y2-2
loop

[PaulLewis]

Here you go. It's slow, ugly and altogether useless I would think...

' on a form with a picturebox, command button, text box and timer controls
Option Explicit
Dim border As Integer
Dim Closing As Boolean
Dim r As Single
Dim colors(15) As Long

Private Sub Command2_Click()
  border = Text1
  Timer1.Enabled = True
End Sub

Private Sub Form_Load()
  border = 10
  Timer1.Enabled = False
  With Picture1
    .AutoRedraw = True
    .DrawWidth = border
    .ScaleMode = 3
    r = .ScaleHeight / .ScaleWidth
  End With
  ' initialise shades of grey
  Dim c As Integer
  colors(0) = RGB(255, 255, 255)
  For c = 1 To 15
    colors(c) = RGB(255 - c * 10, 255 - c * 10, 255 - c * 10)
  Next
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Closing = True
End Sub

Private Sub Timer1_Timer()
  If Closing Then Timer1.Enabled = False
  Dim x As Integer
  Dim y As Integer
  Static c As Long
  Dim myWidth As Integer
  Dim myHeight As Integer
    
  With Picture1
    For x = 0 To .ScaleWidth / 2 Step border
      myWidth = .ScaleWidth - 2 * x
      myHeight = .ScaleHeight - 2 * x * r
      y = r * x
      Picture1.Line (x, y)-(x + myWidth, y + myHeight), colors(c), B
      c = (c + 1) Mod 15
    Next
  End With

End Sub

Regards

[PaulLewis]

It's quite funny maximising the picturebox to fit the screen and trying different widths. At with 4, it looks like you are going out, but 5 it looks like you are going in.

And it makes your eyes go funny if you watch for too long.

I guarantee someone will post you an API or DirectX way of doing it which will be really impressive

Cheers

hi paul.....thanks for the code....there seems to be a problem with the following line " type mismatch error ".
border = text1


john

[PaulLewis]

I was being lazy and relying on the user to enter a valid number there.

You could replace it with

border = cint(text1.text)

It will now give a conversion error if the value is not an integer. For a demo, you can live with it. If you were going to do something serious with it, you would probably check the user input...

Cheers
Paul

hi paul......i seem to be missing something somewhere....on a form i have a textbox,a picturebox,a timer and a command button.i pasted the code into the appropiate areas and still get a " type mismatch " even on that new ode you mailed me.

what am i doing wrong ????

john

[PaulLewis]

I just started a new project, and followed my own instructions but it did not work. Extra steps I needed to do were:

Call the Command Button Command2 (I guess I originally had 2 buttons for testing)

Put an interval of 250 or so in the Timer Control.

After doing this, and running it, I get a type mismatch if I do not change the value of the Text1 text box. If I put 10 in there and press the button, I get the effect.

You may like to try again, and if no go , post here the whole sub or function that is failing.

Regards

[PaulLewis]

Just delete the line that has border=text1. The default border width is 10 anyhow.

Cheers

hiya paul.....got it working 100% now...the timer had no value :-((
now to tear the code apart and disect it....Mmmmmmm

thanks for the help

john

ps...its quite good....needs some smoothe scrolling though.