Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
This code snippet will make text on a form scroll ...
Submitted:
7/12/2000
Version:
VB3
Compatibility:
VB3, VB4, VB5, VB6
Category:
Forms
Views:
11338
This code snippet will make text on a form scroll upward.
Declarations:
Option Explicit Private Declare Function BitBlt Lib "gdi32" (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 dwRop As Long) As Long
Code:
'Add a Timer and 2 picture boxes in a control array 'to a form. Private Sub Form_Load() Dim i& Me.AutoRedraw = True Me.ScaleMode = vbPixels Me.Move Left, Top, 3600, 1900 Picture1(0).Move 300, 0, 227, 745 Picture1(1).Move 0, 300, 227, 120 For i = 0 To 1 With Picture1(i) .AutoRedraw = True .ScaleMode = vbPixels .BackColor = vbWhite .BorderStyle = vbEmpty .Visible = False End With Next i DrawMessage 'Draw background Me.FillStyle = vbSolid Me.FillColor = vbYellow Me.DrawWidth = 3 Me.Circle (110, 48), 40, vbBlack Me.ForeColor = &H30C0C0 Me.Font.Name = "arial" Me.Font.Size = 44 Me.Font.Bold = True PSet (80, 8), Me.BackColor Me.Print "@"; Me.AutoRedraw = False Timer1.Interval = 30 End Sub Private Sub DrawMessage() Dim p As PictureBox Dim y&, m$, midline& Set p = Picture1(0) With p midline = .ScaleWidth \ 2 .CurrentY = 128 .Font.Bold = True For y = 0 To 30 If (y Mod 8) = 0 Then p.Print If y = 16 Then .CurrentY = .CurrentY + 40 End If m = RndMsg() .CurrentX = midline - (.TextWidth(m)) \ 2 p.Print m Next .Font.Size = .Font.Size + 8 .Font.Bold = True m = "Some Random Text" y = midline - .TextWidth(m) \ 2 p.PSet (y, 104), .BackColor p.Print m Mid(m, 1, 4) = "More" p.PSet (y, 380), .BackColor p.Print m .Font.Size = .Font.Size + 8 .Font.Bold = True End With Set p = Nothing End Sub Private Function RndMsg() As String Dim i& RndMsg = String((Rnd * 5) * 5 + 4, " ") For i = 1 To Len(RndMsg) If Rnd < 0.8 Then Mid(RndMsg, i, 1) = Chr(Rnd * 25 + 65) Else Mid(RndMsg, i, 1) = Chr(32) End If Next End Function Private Sub Form_Unload(Cancel As Integer) Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Static Scroll& Dim r& Scroll = (Scroll + 1) Mod 630 'Get the backgroud AutoRedraw = True r = BitBlt(Picture1(1).hDC, 0, 0, 227, 120, Me.hDC, 0, 0, vbSrcCopy) 'Add the text r = BitBlt(Picture1(1).hDC, 0, 0, 230, 100, Picture1(0).hDC, 0, Scroll, vbSrcAnd) 'Move to display AutoRedraw = False r = BitBlt(Me.hDC, 0, 0, 227, 120, Picture1(1).hDC, 0, 0, vbSrcCopy) End Sub
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement