Vscroll problem

[Egil]

I live on a coast where weather and  ocean current conditions make routing rather challenging to navigators. A couple of years ago the environmental authorities started to deploy buoys with sensors, broadcasting present weather conditions via the AIS system. Therefore I finally decided to make software for decoding these signals and showing them on a screen. Coding such a system should be relatively straight forward, but I soon ran into an unexpected problem, vertical scrolling.

Apparently I can scroll vertically forever, but when the ammount of pixels scrolled pass the screenheight number of pixels, printing to screen stops. Searching both the web and this forum reveals that I'm not the only one experiencing this. But so far I have been unable to figure out a way to eliminate the problem. And since the problem occours also with IWB and Aurora, I have only tried with CB.

I wonder if anyone have a suggestion to fix the problem?
Below is the CB code I used to produce the posted picture, showing that printing to screen suddenly stops.


Regards,
Egil

Code Select Expand

'
' TextBox.cba
'----------------------------------------------------------------------
AUTODEFINE "OFF"

' Declares for gcLabel:
DECLARE "gdi32.dll",RoundRect(hdc:int, X1:int, Y1:int, X2 As int, Y2:int, X3 As int, Y3:int),int
DECLARE TextBox(wnd:window,x:int,y:int,msg$:string,bgcolor:int)

'--- Test program -------------------------------------------------------
'
DEF win,w1,w2:window
def i,run,nlines,status:int
def CRLF:string
DEF message1$[2048],message2$[2048]:istring
DEF PRIORITY,ROUTINE:int
PRIORITY = RGB(255,188,202)
ROUTINE = RGB(255,255,188)
def lft,top,wth,hgt,hgt2:int

message1$ = " In a dual-polarization system, MAP65 optimally matches the linear polarization angle of each signal, "
message2$ = " China is one of the few countries increasing its presence on the medium wave (AM) radio dial, as DXers have been able to observe. Identifying Chinese stations can however be tricky if you don't understand the language."
WINDOW win,0,0,760,480,@MINBOX|@MAXBOX|@SIZE,0," Scrolling Text Demo",main
'WINDOW win,0,0,760,480,0,0," Scrolling Text Demo",main
GETCLIENTSIZE win,lft,top,wth,hgt
SETWINDOWCOLOR win,rgb(190,200,240)

'----------------------------------------------------------------------

'----main window child -----------
Window w1,200,top,wth-200,hgt,@VSCROLL|@NOCAPTION,win,"Scrolling Window",main
setwindowcolor w1,RGB(222,222,222)

'----scrolling window child -----------
Window w2,0,0,wth-200,hgt,@NOCAPTION,w1,"Child Window",main
drawmode w2,@TRANSPARENT
setwindowcolor w2,RGB(222,222,222)


'¤¤¤¤¤¤¤¤¤¤¤¤¤  These lines are for testing scroll functions only!!! ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
nlines = 0
status = PRIORITY

for i = 1 to 100
if status = PRIORITY
status = ROUTINE
else
status = PRIORITY
endif

if (i = 5) | (i = 20)
nlines = nlines + TextBox(w2,10,10 + (nlines * 15),str$(i) + message2$,status)
else
nlines = nlines + TextBox(w2,10,10 + (nlines * 15),str$(i) + message1$,status)
endif
next i
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤


SETSCROLLRANGE w2,-2,1,hgt
SetSize w2,0,1,wth-200,hgt

run = 1
WAITUNTIL run = 0
END


SUB main

SELECT @class

CASE @idclosewindow
CLOSEWINDOW win
CLOSEWINDOW w1
CLOSEWINDOW w2
run=0

CASE @IDVSCROLL : ' Scrollbar handler

' determine scroll direction (UP or DOWN)
' scroll w2 content up or down
' set scrollbar in new position

SELECT @CODE
CASE @SBLINEUP
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))-2
CASE @SBLINEDOWN
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))+2

CASE @SBPAGEUP
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))-20
CASE @SBPAGEDOWN
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))+20

CASE @SBTHUMBPOS
SETSCROLLPOS w1, -2, @QUAL
CASE @SBTHUMBTRACK
SETSCROLLPOS w1, -2, @QUAL
ENDSELECT

