Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

creeper

Status
Not open for further replies.

madhatter2002

Programmer
Nov 6, 2002
73
PH
is anybody here familiar in how a creeper works??

for clarity, the creeper that I am talking about is the bottom line of a form or a screen that continuously runs messages from right to left. similar to the bottom part of a news channel.
 
If the only thing you want your program to do is run a ticker, that'd be pretty easy, but I don't think that VFP can create a continuously updating ticker (and do other things too). You could use a timer to run updates to a label control or wait window after particular events.

I haven't tried it myself, but perhaps you could incorporate an OCX control. The link below is to a shareware version, but there's likely a freeware version if you look hard enough.


Brian
 
Start a timer that reads the text of the status bar, removes the first character, and sticks it on the end:

lcText = Set("Message", 1)
lcFirst = Left(lcText, 1)
lcRest = Substr(lcText, 2)
lcText = lcRest + lcFirst
Set Message to lcText

Geoff Franklin
 
I like the link that Ramani posted.

The only problem with the code posted on news2news has
to do with event processing.

If you run the code sample as is, you won't be able to
easily select any of the radio buttons, or move the form while the creeper is running.

I made a few modifications to the code sample that will
give at least some control over event processing.

Look for the line: *** Added to the code example ***
for the additions I've made.

Darrell

Long Example:

[tt]
* Program: Creeper
*** Added to the code example ***
#DEFINE ShowDoEventsTextBox .T. && Set to false to not show the added textbox
#DEFINE DoEventsInterval 5 && count before a DoEvents() will be executed within the CopyToTarget method

PUBLIC oForm

oForm = CREATEOBJECT("Tform")
oForm.VISIBLE = .T.

DEFINE CLASS Tform AS FORM
WIDTH=540
HEIGHT=250
CAPTION=" Scrolling text horizontally"
AUTOCENTER=.T.

SrcLen=3000 && width of the source memory device context
TrgLen=400 && target width
TrgHeight=20 && target height
SrcOffs=0 && initial offset
MSecPerPixel=10 && scroll speed in milliseconds per pixel
LastTickCount=0 && saved ticker value
OffsCollected=0 && collects offset fractions

*** Added to the code example ***
nDoEventsCount=0 && counter to allow events processing

* sample long string to be scrolled
content = "foctx=23.93% thpsx=14.77% nbssx=14.57% " +;
"nbfcx=14.55% nbfax=14.45% hefgx=13.12% " +;
"lmnvx=12.18% gnaax=12.14% lmvfx=12.08% " +;
"lmvtx=11.84% uspix=36.56% uspsx=35.55% " +;
"urpix=32.26% urpsx=31.11% ryurx=19.75% " +;
"ryuax=19.11% brpix=18.17% brpsx=16.89% " +;
"pspsx=15.64% anpax=5.86% urpix=23.25% " +;
"urpsx=22.19% ryurx=16.79% ryuax=16.16% " +;
"hibcx=15.39% brpix=15.28% brpsx=14.20% " +;
"pspsx=11.16% mpgfx=8.92% thpgx=7.66% "

hMemDC=0 && memory device context
hMemBmp=0 && memory bitmap
hForm=0 && window handle for the form
hFormDC=0 && device context for the form

ADD OBJECT lbl1 AS Tlbl WITH LEFT=120, TOP=70, CAPTION="Output:"
ADD OBJECT lbl2 AS Tlbl WITH LEFT=220, TOP=70, CAPTION="Speed:"
ADD OBJECT tm AS TIMER WITH INTERVAL=0
ADD OBJECT ogOutput AS Toutput WITH LEFT=120, TOP=90, VALUE=2
ADD OBJECT ogSpeed AS Tspeed WITH LEFT=220, TOP=90

*** Added to the code example ***
ADD OBJECT txtTickCount AS TEXTBOX WITH ;
TOP = THIS.HEIGHT -24, ;
CONTROLSOURCE = "thisform.nDoEventsCount", ;
VISIBLE = ShowDoEventsTextBox

PROCEDURE INIT
THIS.DECL
THIS.CreateSource
ENDPROC

PROCEDURE DESTROY
= ReleaseDC(THIS.hForm, THIS.hFormDC)
= DeleteObject(THIS.hMemBmp)
= DeleteDC(THIS.hMemDC)
ENDPROC

