Worms!

Printable View

Oct 27th, 2003, 11:47 AM
DiGiTaIErRoR

1 Attachment(s)

Worms!

worms
Oct 27th, 2003, 12:15 PM
si_the_geek

:confused: virus?
Oct 27th, 2003, 12:51 PM
DiGiTaIErRoR

Quote:

Originally posted by si_the_geek
:confused: virus?

Definately not a virus.

It doesn't self-replicate.

:lol:
Oct 27th, 2003, 07:04 PM
Acidic

What does it do then? I would like to know that before I run it.
Oct 27th, 2003, 08:23 PM
DiGiTaIErRoR

It's a visualisation.

Two roundrects with AlphaBlending to black.

Trippy effect to say the least.
Oct 27th, 2003, 08:58 PM
jemidiah

That is trippy. I'd love to see that source code :)
Oct 28th, 2003, 05:20 AM
Acidic

Wow, Thats nice. It almost looks as if I'm doing something scientific when I run that. Though when they start taking up a lot of screen space, it gets a bit.... whats the word..
boring i think will have to do.
Oct 28th, 2003, 06:28 AM
NotLKH

1 Attachment(s)

Very Funny.
I tried running it from the zip, and the first time all I saw was a blank window, the size of my screen.

The second time I tried running it from the zip, it told me that c:\windows\temp\worm2.exe was in use, in essence couldn't be overwritten.

So..., going there, I can't delete it.

http://www.vbforums.com/attachment.p...postid=1547134

Whats next? My hard drive wiped?
Whatcha do?
How do I cleanse my system?

-Lou
Oct 28th, 2003, 06:32 AM
Acidic

Strange, I did the same thing and it worked. I'll try again...

... Yep, still works straight from the .zip
Oct 28th, 2003, 06:57 AM
NotLKH

There we go. Got it deleted.
Still, running it gives me a temporary, fleeting glimpse of a screen shot with two ovals placed, then it instantly becomes a black window.
Oct 28th, 2003, 09:39 AM
DiGiTaIErRoR

Quote:

Originally posted by NotLKH
There we go. Got it deleted.
Still, running it gives me a temporary, fleeting glimpse of a screen shot with two ovals placed, then it instantly becomes a black window.

Try making the window smaller.

The AlphaBlend can be slow on some systems.

VB Code:

Option Explicit
 
Private Type tLoc
    x As Double
    y As Double
    Vx As Double
    Vy As Double
End Type
 
Private p(5) As tLoc
 
Private Cnt As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Sub Form_Activate()
Dim t As Long, x As Integer, pCnt As Integer
Dim c(2) As Single
Randomize
t = GetTickCount
pCnt = UBound(p)
For x = 0 To pCnt
p(x).x = ScaleWidth * Rnd
p(x).y = ScaleHeight * Rnd
p(x).Vx = 1 * Rnd
p(x).Vy = 1 * Rnd
Next
 
Do
For x = 0 To pCnt
p(x).x = p(x).x + p(x).Vx
p(x).y = p(x).y + p(x).Vy
If p(x).x < 0 Then p(x).x = 0: p(x).Vx = Abs(p(x).Vx)
If p(x).y < 0 Then p(x).y = 0: p(x).Vy = Abs(p(x).Vy)
If p(x).x > ScaleWidth Then p(x).x = ScaleWidth: p(x).Vx = -Abs(p(x).Vx)
If p(x).y > ScaleHeight Then p(x).y = ScaleHeight: p(x).Vy = -Abs(p(x).Vy)
p(x).Vx = p(x).Vx + (Rnd - Rnd) / 100
p(x).Vy = p(x).Vy + (Rnd - Rnd) / 100
 
If p(x).Vx < -1 Then p(x).Vx = 2 * Rnd - 1
If p(x).Vy < -1 Then p(x).Vy = 2 * Rnd - 1
If p(x).Vx > 1 Then p(x).Vx = 2 * Rnd - 1
If p(x).Vy > 1 Then p(x).Vy = 2 * Rnd - 1
Next
 
For x = 0 To 2
 c(x) = c(x) + Rnd * 2 - Rnd * 2
 If c(x) < 0 Then c(x) = 0
 If c(x) > 255 Then c(x) = 255
Next
 
ForeColor = RGB(c(0), c(1), c(2))
RoundRect hdc, p(0).x, p(0).y, p(1).x, p(1).y, p(2).x, p(2).y
ForeColor = RGB(c(2), c(1), c(0))
RoundRect hdc, p(3).x, p(3).y, p(4).x, p(4).y, p(5).x, p(5).y
Cnt = Cnt + 1
If (Cnt Mod 8) = 0 Then
'Caption = Cnt / ((GetTickCount - t + 1) / 1000)
AlphaBlend hdc, 0, 0, ScaleWidth, ScaleHeight, Picture1.hdc, 0, 0, ScaleWidth, ScaleHeight, &H10000
'Refresh
DoEvents
End If
Loop
End Sub
 
 
Private Sub Form_Resize()
Picture1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
End 'Muwhahahahahahahahahahahahahaha!
End Sub