' ¤¤¤¤  THIS CODE NEEDS TO BE ADJUSTED SO ALL MESSAGES CAN BE SHOWN   Â¤Â¤Â¤Â¤
' ¤¤¤¤  AND SCROLLING STOPED WHEN LAST LINE OF TEXT HAS BEEN REACHED    ¤¤¤¤
SetSize w2,0,-GETSCROLLPOS(w1,-2)*15,wth-200,hgt + (nlines*15)

CASE @IDCREATE
CenterWindow win

ENDSELECT

RETURN


'
SUB TextBox(wnd:window,x:int,y:int,msg$:string,bgcolor:int)
'----------------------------------------------------------------------------------------
' Draws colored textboxes with border - 71 characters wide with selfdimensioning heights.
' Parameters:
' x, y: Upper left corner of rounded Label
' msg$: Label text
' bgcolor: Fill color
'----------------------------------------------------------------------------------------
def hdc,tcount,lcount,i,tmp:int
def textwidth,textheight,textlength,lines:int
def tmsg$[4096]:istring

tmsg$ = msg$ + " "

textlength = len(tmsg$) :'number of characters
lines = textlength/71 :'number of lines
if textlength > (lines * 71) then lines = lines + 1
tcount = 71 :'used for dividing line lengths to fit TextBox
lcount = 1  :'linecount
SETFONT wnd,"Consolas",10,400
GETTEXTSIZE wnd, tmsg$, textwidth, textheight

'print box:
hdc = GetHDC wnd
RoundRect(hdc, x,y,(x + 6 + (7*72)), (y+(lines*15)+6),5,5)
RELEASEHDC(wnd,hdc)
FLOODFILL wnd, x+3,y+2,bgcolor

tmp = textlength
x = x+8 :' left side of text
y = y + 2 :' top of text
i = 0

do
move wnd, x,y
' find end of last complete word for dividing text
while (mid$(tmsg$,tcount,1) <> " ")
tcount = tcount - 1
endwhile
' print line
if tmp > 71
print wnd,left$(tmsg$,tcount)
tmp = tmp - tcount
tmsg$ = right$(tmsg$,tmp)
else
print wnd,tmsg$
endif

if tmp > 71
tcount = 71
else
tmp = len(tmsg$)
tcount = tmp
endif

y = y + 15
i = i + 1

until i = (lines)

RETURN lines + 1



[Andy]

Egil,

Nice to hear from you again!

I've made an IWB version of your code, and just a quick look at it, I changed the value 71 to 171 and got a few more in the list view.

Wonder if it's in the calculation for TextBox sub?

Code Select Expand


'
' TextBox.cba
'----------------------------------------------------------------------
AUTODEFINE "OFF"

' Declares for gcLabel:
DECLARE "gdi32.dll",RoundRect(hdc:int, X1:int, Y1:int, X2 As int, Y2:int, X3 As int, Y3:int),int
DECLARE TextBox(wnd:window,x:int,y:int,msg$:string,bgcolor:int),int

'--- Test program -------------------------------------------------------
'
DEF win,w1,w2:window
def i,run,nlines,status:int
def CRLF:string
DEF message1$[2048],message2$[2048]:istring
DEF PRIORITY,ROUTINE:int
PRIORITY = RGB(255,188,202)
ROUTINE = RGB(255,255,188)
def lft,top,wth,hgt,hgt2:int

message1$ = " In a dual-polarization system, MAP65 optimally matches the linear polarization angle of each signal, "
message2$ = " China is one of the few countries increasing its presence on the medium wave (AM) radio dial, as DXers have been able to observe. Identifying Chinese stations can however be tricky if you don't understand the language."
'WINDOW win,0,0,760,480,@MINBOX|@MAXBOX|@SIZE,0," Scrolling Text Demo",main

openwindow win,0,0,760,480,@MINBOX|@MAXBOX|@SIZE,0," Scrolling Text Demo",&main


'WINDOW win,0,0,760,480,0,0," Scrolling Text Demo",main
GETCLIENTSIZE win,lft,top,wth,hgt
SETWINDOWCOLOR win,rgb(190,200,240)

'----------------------------------------------------------------------

'----main window child -----------
'Window w1,200,top,wth-200,hgt,@VSCROLL|@NOCAPTION,win,"Scrolling Window",main