PROCEDURE ACTIVATE
IF THISFORM.hForm = 0
* window handle and device context for the form
THISFORM.hForm = GetFocus()
THISFORM.hFormDC = GetWindowDC(THISFORM.hForm)
ENDIF
ENDPROC

PROCEDURE tm.TIMER
THISFORM.CopyToTarget
ENDPROC

PROCEDURE ogSpeed.INTERACTIVECHANGE
* changes scroll speed
IF THIS.VALUE = 1
THISFORM.tm.INTERVAL = 0
ELSE
THISFORM.tm.INTERVAL = 10
DO CASE
CASE THIS.VALUE = 2
THISFORM.MSecPerPixel = 50
CASE THIS.VALUE = 3
THISFORM.MSecPerPixel = 20
CASE THIS.VALUE = 4
THISFORM.MSecPerPixel = 10
CASE THIS.VALUE = 5
THISFORM.MSecPerPixel = 7
CASE THIS.VALUE = 6
THISFORM.MSecPerPixel = 3
ENDCASE
ENDIF
ENDPROC

PROCEDURE CreateSource
* creates compatible device context and draws text on it
DECLARE INTEGER GetDesktopWindow IN user32
DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
INTEGER hdc, INTEGER nWidth, INTEGER nHeight

LOCAL hDsk, hDskDC, hBr, RECT
hDsk = GetDesktopWindow()
hDskDC = GetWindowDC(hDsk)

THIS.hMemDC = CreateCompatibleDC(hDskDC)
THIS.hMemBmp = CreateCompatibleBitmap(hDskDC,;
THIS.SrcLen, THIS.TrgHeight)

= DeleteObject(SelectObject(THIS.hMemDC, THIS.hMemBmp))

* background color
hBr = CreateSolidBrush(THISFORM.BACKCOLOR)
RECT = num2dword(0) + num2dword(0) +;
num2dword(THIS.SrcLen) + num2dword(THIS.TrgHeight)
= FillRect(THIS.hMemDC, @RECT, hBr)
= DeleteObject(hBr)

* setting text parameters
= SetBkMode(THIS.hMemDC, 1) && transparent
= SetTextColor(THIS.hMemDC, THISFORM.FORECOLOR)

* default font is used for this device context
* use CreateFont+SelectObject functions to select another font
= TextOut(THIS.hMemDC, 0,0, THIS.content, LEN(THIS.content))
= ReleaseDC(hDsk, hDskDC)
ENDPROC

PROCEDURE CopyToTarget
* copies frames from memory device context to the target
#DEFINE SRCCOPY 0xCC0020

LOCAL hTarget, hTargetDC, x,Y, nTickCount, nDelta, nOffs, nOffsInt

* converting time delta to pixels
nTickCount = GetTickCount()

*** Added to the code example ***
THIS.nDoEventsCount = THIS.nDoEventsCount + 1

IF ShowDoEventsTextBox
THIS.txtTickCount.REFRESH()
ENDIF

IF MOD(THIS.nDoEventsCount,DoEventsInterval)== 0
DOEVENTS()
THIS.nDoEventsCount = 0
ENDIF
*** End of additions to the code example ***

IF THIS.LastTickCount = 0
STORE 0 TO nOffs, THIS.OffsCollected
ELSE
nDelta = nTickCount - THIS.LastTickCount
nOffs = nDelta/THIS.MSecPerPixel
nOffsInt = INT(nOffs)

THIS.OffsCollected = THIS.OffsCollected + nOffsInt - nOffsInt
DO WHILE THIS.OffsCollected > 1
nOffs = nOffs + 1
THIS.OffsCollected = THIS.OffsCollected - 1
ENDDO
ENDIF
THIS.LastTickCount = nTickCount

* calculating offset for the memory device context
THIS.SrcOffs = THIS.SrcOffs + nOffs
IF THIS.SrcOffs + THIS.TrgLen > THIS.SrcLen
THIS.SrcOffs = 0
ENDIF

* the target either main FoxPro window or the form
IF THIS.ogOutput.VALUE = 1
hTarget = GetActiveWindow()
hTargetDC = GetWindowDC(hTarget)
x = 100
Y = 100
ELSE
hTarget = 0
hTargetDC = THISFORM.hFormDC
x = 10
Y = 30
THIS.TrgLen = THISFORM.WIDTH - 10
ENDIF

