Help!Efecte text in visual basic for aplication

[amilopro]

Buna tuturor as vrea sa stiu cum rezolv problema de mai jos:

1. S? se realizeze o aplica?ie care s? eviden?ieze cel pu?in 10 efecte pentru text: evantai, deplasare aleatoare (stânga, dreapta, sus, jos), modificare culoare, deplasare fix? (orizontal?, vertical?, oblic?), modificare culoare, font, stil la nivel de liter?, modificare aleatoare chenar etc. Din sec?iunea de configur?ri se va putea selecta frecven?a cu care se va desf??ura anima?ia ?i, de asemenea, efectele care s? fie utilizate (se pot selecta unul sau mai multe efecte compatibile – de exemplu, nu se poate selecta atât deplasarea pe orizontala, cat ?i deplasarea aleatoare).

Cu fontu, culoare de background si text am facut dar nu stiu sa pun efecte la text.Precizez ca textul este continut intr-un label.

Daca ma poate ajuta cineva cu niste efecte din cerinta raman profund recunscator.

Multumesc anticipat!!!

[me.mello]

Ma omule nu stiu ce sa zic....am inteles tot si mai nimic. E .Net sau VB6?

Oricare dintre ele incearca sa gasesti ceva pe forumurile germane....din cate am inteles si ma rog mi s-a confirmat/demonstrat(forumuri,bloguri) cu proiecte/papers unele chiar foarte complexe ca Germanii chiar au adoptat visual basic ca limba si eu am invatat niste chestii pe care nu le stiam si acum imi sunt foarte utile. Am auzit ca si prin scoli se preda aceasta limba mai nou VB .Net. Tot ce zic e ca sigur gasesti ceva pentru tine sau pe cineva sa te ajute.

Ok acum din cate am inteles sa zicem ca ca e Vb6 desi nu iti recomand ca desi e inca alesu multora....e vechi si sacadeaza din mai multe puncte de vedere.

Totusi iti dau un set de functii(defapt intregul modul al proiectului) care sper sa te inspire cat de cat l-am folosit la ultimul meu proiect de grup in vb6: Il folosesc ca Credits poti sa il testezi sa iti faci o parere, atat timp cat nu il caci pe internet. KPD s-ar supara avand in vedere ca multi ati invatat win32 api(VB6) de la ei!!

'wh-team Repository. Be smart. Give us Credits for this.
Option Explicit

Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ByteOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, lpString As Byte, ByVal nCount As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type POINT
  X As Single
  Y As Single
End Type

Private Type Char
  C As Byte
  Target As POINT
  Start As POINT
  Pos As POINT
  m As Single
  v As Single
  Color As Long
  Bold As Boolean
  bReady As Boolean
End Type

Dim Chars() As Char
Dim CharsUB As Long

Dim R As RECT
Dim bQuit As Boolean
Dim bRunning As Boolean

Private Sub Form_Deactivate()
bQuit = True
End Sub

Private Sub Form_Load()
Randomize Timer

GetClientRect Picture1.hwnd, R

'Call InitBackground

Me.Show

Dim Page As Long
Const PagesUB As Long = 2
Page = 0

Call InitText(Page)

Dim C As Long
Dim CharsDone As Long
Dim T As Long
Dim bReverse As Boolean
Dim tmp As POINT

bRunning = True

DoEvents

Sleep 300

Do

  T = timeGetTime

  Picture1.Cls

  For C = 0 To CharsUB
    With Chars(C)
      If .bReady = False Then
        .Pos.X = .Pos.X + .v
        .Pos.Y = .Pos.Y + .v * .m

        If Abs(.Target.X - .Pos.X) < Abs(.v) Then
          .Pos = .Target
          .bReady = True
          CharsDone = CharsDone + 1
        End If

      End If

      Picture1.ForeColor = .Color
      Picture1.FontBold = .Bold
      Picture1.FontUnderline = .Bold

      ByteOut Picture1.hDC, .Pos.X, .Pos.Y, .C, 1

    End With
  Next

  Picture1.Refresh

  Do
    'If GetInputState Then
    DoEvents
  Loop Until timeGetTime - T > 3

  If CharsDone > CharsUB Then 'Fertig
    CharsDone = 0
    If bReverse = False Then
      T = timeGetTime
      Do
        DoEvents
      Loop Until timeGetTime - T > 8000 Or bQuit
      For C = 0 To CharsUB
        With Chars(C)
          tmp = .Target
          .Target = .Start
          .Start = tmp
          .v = -.v
