Grafitti Effect

[AttnSue]

I recently saw a program written in VB that had a very nice looking, Grafitti type effect, for a background.

This seems like the appropriate forum section to ask if anyone knows how to do that?

[Hack]

'in a module
Public Sub Grafitti(MyForm As Form)
    Dim x As Integer
    Dim Colo As Integer
    Dim x1 As Integer
    Dim x2 As Integer
    Dim y1 As Integer
    Dim y2 As Integer
    If MyForm.WindowState = vbMinimized Then Exit Sub
    MyForm.BackColor = vbBlack
    MyForm.ScaleHeight = 100
    MyForm.ScaleWidth = 100
    For x = 0 To 300
        DoEvents
        x1 = Int(Rnd * 101)
        x2 = Int(Rnd * 101)
        y1 = Int(Rnd * 101)
        y2 = Int(Rnd * 101)
        Colo = Int(Rnd * 15)
        MyForm.Line (x1, y1)-(x2, y2), QBColor(Colo)
        MyForm.Line (x1, y2)-(x2, y1), QBColor(Colo)
        MyForm.Line (x2, y1)-(x1, y2), QBColor(Colo)
        MyForm.Line (y1, y2)-(x1, x2), QBColor(Colo)
    Next x
End Sub
 
'on your form
Private Sub Form_Resize()
Grafitti Me
End Sub

[AttnSue]

VERY COOL!!! I like it a lot!!!

Fickle huh?

(Yes, I saw your comment to Edneeis on the question I posted yesterday! )

[Hack]

[AttnSue]

indeed

If you haven't tried what Hack posted, give it a shot. Its pretty cool.

Any other ideas?

[Hack]

Just doing that routine taxed all of my graphic capability for a long time to come, but, how about animating the form's caption?

[AttnSue]

I'm not sure what you mean by "animating the form's caption", so, sure.....whatchya got?

[Sastraxi]

The FlashWindow API, I believe. After you declare it, you give it some parameters, and your form's handle, and the title bar blinks. Other than that you could change your title based on a timer or a loop...

[Hack]

Try this for your form's caption. I've finished playing around with it, and I kinda like the effect

Private Sub AnimateCaption(MyCaption As String, MyForm As Form)
    Dim AddTitle As String
    Dim Title As Long
    MyForm.Show
    MyForm.Caption = ""
    AddTitle = MyCaption
    For Title = 1 To Len(AddTitle)
        ZoomLetter MyForm, Mid$(AddTitle, Title, 1), MyForm.Caption
    Next
End Sub
 
Private Sub ZoomLetter(MyForm As Form, NewLetter As String, OldCaption As String)
    'Used By AnimateCaption
    Dim Total As Integer
    Dim Spaces As Integer
    Dim Temp As String
    Dim i As Integer
    Total = Len(Temp)
    Spaces = (MyForm.Width / 50) - (Total)
    For i = Spaces To Len(Temp) Step -1
        MyForm.Caption = OldCaption & Space(i) & NewLetter
        DoEvents
    Next
End Sub
 
Private Sub Form_Load()
AnimateCaption "Hows life in the world of litigation AttnSue?", Me
End Sub

[Zaei]

Here is a little modification to the animated caption:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub AnimateCaption(MyCaption As String, MyForm As Form)
    Dim AddTitle As String
    Dim Title As Long
    MyForm.Show
    MyForm.Caption = ""
    AddTitle = MyCaption
    For Title = 1 To Len(AddTitle)
        ZoomLetter MyForm, Mid$(AddTitle, Title, 1), MyForm.Caption
    Next
End Sub

Private Sub ZoomLetter(MyForm As Form, NewLetter As String, OldCaption As String)
    'Used By AnimateCaption
    Dim Total As Integer
    Dim Spaces As Integer
    Dim Temp As String
    Dim i As Integer
    If NewLetter = " " Then
        MyForm.Caption = MyForm.Caption & " "
        Exit Sub
    End If
    Total = Len(Temp)
    Spaces = (MyForm.Width / 50) - (Total)
    For i = Spaces To Len(Temp) Step -1
        MyForm.Caption = OldCaption & Space(i) & NewLetter
        DoEvents
        Sleep (5)
    Next
End Sub

Private Sub Form_Load()
AnimateCaption "Hows life in the world of litigation AttnSue?", Me
End Sub

It simply adds a small pause to each step, which makes the animation smoother.

Z.

[Hack]

I like it Zaei!!!

[AttnSue]

So do I Zaei. Nice job!

Anyone else have a cool form effects?

[Sastraxi]

How about playing some groovy music with the windows media control?

[AttnSue]

I don't think music, "groovy" or otherwise would go over well in an Lawyers office, but thanks for the suggestion.

I was more looking for visual effects, rather than auditory.

[SLH]

Perhaps you could incorperate this.

[AttnSue]

Thanks SLH. I will definately check it out!

[Hack]

Me too!

[SLH]

Would be easy to convert so it was on a form as well, just change the object the pixels were drawn on, and a few max/min values and you're set.

[AttnSue]

SLH: There is some very cool affects in your program, but how can I use it in mine. All your zip file contained was the .Exe

Is this copywritten code?

[SLH]

Sorry, i created the zip file a while ago, forgot it was just the exe.....

[SLH]

There u go!

[SLH]

Figureing out where to draw the pixels is in the case statement: select case list1.listindex.

The rest is for the trails, colours and user interface.

[Hack]

Thanks!!! Nice job!!

[Hack]

Try this one out

Private Sub HorizGradient(MyForm As Form, rs As Integer, gs As Integer, bs As Integer, re As Integer, ge As Integer, be As Integer, smooth As Boolean)
    Dim ri As Integer
    Dim gi As Integer
    Dim bi As Integer
    Dim rc As Integer
    Dim bc As Integer
    Dim gc As Integer
    Dim x As Integer
    If MyForm.WindowState = vbMinimized Then Exit Sub
    MyForm.BackColor = RGB(re, ge, be)
    If smooth = True Then
        MyForm.DrawStyle = 6
    Else
        MyForm.DrawStyle = 0
    End If
    If MyForm.ScaleWidth <> 255 Then
        MyForm.ScaleWidth = 255
    End If
    If MyForm.ScaleHeight <> 255 Then
        MyForm.ScaleHeight = 255
    End If
    MyForm.DrawWidth = 5
    MyForm.Refresh
    ri = (rs - re) / 255
    gi = (gs - ge) / 255
    bi = (bs - be) / 255
    rc = rs: bc = bs: gc = gs
    For x = 0 To 255
        MyForm.Line (x, 0)-(x, MyForm.ScaleHeight), RGB(rc, gc, bc)
        rc = rc - ri
        gc = gc - gi
        bc = bc - bi
    Next x
End Sub
 
Private Sub Form_Resize()
HorizGradient Form1, 111, 111, 222, 222, 255, 255, True
'or someother form of number combination
End Sub

[SLH]

Nice

[SLH]

Try this

Option Explicit
Dim i As Integer
Dim j As Integer
Private Sub Form_Resize()
    Cls
    Call CurveForm(Me, vbBlack, 10)
End Sub
Private Sub CurveForm(Frm As Form, Colour As Long, Inc As Integer)
    For i = 0 To 1000 Step Inc
        Line (0, Frm.ScaleHeight / 1000 * i)-(Frm.ScaleWidth - (Frm.ScaleWidth / 1000 * i), 0), Colour
        
        Line (Frm.ScaleWidth, Frm.ScaleHeight / 1000 * i)-(Frm.ScaleWidth - (Frm.ScaleWidth / 1000 * i), Frm.ScaleHeight), Colour
        
        Line (0, Frm.ScaleHeight - (Frm.ScaleHeight / 1000 * i))-(Frm.ScaleWidth - (Frm.ScaleWidth / 1000 * i), Frm.ScaleHeight), Colour
        
        Line (Frm.ScaleWidth, Frm.ScaleHeight - (Frm.ScaleHeight / 1000 * i))-(Frm.ScaleWidth - (Frm.ScaleWidth / 1000 * i), 0), Colour
    Next i
