Scrolling banner 1

[Pierre1966]

Dears,

I would like to create an app that has only a banner (scrolling banner like the one on the TV that shows short news) that will show invoices list and total invoices made today.... and if I click on one, it would display the invoice.
Any idea how to design this ? I know how to retrieve the invoices to display, I also know how to get the text to display... but I have no clue how to design the banner in a nice way...
Any idea ?

Thanks

 

[Mike Lewis]

Hello Pierre, and welcome to the forum.

Do you mean that you want a banner that slowly moves, either horizontally or vertically, along the screen? (The reason I ask is that the word "scrolling" is more usually used here in relation to scrollbars.)

If so, then create the banner as a label. Set its caption to the required text, and adjust its fonts and colours to your taste. Then add a timer to your form. Set its Interval property to, say, 1000. In the Timer event, adjust the caption's Left or Top property.

If you want the banner to scroll from right to left, decrease the Left property by, say, 10 pixels, until it reaches zero, then set it back to a value equal to the width of the form. Similarly, to scroll the banner vertically, decrease the Top property until it reaches zero, then set it the height of the form.

You will have to do a certain amount of trial and error in order to find the best values for the Interval and the amount to decrement the Left or Top.

If I have misunderstood your requirement, perhaps you could clarify.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

 

[Mike Gagnon]

This from VFPX

https://github.com/VFPX/Win32API/blob/ad4185d6c45f936326166e8dad708fcdcd6e8cf7/samples/sample_352.md

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 source memory bitmap
	TrgLen=400       && target width
	TrgHeight=24     && target height
	SrcOffs=0        && initial offset
	MSecPerPixel=0   && scroll speed in milliseconds per pixel
	LastTickCount=0  && saved ticker value
	OffsCollected=0  && collects offset fractions
	
	* 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
	hFont=0    && font handle

	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 ogOutput As Toutput WITH Left=120, Top=90, Value=2
	ADD OBJECT ogSpeed As Tspeed WITH Left=220, Top=90
	ADD OBJECT tm As Timer WITH interval=0

PROCEDURE Init
	THIS.decl
	THIS.CreateSource

PROCEDURE Destroy
	= ReleaseDC(THIS.hForm, THIS.hFormDC)
	= DeleteObject(THIS.hMemBmp)
	= DeleteObject(THIS.hFont)
	= DeleteDC(THIS.hMemDC)

PROCEDURE Activate
	IF ThisForm.hForm = 0
	* window handle and device context for the form
		ThisForm.hForm = GetFocus()
		ThisForm.hFormDC = GetWindowDC(ThisForm.hForm)
	ENDIF
	
PROCEDURE tm.timer
	ThisForm.CopyToTarget

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

PROCEDURE CreateSource
* creates compatible device context and draws text on it
#DEFINE OUT_OUTLINE_PRECIS  8
#DEFINE CLIP_STROKE_PRECIS  2
#DEFINE PROOF_QUALITY       2
#DEFINE ANTIALIASED_QUALITY 4
#DEFINE CLEARTYPE_QUALITY   5
#DEFINE WM_SETFONT          48

	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))

	THIS.hFont = CreateFont(THIS.TrgHeight, 0,0,0, 300, 0,0,0,;
		0, OUT_OUTLINE_PRECIS, CLIP_STROKE_PRECIS,;
		BITOR(PROOF_QUALITY,ANTIALIASED_QUALITY), 0,"Impact")

	IF THIS.hFont <> 0
		= DeleteObject(SelectObject(THIS.hMemDC, THIS.hFont))
	ENDIF

	* 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, RGB(164,164,164))
	= TextOut(THIS.hMemDC, 3,3, THIS.content, Len(THIS.content))

	= SetTextColor(THIS.hMemDC, RGB(80,80,128))
	= TextOut(THIS.hMemDC, 0,0, THIS.content, Len(THIS.content))

	= ReleaseDC(hDsk, hDskDC)
	
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()

	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

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 GetDesktopWindow IN user32
	DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc

	DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
		INTEGER hdc, INTEGER nWidth, INTEGER nHeight

	DECLARE INTEGER CreateFont IN gdi32;
		INTEGER nHeight, INTEGER nWidth, INTEGER nEscapement,;
		INTEGER nOrientation, INTEGER fnWeight, INTEGER fdwItalic,;
		INTEGER fdwUnderline, INTEGER fdwStrikeOut, INTEGER fdwCharSet,;
		INTEGER fdwOutPrecis, INTEGER fdwClipPrecis, INTEGER fdwQuality,;
		INTEGER fdwPitchAndFamily, STRING lpszFace

	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
ENDDEFINE

DEFINE CLASS Tlbl As Label
	Autosize=.T.
	Backstyle=0
ENDDEFINE

DEFINE CLASS Toutput As OptionGroup
	ButtonCount=2
	Autosize=.T.
	Option1.Caption="Screen"
	Option1.Top=5
	Option1.Autosize=.T.
	Option2.Caption="Form"
	Option2.Top=30
	Option2.Autosize=.T.
ENDDEFINE

DEFINE CLASS Tspeed As OptionGroup
	ButtonCount=6
	Autosize=.T.
	Option1.Caption="Stop"
	Option2.Caption="Slow"
	Option3.Caption="..."
	Option4.Caption="Recommended"
	Option5.Caption="..."
	Option6.Caption="Fast"

PROCEDURE Init
	LOCAL ii, obj, nTop
	nTop = 5
	FOR ii=1 To 6
		obj = Eval("THIS.Option" + LTRIM(STR(ii)))
		WITH obj
			.Top=nTop
			.Autosize=.T.
			nTop = nTop + 20
		ENDWITH
	ENDFOR
ENDDEFINE

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)

If you want to get the best response to a question, please check out FAQ184-2483 first.