'          .m = (.Start.Y - .Target.Y) / (.Start.X - .Target.X)
          .bReady = False
        End With
      Next
      bReverse = True
    Else
      Page = Page + 1
      If Page > PagesUB Then Page = 0
      Call InitText(Page)
      bReverse = False
    End If
  End If
Loop Until CharsDone > CharsUB Or bQuit
bRunning = False

If bQuit Then Unload Me
End Sub

Private Sub InitText(Page As Long)
Dim T As String

Dim TextRect As RECT
Dim TextW As Long
Dim TextH As Long
Dim Line As Long

Dim Char As Long
Dim C As String

Dim ColorMap() As Long

T = GetText(Page)
ColorMap = GetColorMap()

TextW = Picture1.TextWidth(T)
TextH = Picture1.TextHeight(T)
With TextRect
  .Top = (R.Bottom - TextH) \ 2
  .Left = (R.Right - TextW) \ 2
  .Bottom = R.Top + TextH
  .Right = R.Left + TextW
End With

T = Replace$(T, vbCrLf, vbLf)
CharsUB = Len(Replace$(T, vbLf, "")) - 1
ReDim Chars(0 To CharsUB)

Dim Y As Long
Dim X As Long
Dim W As Long
Dim Color As Long

TextH = Picture1.TextHeight("Q")

X = TextRect.Left
Y = TextRect.Top

For W = 1 To Len(T)
  C = Mid$(T, W, 1)

  If C <> vbLf Then
    With Chars(Char)
      .C = Asc(C)
      .Target.X = X
      .Target.Y = Y

      TextW = Picture1.TextWidth(C)

      Do

        .Start.X = (Rnd * R.Right * 2) - (R.Right \ 2)
        .Start.Y = (Rnd * R.Bottom * 2) - (R.Bottom \ 2)

      Loop Until (.Start.X + TextW < R.Left Or .Start.X > R.Right) And _
                 (.Start.Y + TextH < R.Top Or .Start.Y > R.Bottom)

      .Pos = .Start

      .m = (.Start.Y - .Target.Y) / (.Start.X - .Target.X)

      .v = 5
      If .Start.X > .Target.X Then .v = -.v

      .Color = ColorMap(Line)
      .Bold = Line = 0
    End With
    X = X + TextW
    Char = Char + 1
  Else
    Y = Y + TextH
    X = TextRect.Left

    Line = Line + 1
  End If
Next

End Sub

Private Function GetText(Page As Long) As String
Select Case Page
Case 0
  GetText = "wh-team CallBack Pipe(ACML 6 - Putty Hijack Version,W-Pannel 3.3 Compatible)" & vbCrLf & _
            vbCrLf & _
            "Programming:" & vbCrLf & _
            "iceyjoke" & vbCrLf & _
            "iceyjoke@yahoo.com.au" & vbCrLf & _
            vbCrLf & _
            "Testing:" & vbCrLf & _
            "Arthacker" & vbCrLf & _
            "hi.baidu.com/arthacker" & vbCrLf & _
            vbCrLf & _
            "Phil Kay" & vbCrLf & _
            "@Kay" & vbCrLf & _
            vbCrLf & _
            "Special Thanks To:" & vbCrLf & _
            "ARK(Local-Remote Pipe), KPD-Team,fa5t and others"
