Tweet
This is a first attempt. Improvements welcome.
Code:
' a stab at a Read Only Text box using PBCC GRAPHIC WINDOW
' Chris Holbrook Oct 2008
'
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
'--------------------------------------------------------------------
%MAXLINES = 99
' text editor
FUNCTION dotext ( hGW AS DWORD, stext AS STRING, rct AS QUAD, term AS STRING) AS QUAD
LOCAL ll() AS BYTE PTR
LOCAL cpl, lpd, lline, endoftext, pxcwide, pxchigh, row, col AS LONG
LOCAL pbwd AS BYTE PTR
DIM ll(0 TO 99) AS LOCAL BYTE PTR
LOCAL r AS rect
LOCAL skey, s AS STRING
STATIC SERRWTOOLONG AS STRING
SERRWTOOLONG = "<word too long>"
' extract bounding rect from parameter
r.nleft = LO(WORD, LO(DWORD,rct))
r.ntop = HI(WORD, LO(DWORD,rct))
r.nright = LO(WORD, HI(DWORD,rct))
r.nbottom = HI(WORD, HI(DWORD,rct))
' set font
GRAPHIC FONT "Courier New", 10
'get pixel sizes of characters
GRAPHIC CHR SIZE TO pxcwide, pxchigh
again:
REDIM ll(0 TO 99) AS LOCAL BYTE PTR
GRAPHIC BOX (r.nleft,r.ntop) - (r.nright, r.nbottom), 0, 0,0,0
'get no of charcters per line
cpl = (r.nright - r.nleft -4)\pxcwide
'get no of lines in display
lpd = (r.nbottom - r.ntop -4)\pxchigh
'GRAPHIC PRINT "cpl=" + STR$(cpl) + ", lpd =" + STR$(lpd)
' split text into lines until text or exhausted or > maxlines
row = 0 : col = 0 :
pbwd = STRPTR(stext)
endoftext = STRPTR(stext) + LEN(stext)
ll(0) = STRPTR(stext)
'
DO
INCR pbwd
IF pbwd = endoftext THEN EXIT LOOP ' ignore trailing white space in last line
IF pbwd - ll(row) > cpl THEN ' ran out of line
IF @pbwd = &H20 THEN
WHILE @pbwd = &H20
INCR pbwd
IF pbwd = endoftext THEN EXIT LOOP
WEND
IF pbwd = endoftext THEN EXIT LOOP ' ignore trailing white space in last line
ELSE
WHILE @pbwd <> &H20
DECR pbwd
IF pbwd < ll(row) THEN
' word too long for margins error
ll(row) = STRPTR(SERRWTOOLONG)
INCR row
ll(row) = ll(row-1) + cpl
END IF
WEND
WHILE @pbwd = &H20
DECR pbwd 'skip back past whitespace
IF pbwd < ll(row) THEN EXIT LOOP
WEND
IF pbwd < ll(row) THEN EXIT LOOP ' white space at start of line
INCR row
IF row > %MAXLINES THEN EXIT LOOP
INCR pbwd
IF pbwd = endoftext THEN EXIT LOOP ' ignore trailing white space in last line
ll(row) = pbwd
DECR pbwd
'exit loop
IF row > %MAXLINES THEN EXIT LOOP
END IF
END IF
IF pbwd > endoftext THEN
EXIT LOOP
END IF
LOOP
ll(row+1) = pbwd + 1 ' set limiting size into pointer array
' display lines in text box
FOR row = 0 TO lpd -1
IF ll(row + 1) = 0 THEN EXIT FOR
pbwd = ll(row)
lline = ll(row +1) - pbwd
s = STRING$(cpl, 0)
copymemory(STRPTR(s), pbwd, lline)
GRAPHIC SET POS ( r.nleft + 2 , r.ntop + 2 + (row * pxchigh))
REPLACE $NUL WITH $SPC IN s
GRAPHIC PRINT s
NEXT
GRAPHIC WAITKEY$ TO skey
SELECT CASE skey
CASE "W"
r.nright = r.nright + 20
IF r.nright > 350 THEN r.nright = 350
GOTO again
CASE "H"
r.nbottom = r.nbottom + 20
IF r.nbottom > 300 THEN r.nbottom = 300
GOTO again
CASE $ESC
FUNCTION = MAK(QUAD,MAK(DWORD,&H1B,0),0)
CASE ELSE
GOTO again
END SELECT
END FUNCTION
FUNCTION PBMAIN () AS LONG
LOCAL hGW AS DWORD
LOCAL qrect AS QUAD
LOCAL qtc AS QUAD
LOCAL s AS STRING
GRAPHIC WINDOW "", 100, 100, 400, 400 TO hGW
GRAPHIC ATTACH hGW, 0
s = "Titiro e Kawana--a whakarongo mai hoki. Ko te wahi e nohoia na e koe, ko " + _
"te wahi tena i noho ai to matou tupuna a Hinemoa, i tona Kauanga mai. " + _
"Kia kauwhautia atu iana, e ahau, ki a koe. Na, ko Rangiuru, te matua " + _
"wahine o Tutanekai, ko Whakaue-Kaipapa tana tane tupu; he tane tahae a " + _
"Tuwharetoa. Ko ana tamariki matamua tokotoru, ko o ratou ingoa, ko " + _
"Tawakeheimoa, ko Ngararanui, ko Tuteaiti; muri iho o te tokotoru, ka " + _
"moea tahaetia a Rangiuru e Tuwharetoa. I haere manuhiri mai a " + _
"Tuwharetoa, nana a Tutanekai, he poriro ia, otira i moea ano e Whakaue a " + _
"Rangiuru; ka hapu ano, he tamaiti, ko Kopako tona ingoa; ka hapu ano " + _
"hoki ia i muri iho i a Kopako, he tamahine, Ko Tupa tona ingoa, ko te " + _
"whakapakanga ia o nga tamariki a Whakaue."
GRAPHIC SET POS ( 20, 320)
GRAPHIC PRINT "W to grow width, H to grow height ESC to exit"
qrect = MAK(QUAD,MAK(DWORD,20,20),MAK(DWORD,200,200))
qtc = dotext ( hGW, s, qrect, $ESC + $NUL)
END FUNCTION
Comment