OPENWINDOW w1,200,top,wth-200,hgt,@VSCROLL|@NOCAPTION,win,"Scrolling window",&main
setwindowcolor w1,RGB(222,222,222)

'----scrolling window child -----------
'Window w2,0,0,wth-200,hgt,@NOCAPTION,w1,"Child Window",main

OPENWindow w2,0,0,wth-200,hgt,@NOCAPTION,w1,"Child Window",&main
drawmode w2,@TRANSPARENT
setwindowcolor w2,RGB(222,222,222)


'¤¤¤¤¤¤¤¤¤¤¤¤¤  These lines are for testing scroll functions only!!! ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
nlines = 0
status = PRIORITY

for i = 1 to 100
if status = PRIORITY
status = ROUTINE
else
status = PRIORITY
endif

if (i = 5) | (i = 20)
nlines = nlines + TextBox(w2,10,10 + (nlines * 15),str$(i) + message2$,status)
else
nlines = nlines + TextBox(w2,10,10 + (nlines * 15),str$(i) + message1$,status)
endif
next i
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤


SETSCROLLRANGE w2,-2,1,hgt
SetSize w2,0,1,wth-200,hgt

run = 1
WAITUNTIL run = 0
END


SUB main()

SELECT @class

CASE @idclosewindow
CLOSEWINDOW win
CLOSEWINDOW w1
CLOSEWINDOW w2
run=0

CASE @IDVSCROLL : ' Scrollbar handler

' determine scroll direction (UP or DOWN)
' scroll w2 content up or down
' set scrollbar in new position

SELECT @CODE
CASE @SBLINEUP
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))-2
CASE @SBLINEDOWN
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))+2

CASE @SBPAGEUP
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))-20
CASE @SBPAGEDOWN
SETSCROLLPOS w1, -2, (GETSCROLLPOS(w1, -2))+20

CASE @SBTHUMBPOS
SETSCROLLPOS w1, -2, @QUAL
CASE @SBTHUMBTRACK
SETSCROLLPOS w1, -2, @QUAL
ENDSELECT

' ¤¤¤¤  THIS CODE NEEDS TO BE ADJUSTED SO ALL MESSAGES CAN BE SHOWN   Â¤Â¤Â¤Â¤
' ¤¤¤¤  AND SCROLLING STOPED WHEN LAST LINE OF TEXT HAS BEEN REACHED    ¤¤¤¤
SetSize w2,0,-GETSCROLLPOS(w1,-2)*15,wth-200,hgt + (nlines*15)

CASE @IDCREATE
CenterWindow win

ENDSELECT

RETURN
endsub


'
SUB TextBox(wnd:window,x:int,y:int,msg$:string,bgcolor:int),int
'----------------------------------------------------------------------------------------
' Draws colored textboxes with border - 71 characters wide with selfdimensioning heights.
' Parameters:
' x, y: Upper left corner of rounded Label
' msg$: Label text
' bgcolor: Fill color
'----------------------------------------------------------------------------------------
def hdc,tcount,lcount,i,tmp:int
def textwidth,textheight,textlength,lines:int
def tmsg$[4096]:istring

tmsg$ = msg$ + " "

textlength = len(tmsg$) :'number of characters
lines = textlength/171 :'number of lines
if textlength > (lines * 171) then lines = lines + 1
tcount = 71 :'used for dividing line lengths to fit TextBox
lcount = 1  :'linecount
SETFONT wnd,"Consolas",10,400
GETTEXTSIZE wnd, tmsg$, textwidth, textheight

'print box:
hdc = GetHDC wnd
RoundRect(hdc, x,y,(x + 6 + (7*72)), (y+(lines*15)+6),5,5)
RELEASEHDC(wnd,hdc)
FLOODFILL wnd, x+3,y+2,bgcolor

tmp = textlength
x = x+8 :' left side of text
y = y + 2 :' top of text
i = 0

do
move wnd, x,y
' find end of last complete word for dividing text
while (mid$(tmsg$,tcount,1) <> " ")
tcount = tcount - 1
endwhile
' print line
if tmp > 71
print wnd,left$(tmsg$,tcount)
tmp = tmp - tcount
tmsg$ = right$(tmsg$,tmp)
else
print wnd,tmsg$
endif

