Solved

Better Way For Scrolling Text

Posted on 1998-10-12
4
206 Views
Last Modified: 2010-04-30
I have scrolling text set with a timer which adds previous text viewed to the screen plus adding one character during each timer event.  Unfortunately, the refresh is noticeable in spurts...resulting in a sporatic blinking every so often.  Is there a fix or a better way to gradually display text(scrolling) to a form?
0
Comment
Question by:suellen
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 14

Expert Comment

by:waty
ID: 1439400
Try use the following function :

Add some label to your form.

To see a sample, download :
   http://www.geocities.com/ResearchTriangle/6311/prview50.zip


Option Explicit

' *** TextEfect
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetTextCharacterExtra Lib "gdi32" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long

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

Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Private Const COLOR_BTNFACE = 15

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Private Const DT_BOTTOM = &H8
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_CHARSTREAM = 4          '  Character-stream, PLP
Private Const DT_DISPFILE = 6            '  Display-file
Private Const DT_EXPANDTABS = &H40
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_INTERNAL = &H1000
Private Const DT_LEFT = &H0
Private Const DT_METAFILE = 5            '  Metafile, VDM
Private Const DT_NOCLIP = &H100
Private Const DT_NOPREFIX = &H800
Private Const DT_PLOTTER = 0             '  Vector plotter
Private Const DT_RASCAMERA = 3           '  Raster camera
Private Const DT_RASDISPLAY = 1          '  Raster display
Private Const DT_RASPRINTER = 2          '  Raster printer
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_TABSTop = &H80
Private Const DT_Top = &H0
Private Const DT_VCENTER = &H4
Private Const DT_WORDBREAK = &H10

Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

Public Sub TextEffect(obj As Object, ByVal sText As String, ByVal lX As Long, ByVal lY As Long, Optional ByVal bLoop As Boolean = False, Optional ByVal lStartSpacing As Long = 128, Optional ByVal lEndSpacing As Long = -1, Optional ByVal oColor As OLE_COLOR = vbWindowText)
   ' *** Kerning describes the spacing between characters when a font is written out.
   ' *** By default, fonts have a preset default kerning, but this very easy to modify
   ' *** under the Win32 API.

   ' *** The following (rather unusally named?) API function is all you need:

   ' *** Private Declare Function SetTextCharacterExtra Lib "gdi32" () (ByVal hdc As Long, ByVal nCharExtra As Long) As Long

   ' *** By setting nCharExtra to a negative value, you bring the characters closer together,
   ' *** and by setting to a positive values the characters space out.
   ' *** It works with VB's print methods too.

   Dim lHDC             As Long
   Dim i                As Long
   Dim X                As Long
   Dim lLen             As Long
   Dim hBrush           As Long
   Static tR            As RECT
   Dim iDir             As Long
   Dim bNotFirstTime    As Boolean
   Dim lTime            As Long
   Dim lIter            As Long
   Dim bSlowDown        As Boolean
   Dim lCOlor           As Long
   Dim bDoIt            As Boolean

   lHDC = obj.hdc
   iDir = -1
   i = lStartSpacing
   tR.left = lX: tR.Top = lY: tR.Right = lX: tR.Bottom = lY
   OleTranslateColor oColor, 0, lCOlor

   hBrush = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
   lLen = Len(sText)

   SetTextColor lHDC, lCOlor
   bDoIt = True

   Do While bDoIt
      lTime = timeGetTime
      If (i < -3) And Not (bLoop) And Not (bSlowDown) Then
         bSlowDown = True
         iDir = 1
         lIter = (i + 4)
      End If
      If (i > 128) Then iDir = -1
      If Not (bLoop) And iDir = 1 Then
         If (i = lEndSpacing) Then
            ' STop
            bDoIt = False
         Else
            lIter = lIter - 1
            If (lIter <= 0) Then
               i = i + iDir
               lIter = (i + 4)
            End If
         End If
      Else
         i = i + iDir
      End If

      FillRect lHDC, tR, hBrush
      X = 32 - (i * lLen)
      SetTextCharacterExtra lHDC, i
      DrawText lHDC, sText, lLen, tR, DT_CALCRECT
      tR.Right = tR.Right + 4
      If (tR.Right > obj.ScaleWidth \ Screen.TwipsPerPixelX) Then tR.Right = obj.ScaleWidth \ Screen.TwipsPerPixelX
      DrawText lHDC, sText, lLen, tR, DT_LEFT
      obj.Refresh

      Do
         DoEvents
         If obj.Visible = False Then Exit Sub
      Loop While (timeGetTime - lTime) < 20

   Loop
   DeleteObject hBrush

End Sub

Public Function MakeFlatToolbar(myToolbar As toolbar, Optional isList As Boolean)
   ' *** MakeFlatToolbar
   Dim style      As Long
   Dim hToolbar   As Long
   Dim r          As Long

   hToolbar = FindWindowEx(myToolbar.hwnd, 0&, "ToolbarWindow32", vbNullString)
   style = SendMessageLong(hToolbar, TB_GETSTYLE, 0&, 0&)
   If isList Then
      style = style Or TBSTYLE_FLAT Or TBSTYLE_LIST
   Else
      style = style Or TBSTYLE_FLAT
   End If
   r = SendMessageLong(hToolbar, TB_SETSTYLE, 0, style)
   myToolbar.Refresh

End Function



0
 

Author Comment

by:suellen
ID: 1439401
As much as I was impressed with your demo of text animation, it just doesn't work well with the application I am developing.  Unfortunately, what I want to do with Visual Basic would be a cinch if I were programming an Active Server Page (due to availabiltiy of multi-line marquee controls available for the web).  

I am rejecting the answer due to the fact that my question about the flickering still remains.  
0
 

Accepted Solution

by:
RUSH earned 100 total points
ID: 1439402
I had a similar problem.

Try this:

Instead of refreshing the screen on every character, refresh only after a line or a preset "cache" of characters.
'use an invisible textbox for a temp cache.
'Create 2 textboxes and make one invisible.
form.text1.visible = false
form.text2.visible = true
'set the multiline property to true.
'send all characters to the invisible textbox first
'create a counter to count characters as they are written to the 'invisible textbox.
global incount as integer
'increment the count on every character.
form.text1.seltext = yourcharacter
incount = incount + 1
'display the "cached" characters when enough have passed.
if incount > 10 then
form.text2.seltext = form.text1.text
form.text1.text = " " 'clear the cache.
incount = 0 'reset the counter
end if

This is very simple and overhead is low.
Just by setting the incount to a max of 2 will reduce screen refreshes by 50 %.
Or you can trigger the screen update with a special character such as  "." or "*" or any character you chose:

If form.text1.seltext = "*" then
form.text2.seltext = form.text1.text
form.text1.text = " " 'clear the cache.
'incount = 0 'no counter needed here
end if

I hope this helps.
Rush
0
 

Author Comment

by:suellen
ID: 1439403
Sounds like a great suggestion...I'll give this a try!
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question