End Sub

[Hack]

Private Const AW_HOR_POSITIVE = &H1 'Animates the window from left to right. This flag can be used with roll or slide animation.
Private Const AW_HOR_NEGATIVE = &H2 'Animates the window from right to left. This flag can be used with roll or slide animation.
Private Const AW_VER_POSITIVE = &H4 'Animates the window from top to bottom. This flag can be used with roll or slide animation.
Private Const AW_VER_NEGATIVE = &H8 'Animates the window from bottom to top. This flag can be used with roll or slide animation.
Private Const AW_CENTER = &H10 'Makes the window appear to collapse inward if AW_HIDE is used or expand outward if the AW_HIDE is not used.
Private Const AW_HIDE = &H10000 'Hides the window. By default, the window is shown.
Private Const AW_ACTIVATE = &H20000 'Activates the window.
Private Const AW_SLIDE = &H40000 'Uses slide animation. By default, roll animation is used.
Private Const AW_BLEND = &H80000 'Uses a fade effect. This flag can be used only if hwnd is a top-level window.
 
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
 
Private Sub Form_Unload(Cancel As Integer)
    'Animate the window
    AnimateWindow Me.hwnd, 1000, AW_VER_POSITIVE Or AW_HOR_NEGATIVE Or AW_HIDE
    'Unload our form completely
    Set Form1 = Nothing
End Sub

[AttnSue]

It appears that SLH and Hack have been having some fun.

Thanks guys. I can't wait to try all these new things out!!!!!

Thanks a lot!!

[SLH]

I thought you might like this fade effect (I think it only works with windows with NT (2000,XP...)

Just so people searching may find this (it's usefull).

It fades the form, using alphablending, with the form and the background (what's behind the form).

[Hack]

You are probably correct on what platforms it works on. I just tried on my Win98 box, and the form just unloaded. Nothing else happened.

I'll try on my WinNT4 box at home tonight and let you know if it works there.

[Zaei]

Nice Fader, though WAYYY to slow. Visual effects should be pretty, but they shouldnt be a pain =).

Z.

[Hack]

It works on NT4.

Good job SLH!!

[Oafo]

How bout some snow?

Dim Flake(500) As Coord
 
Private Type Coord
    X As Integer
    Y As Integer
End Type
 
Private Sub Snow(Speed As Integer, Variation As Integer, Length As Integer)
    Dim i&
    For i& = 0 To 500
        Flake(i&).X = Int(Rnd * Me.ScaleWidth)
        Flake(i&).Y = -Int(Rnd * Length%)
    Next i
    
    Do
        DoEvents
        
        Dim dir%
        Me.Refresh
        For i& = 0 To 500
            Randomize
            dir% = Int(Rnd * 3)
            
            If dir% = 1 Then
                Flake(i&).X = Flake(i&).X + Variation%
            ElseIf dir% = 2 Then
                Flake(i&).X = Flake(i&).X - Variation%
            End If
            
            Flake(i&).Y = Flake(i&).Y + Sqr(Speed)
            Me.PSet (Flake(i&).X, Flake(i&).Y), vbWhite
        Next i
    Loop
End Sub
 
Private Sub Form_Load()
    Me.ScaleMode = vbPixels
    Me.BackColor = vbBlack
    Me.Show
    Snow 5, 1, 500
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

It doesn't fade all that well in and out but just play with it.

[SLH]

Nice

[SLH]

How about this nice effect..

[Fox]

Takes too much time.. would probably be OK if you slide-in all together...