if tmp > 71
tcount = 71
else
tmp = len(tmsg$)
tcount = tmp
endif

y = y + 15
i = i + 1

until i = (lines)

RETURN lines + 1
endsub


Andy.

[Egil]

Hi Andy and thanks  for trying!

The value you changed, is only specifying the TextBox line widths before making a new line, so even if you get more messages printed, you only print the first 71 characters of each message, not the full messages.
And I am quite convinced that if you try to  calculate the pixels "used" vertically in your example, you get the same number as your system screenheight in pixels. Just change your screen resolution, and see what happens....

And it is quite a mystery to me why the program stops printing to screen after scrolling past the value of screenheight.
But I am convinced that there is a way to rectify this problem, but have not yet managed to figure out how to do it. And the fact that a lot of other people (also on this forum!!) have the same problems, only makes the challenge more interesting.


Egil



PS:
I can get around this problem by using a RichEdit Control, but the it will be very complicated or impossible to use the colored boxes to show the importance of the different messages.  And since I can scroll vertically inside such a control way past the value of the system screen height, there must be a way doing the same when using a "clean" window.

[LarryMc]

Egil
If no one can offer a direct solution to the problem (I can't) I may have a viable solution for you.

I have two pieces of old code, one of which came from the forum based upon listviews.
One addresses your desire for color and the other addresses your apparent need for multiline text.
Let me know if you want copies

[ckoehn]

The key is to print on the form and maintain your own x,y positions.  If I can find time tomorrow I may put something together for you, showing what I mean.  The scrollbar value is the top position of your pseudo screen.

Later,
Clint

[Egil]

If no one can offer a direct solution to the problem (I can't) I may have a viable solution for you.

Thanks Larry.

I have already thought of using a Listview Control for the job. And if I can't find a solution to my "plain window" problem that is the way I'll do it.


Egil

[Egil]

....The scrollbar value is the top position of your pseudo screen.

Thanks Clint,

That is  what I'm trying to do with the line:

Code Select Expand

SetSize w2,0,-GETSCROLLPOS(w1,-2)*15,wth-200, hgt + (nlines*15)

The only change of how far it is possible to scroll vertically, is when changing the the last SetSize parameter (hgt + (nlines*15)). Decreasing that parameter decrease how far I can scroll vertically, and increasing it above the shown value does nothing. 
Quite confusing for an old brain....


Egil

[Brian]

Egil,

From what I have read, you are trying to draw round rectangles to a device context (DC) which is the client size of your program window, so that's the size you are allowed

Brian

[Egil]

Hi Brian,

I don't think that is the problem because one of the first things I tried was printing without the colored boxes, but scrolling stopped at exactly the same point.


Egil.



PS
Tomorrow I'll go back to the hospital for new tests and another MR scan, so will not be able to log in here for a couple of days...

[ckoehn]

I guess I didn't make myself clear which isn't unusual.  You have to use the scroll pos to draw your text box routines.  It looks like you are just scrolling the form. My mind feels a little fuzzy this morning so I probably still aren't making myself clear.  I hope you can transfer this from IWB to CB.  I have Sapereo's high speed routine to draw the display and it is needed if you want the scrolling to appear smooth.

I have a CB program somewhere on my computer I think..     Sorry Graham if you're reading this..


Later,
Clint

[ckoehn]

I found my CB program.  It seems a little more complicated..   Although your programming looks better then mine  .

Let me play around with it and see if I can figure it out.

Later,
Clint

[ckoehn]

Try this one.  I think  it does what you want.

Later,
Clint

[Egil]

Exactly what I needed Clint!   

So thank  you very much. I misunderstood your first message, but seems like I was on the right track, but somehow managed to simplify too much.
Always used various controls when I have needed scrolling before. So who would beleive that this should be this  complicated when using it with a plain window.

Saw that Graham had regained access to the forum. Guess he likes this type of coding...

Took a lot of bloodsamples today, plus MR. And instead of waiting for the results tomorrow or wednesday, I went home, and get the results by phone.
So tomorrow I'll go on and make code for retreiving broadcasts from the weather buoys only. Guess projects like this is what keeps me going....

Thanks again Clint for a nice solution, and thanks to all the others for trying to help.


Regards,

Egil.