Oct 28th, 2003, 10:23 AM
NotLKH

hdc isn't dimmed, nor does it have a value assigned to it? {Amazingly, Option Explicit isn't complaining!}

Unless RoundRect initializes it.

Anyways, I compiled it and ran it on my work PC.
Its a nice, blank form, just sitting on my screen, ohh about 2x3 inches.

The Picture box is framed by the form window.

Thats about it.

Oh. Its a nice shade of default grey.

Is there anything that needs to be assigned to the form or picture1 props?

;)
Oct 28th, 2003, 11:27 AM
DiGiTaIErRoR

Quote:

Originally posted by NotLKH
hdc isn't dimmed, nor does it have a value assigned to it? {Amazingly, Option Explicit isn't complaining!}

Unless RoundRect initializes it.

Anyways, I compiled it and ran it on my work PC.
Its a nice, blank form, just sitting on my screen, ohh about 2x3 inches.

The Picture box is framed by the form window.

Thats about it.

Oh. Its a nice shade of default grey.

Is there anything that needs to be assigned to the form or picture1 props?

;)

You don't program eh?

hdc is a property of the Form.

Picture1 should have auto redraw set to true.
Oct 28th, 2003, 01:39 PM
NotLKH

hdc is also a property of a picturebox, so a hanging hdc, unatached to any parent control or form, is ambiguous, and imho NGCP.

I always use the Parent Controls name when using properties.
Outside of a with, I never do it any other way.

-Lou
Oct 28th, 2003, 08:50 PM
DiGiTaIErRoR
Quote:

Originally posted by NotLKH
hdc is also a property of a picturebox, so a hanging hdc, unatached to any parent control or form, is ambiguous, and imho NGCP.

I always use the Parent Controls name when using properties.
Outside of a with, I never do it any other way.

-Lou

Not attached?

It's in Private Sub Form_Activate()!

A with still needs a . before the call.

For example:
VB Code:
```
Private Sub Picture1_Click()
With Picture1
MsgBox hDC & " " & .hDC
End With
End Sub
```
I don't see how it's ambiguous, unless you can't read BASIC. :p
Oct 29th, 2003, 04:54 AM
si_the_geek

I think it's ambiguous too, and I can certianly read basic.

I also don't like your lack of indentation, and (understandable) lack of comments. I'm not impressed with the use of End either - a simple boolean removes the need for it. ;)

anyway, the biggest issue is the fact that nothing seems to happen (as with NotLKH) :p

after a lot of fiddling (such as setting the scalemode to pixels, and changing the code to draw on the picturebox) I managed to get a few circles.. wow! so pretty :D

(I think AlphaBlend doesn't work on Win 2000 ;) )
Oct 29th, 2003, 07:36 AM
Acidic

Quote:

(I think AlphaBlend doesn't work on Win 2000)

That might very well be the case ( I had heard it only works on XP), but it would seem wierd that it works on me Win98 SE.
Oct 29th, 2003, 07:45 AM
si_the_geek

I see.. it makes sense that Win2000 doesn't have features that Win95/98 and WinXP have - as 2000 is based on NT, and XP combines features of NT and 95/98.
Oct 29th, 2003, 07:54 AM
Acidic

oh, ok, thanks for the explanation.

Nope. Alphablend does work on Win2000.

Just tried this AllApi code.
Works just fine:

VB Code:

Const AC_SRC_OVER = &H0
Private Type BLENDFUNCTION
  BlendOp As Byte
  BlendFlags As Byte
  SourceConstantAlpha As Byte
  AlphaFormat As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    Dim BF As BLENDFUNCTION, lBF As Long
    'Set the graphics mode to persistent
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = True
    'API uses pixels
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
    'set the parameters
    With BF
        .BlendOp = AC_SRC_OVER
        .BlendFlags = 0
        .SourceConstantAlpha = 128
        .AlphaFormat = 0
    End With
    'copy the BLENDFUNCTION-structure to a Long
    RtlMoveMemory lBF, BF, 4
    'AlphaBlend the picture from Picture1 over the picture of Picture2
    AlphaBlend Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lBF
End Sub

-Lou

Oct 29th, 2003, 05:13 PM
DiGiTaIErRoR

Quote:

Originally posted by si_the_geek
I think it's ambiguous too, and I can certianly read basic.

I also don't like your lack of indentation, and (understandable) lack of comments. I'm not impressed with the use of End either - a simple boolean removes the need for it. ;)

anyway, the biggest issue is the fact that nothing seems to happen (as with NotLKH) :p

after a lot of fiddling (such as setting the scalemode to pixels, and changing the code to draw on the picturebox) I managed to get a few circles.. wow! so pretty :D

(I think AlphaBlend doesn't work on Win 2000 ;) )

I didn't really care about the code's indention. It's pretty damn simple(I was asked for the source).

You people are just anal retentive. :p