Case 1
  GetText = "This is free Software" & vbCrLf & _
            vbCrLf & _
            "You are free to copy and redistribute" & vbCrLf & _
            "it as long as it remains unchanged." & vbCrLf & _
            "(This includes the examples)" & vbCrLf & _
            vbCrLf & _
            "If you want to distribute programs created" & vbCrLf & _
            "with this software, you can do this in any" & vbCrLf & _
            "way you like. PS: Wh-team,Tudou, KPD-team, KDP,Baidu Only!! "

Case 2
  GetText = "Warranty" & vbCrLf & _
            vbCrLf & _
            "This program has been tested and" & vbCrLf & _
            "seems to run stable." & vbCrLf & _
            "However, i can not guarantee that this" & vbCrLf & _
            "Software is bugfree." & vbCrLf & _
            "You use this software of your own risk." & vbCrLf & _
            "This Software is provided ""as it is"" without" & vbCrLf & _
            "any warranty. " & vbCrLf & _
            vbCrLf & _
            "If you have problems or suggestions just" & vbCrLf & _
            "Mail me.mello"


End Select
End Function

Private Function GetColorMap() As Long()
Dim C() As Long
Dim W As Long
ReDim C(0 To 14)
C(0) = &HFF&
For W = 1 To 13
  C(W) = QBColor(W Mod 15)
Next

C(2) = &HC0FF00
C(3) = &HFFFF&
C(6) = &H8080FF
C(7) = &HFF00&
C(8) = &HAA00AA
C(13) = &HAA00AA
GetColorMap = C
End Function


Private Sub Picture1_Click()
bQuit = True
End Sub

Dupa cum ai observat exemplul asta nu tine de label dar altul nu am la indemana si nici nu ma prea am chef de teste pentru unul.Dupa cum tiam zis e nasol in vb6(daca asa ar fi al tau), tot ce trebuie sa stii e win32 api gen Ce ai vazut mai sus,bineinteles oricand poti apela la DirectX....

In .Net sta cu totu altfel problema...e mult mai usor de facut datorita runtime .Net si functiile lui definite(mai putin win api, mai putina bautura respectiv nedormit noaptea;) )

Oricum daca iti place exemplul il poti modifica si daca nu ma insel chiar o sa iti placa , din cate am inteles din ce ai scris mai sus cam asta e asemanator. As fi putut sa folosesc label dar in picturebox poti face mai multe:)

Off: Nu uita ce tiam zis mai sus, eu zic sa cauti ajutor in alta parte pe forumuri dedicate limbii dorite....aici nu cred ca ai sa gasesti mare lucru(forum de securitate IT, Doh!!), si nu spun cu rautate dar am postat si eu o mica problema de parsing in vb .Net http://rstcenter.com/forum/33335-%5Bhelp%5D-vbulletin-net.rst (mda intrebare si ar mai fi raspunsul care tot eu Trebuie sa il dau NU?? , mai degraba stergeti-mi threadu, oricum am rezolvat problema de unu singur, sau puteti sa o mutati la chalenges sau la comice.)

Unii de pe aici chiar bat cu pumnul in piept ca le au in python sau VB. Net , Dar se pare ca raman cu propria cunostinta cand vine vorba de low level text parsing. De REGEX numai zic nimic:))

Tu continua sa incerci cum tiam zis Ai chrome...o sa iti fie usor La noi nu prea gaesti, defapt cam peste toti oamenii is secretosi cand vine vorba de visual basic. In .Net te mai ajuta youtube:d

Daca intradevar

Buna tuturor as vrea sa stiu cum rezolv problema de mai jos:

1. S? se realizeze o aplica?ie care s? eviden?ieze cel pu?in 10 efecte pentru text: evantai, deplasare aleatoare (stânga, dreapta, sus, jos)

Inseamna ca codul de mai sus e de ceva ajutor, ramane sa il imbunatatesti. Uite Aici un mic proiect cu acest cod: GirlShare - Download credits.rar

Sa ai o zi buna, sper ca te-am ajutat...daca vrei sa fii mai specific in ceea ce priveste proiectul tau imi poti lasa un pm.

Edited May 19, 2011 by me.mello