'=========================================================================== ' Subject: GET TEXT Date: 11-20-95 (17:41) ' Author: Alexander Podkolzin Code: PB ' Origin: app@sbank.e-burg.su Packet: TEXT.ABC '=========================================================================== '------------------------- Demo here -------------------------------- defint a-z dim m$(100) %MAXLINES = 1000 ' Dymmy array (for testing): m$(1)="1aaa It's a dummy text zzzaaaaaaa ---------- First line" m$(2)="2bbbbbbdddddddddddddddbbbbbbbbddddb" m$(3)="3ccccccccccaaaazzzzzzaaaaaa" m$(4)="4bbbbbbbbbbbbb" m$(5)="5aaaaaaaaaaeeaaazzzzzzaaaaa" m$(6)="6bbbbwwwwwwwbbbbbbbbbbb" m$(7)="7aaaaaaaaaataaazzzzzzdffaaaaaa" m$(8)="8bbbbbbaaaaaaaaaaaaabbbbbbbbb" m$(9)="9aaaaaaaaazzzzzzaaaaaaa" m$(10)="10bbbbbbbbbbbbbbbww" m$(11)="11aaaazzzzzzaaaaaaawwwwwwwwwwwwaaaaaaa" m$(12)="12bbbbbbbbbbbbbbb" m$(13)="13aaaaaaaaazzzzzzaaaaaaaaa" m$(14)="14bbbbbbbbbbbbbbb ------------- Last line " ' cls print string$(2000,176); color 0,7 locate 1,1 print space$(80); locate 1,16 print "Using navigation keys,choose a line from text array..." locate 25,1 print space$(80); s$ = gettext(m$(),1,22,7,58,13,12,1,0,7) '0,7) if s$="" then s$=" You have pressed ESC-key" locate 25,2 print "You chose line: "; s$; end '-------------------------------------------------------------------------- ' GetText$: ' Returns a string, you chose from an array. It can be used for menuing ' as well. If you don't want cursor bar, make ct%=ctn%, cb%=cbn% and it ' will be a kind of simple browser. '-------------------------------------------------------------------------- ' Author: Alexander Podkolzin '-------------------------------------------------------------------------- ' FUNCTION GetText$( txt$(),_ ' text array, twin%,_ ' win type, xb%, yb%, xe%, ye0%,_ ' window coordinates, ct%,cb%,_ ' window colors, ctn%,cbn%)_ ' cursor bar colors PUBLIC ' OldX% = POS(0) ' Saving parameters have to be OldY% = CSRLIN ' your habit :) OldColor% = pbvScrnTxtAttr ' (internal PB variable) COLOR ct%,cb% ' ' Enter$=CHR$(13) ' Only for beauty of our code, Esc$ = CHR$(27) ' as it's rather difficult to Home$ = CHR$(0,71) ' understand such lines as: PgUp$ = CHR$(0,73) ' IF RIGHT$(s$,1) = "G" THEN ... EndKey$ = CHR$(0,79) ' then: PgDn$ = CHR$(0,81) ' IF s$ = Home$ THEN ... Up$ = CHR$(0,72) ' Down$ = CHR$(0,80) ' ' FOR i%=1 TO %MAXLINES ' max lines in text array IF LEN(txt$(i%))=0 THEN EXIT FOR NEXT i% nlines%=i%-1 IF nlines%1 THEN GOSUB HideCursorBar DECR cur% GOSUB ShowCursorBar ELSE begy%=begy%-1 endy%=endy%-1 END IF CASE Down$ IF cur%0 THEN GetText$=txt$(Gt%) ELSE GetText$="" END IF ct%=OldColor% AND 15 ' restore parameters cb%=OldColor%\16 ' COLOR ct%,cb% ' LOCATE oldy%,oldx% ' EXIT FUNCTION ShowText: CALL Numerer(nlines%,lpage%,begy%,endy%) GOSUB MakeRuler FOR i%=begy% TO endy% PutString xb%+2,yb%+i%-begy%+1,_ LEFT$(txt$(i%)+SPACE$(xe%-xb%+1),xe%-xb%-3) NEXT i% RETURN ShowCursorBar: FOR i%=xb%+1 TO xe%-1 PutAttribute i%,yb%+cur%,ctn%,cbn% NEXT RETURN HideCursorBar: FOR i%=xb%+1 TO xe%-1 PutAttribute i%,yb%+cur%,ct%,cb% NEXT RETURN MakeRuler: FOR i%=yb%+1 TO ye%-1 PutAttribute xe%,i%,ct%,cb% PutString xe%,i%,CHR$(177) NEXT k%=((begy%+cur%-1)/nlines%)*(ye%-yb%-1) IF k%=0 THEN k%=1 ' Correction "Kill insect" PutString xe%,yb%+k%,CHR$(219) RETURN END FUNCTION ' ' A few words about correction "Kill insect". :) ' Probable, it is not mine invention. :) ' Sometimes in my programs appears difficult :) ' points, in which I have hardly to think to :) ' write "universal" formula for all possible :) ' cases. As I'm a LAZY person, I write simple :) ' formula and correct its wrong results by :) ' additional line (sometimes not one) of code.:) ' Such corrections I name "Kill insect". :) '-------------------------------------------------------------------------- ' Numerer "normalizes" begy% and endy% <- very usefull function! ' SUB Numerer(nlines%,lpage%,begy%,endy%) IF nlines%<=lpage% THEN begy%=1 endy%=nlines% EXIT SUB END IF IF begy%<1 THEN begy%=1 endy%=begy%+lpage%-1 EXIT SUB END IF IF begy%+lpage%-1>=nlines% THEN endy%=nlines% begy%=nlines%-lpage%+1 EXIT SUB END IF endy%=begy%+lpage%-1 END SUB '-------------------------------------------------------------------------- SUB PutString(x%,y%,st$) k%=160*(y%-1)+x%+x%-2 DEF SEG = &HB800 ' This is system dependent! FOR i%=0 TO LEN(st$)-1 POKE$ k%+i%+i%,MID$(st$,i%+1,1) NEXT DEF SEG END SUB '-------------------------------------------------------------------------- SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%) ' OldColor% = pbvScrnTxtAttr ' Internal PB variable SELECT CASE t% ' Window types ' ' (you can make as much types, ' ' as you want): CASE 1 a%=218:b%=196:c%=191 'ÚÄÄÄÄÄÄÄ¿ h%=179: :d%=179 '³ 1 ³ g%=192:f%=196:e%=217 'ÀÄÄÄÄÄÄÄÙ CASE 2 a%=201:b%=205:c%=187 'ÉÍÍÍÍÍÍÍ» h%=186: :d%=186 'º 2 º g%=200:f%=205:e%=188 'ÈÍÍÍÍÍÍͼ CASE ELSE a%=032:b%= a%:c%= a% ' h%= a%: :d%= a% ' Blanks only g%= a%:f%= a%:e%= a% ' END SELECT COLOR ct%,cb% LOCATE yb%,xb% : PRINT CHR$(a%)+REPEAT$(xe%-xb%-1,CHR$(b%))+CHR$(c%) FOR i%=yb%+1 TO ye%-1 LOCATE i%,xb% : PRINT CHR$(h%)+ SPACE$(xe%-xb%-1) +CHR$(d%) NEXT LOCATE ye%,xb% : PRINT CHR$(g%)+REPEAT$(xe%-xb%-1,CHR$(f%))+CHR$(e%) FOR i%=yb%+1 TO ye%+1 PutAttribute xe%+1,i%,8,0 ' Maiking NEXT ' shadows FOR i%=xb%+1 TO xe%+1 ' PutAttribute i%,ye%+1,8,0 ' NEXT ct%=OldColor% AND 15 ' restore colors cb%=OldColor%\16 COLOR ct%,cb% END SUB '-------------------------------------------------------------------------- SUB PutAttribute(x%,y%,t%,b%) ' Puts attribute byte to video memory LOCAL c% ' directly to Colomn, Row position c% = b%*16+t% ' DEF SEG = &hb800 ' NOTE: This is system depending ! POKE 160*(y%-1)+x%+x%-1,c% DEF SEG END SUB '--------------------------------------------------------------------------