* the copying of graphics data is here
= BitBlt(hTargetDC, x,Y, THIS.TrgLen, THIS.TrgHeight,;
THIS.hMemDC, THIS.SrcOffs, 0, SRCCOPY)

IF hTarget <> 0
= ReleaseDC(hTarget, hTargetDC)
ENDIF
ENDPROC

PROCEDURE DECL
DECLARE INTEGER GetFocus IN user32
DECLARE INTEGER GetActiveWindow IN user32
DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObj
DECLARE INTEGER GetWindowDC IN user32 INTEGER HWND
DECLARE INTEGER CreateSolidBrush IN gdi32 LONG crColor
DECLARE INTEGER ReleaseDC IN user32 INTEGER HWND, INTEGER hdc
DECLARE INTEGER SetBkColor IN gdi32 INTEGER hdc, LONG crColor
DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc, INTEGER hObj
DECLARE INTEGER SetBkMode IN gdi32 INTEGER hdc, INTEGER iBkMode
DECLARE INTEGER SetTextColor IN gdi32 INTEGER hdc, INTEGER crColor
DECLARE INTEGER GetTickCount IN kernel32

DECLARE INTEGER FillRect IN user32;
INTEGER hDC, STRING @RECT, INTEGER hBrush

DECLARE INTEGER TextOut IN gdi32;
INTEGER hdc, INTEGER x, INTEGER Y,;
STRING lpString, INTEGER nCount

DECLARE INTEGER BitBlt IN gdi32 INTEGER hDestDC,;
INTEGER x, INTEGER Y, INTEGER nWidth, INTEGER nHeight,;
INTEGER hSrcDC, INTEGER xSrc, INTEGER ySrc, INTEGER dwRop
ENDPROC

ENDDEFINE

* Class Tlbl
DEFINE CLASS Tlbl AS LABEL
AUTOSIZE=.T.
BACKSTYLE=0
ENDDEFINE

* Class Toutput
DEFINE CLASS Toutput AS OPTIONGROUP
BUTTONCOUNT=2
AUTOSIZE=.T.
Option1.CAPTION=&quot;Screen&quot;
Option1.TOP=5
Option1.AUTOSIZE=.T.
Option2.CAPTION=&quot;Form&quot;
Option2.TOP=30
Option2.AUTOSIZE=.T.
ENDDEFINE

* Class Tspeed
DEFINE CLASS Tspeed AS OPTIONGROUP
BUTTONCOUNT=6
AUTOSIZE=.T.
Option1.CAPTION=&quot;Stop&quot;
Option2.CAPTION=&quot;Slow&quot;
Option3.CAPTION=&quot;...&quot;
Option4.CAPTION=&quot;Recommended&quot;
Option5.CAPTION=&quot;...&quot;
Option6.CAPTION=&quot;Fast&quot;

PROCEDURE INIT
LOCAL ii, obj, nTop
nTop = 5
FOR ii=1 TO 6
obj = EVAL(&quot;THIS.Option&quot; + LTRIM(STR(ii)))
WITH obj
.TOP=nTop
.AUTOSIZE=.T.
nTop = nTop + 20
ENDWITH
ENDFOR
ENDPROC
ENDDEFINE

* Function Num2DWORD
FUNCTION num2dword (lnValue)
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
LOCAL b0, b1, b2, b3
b3 = INT(lnValue/m2)
b2 = INT((lnValue - b3*m2)/m1)
b1 = INT((lnValue - b3*m2 - b2*m1)/m0)
b0 = MOD(lnValue, m0)
RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)
ENDFUNC
[/tt]
 
Hi Darrel,

I wrote that creeper example (News2News). Testing it on WinXP+Vfp6, Pentium 4, 1.6GHz, 256 MB -- I have absoultely no trouble accessing radio buttons and moving the form while the creeper was running.

Could you provide more details: OS, FoxPro version, CPU clock rate etc. I wonder what could be a reason for that effect you noticed. May be increasing Timer interval to 50 will help too.

Yesterday after noticing this thread I changed the code trying to make it a bit better. Actually you modified already modified :) version.

Regards!

Anatoliy Mogylevets
1361529 Ontario, Inc.
Scarborough, ON, Canada
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top