home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
pow_tb.zip
/
TBWRAP1.PRG
< prev
Wrap
Text File
|
1993-05-14
|
4KB
|
161 lines
/* tbWrap1.prg: Browses supplier.dbf with the long field of
product details word wrapped into column 2. This was a real mind
bender, and took me absolutely ages to figure out, but it turned
out to be really neat in the end. Hotter stuff!!
Copyright (C) Dave Boettcher 1993. This source code, and functional
fragments thereof, may only be distributed unchanged and as part of
the file POWER_TB.ARJ. See POWER_TB.TXT for full copyright details.
Last change: 14 May 93 6:52 pm
*/
#include "setcurs.ch"
#include "inkey.ch"
#include "box.ch"
static nLineLength := 50
static nLineNumber := 1
static nLines
function main()
local oBrowse
local oColumn
local nKey
local lCont := .T.
local oldColour := setcolor("w+/b")
local oldCursor := setcursor(SC_NONE)
local bLineCount
use supplier new
bLineCount := {|| mlcount(alltrim(supplier->product), nLineLength)+1}
nLines := eval(bLineCount)
clear screen
@ 0, 0, 24, 79 box B_DOUBLE
oBrowse := tbrowsedb(1, 1, 23, 78)
oBrowse:headsep := "─┬─"
oBrowse:colsep := " │ "
oBrowse:goBottomBlock := { || dbGoBottom(), nLineNumber := nLines:= eval(bLineCount)}
oBrowse:goTopBlock := { || dbGoTop(), nLineNumber := 1, nLines := eval(bLineCount) }
oBrowse:skipBlock := { |nRequest| multiskip(nRequest, bLineCount) }
oColumn := TBColumnNew("Supplier", {|| col1Conts() })
oColumn:width := 20
oColumn:footsep := "─┴─"
oBrowse:AddColumn(oColumn)
oColumn := TBColumnNew("Product", {|| col2Conts(nLineNumber)} )
oColumn:width := nLineLength
oColumn:footsep := "─┴─"
oBrowse:AddColumn(oColumn)
do while lCont
do while .not. oBrowse:stable .AND. (nKey := InKey()) == 0
oBrowse:Stabilize()
enddo
if oBrowse:stable
if (oBrowse:hitTop .OR. oBrowse:hitBottom)
Tone(125,0)
endif
nKey := InKey(0)
endif
Do Case
Case nKey == K_DOWN ; oBrowse:Down()
Case nKey == K_UP ; oBrowse:Up()
Case nKey == K_LEFT ; oBrowse:Left()
Case nKey == K_RIGHT ; oBrowse:Right()
Case nKey == K_PGDN ; oBrowse:PageDown()
Case nKey == K_PGUP ; oBrowse:PageUp()
Case nKey == K_CTRL_PGUP ; oBrowse:GoTop()
Case nKey == K_CTRL_PGDN ; oBrowse:GoBottom()
Case nKey == K_ESC ; lCont := .F.
endcase
enddo
setcolor(oldColour)
setcursor(oldCursor)
clear screen
return nil
function col1Conts
local cStr
do case
case nLineNumber == 1
cStr := supplier->name
case nLineNumber != 1
cStr := " "
endcase
return cStr
function col2Conts(nLineNumber)
local cStr
do case
case nLineNumber < nLines
cStr := memoline(supplier->product, nLineLength, nLineNumber)
case nLineNumber == nLines
cStr := replicate("-", nLineLength)
endcase
return cStr
function MultiSkip( nRequested, bLineCount )
local nAllowed := 0
if nRequested > 0
do while (!eof()) .and. nAllowed < nRequested
nAllowed++
nLineNumber++
if nLineNumber > nLines
skip 1
nLineNumber := 1
nLines := eval(bLineCount)
endif
enddo
if eof()
nAllowed--
skip -1
nLineNumber := nLines := eval(bLineCount)
endif
elseif nRequested < 0
do while (!bof()) .and. nAllowed > nRequested
nAllowed--
nLineNumber--
if nLineNumber == 0
skip -1
nLineNumber := nLines := eval(bLineCount)
endif
enddo
if bof()
nAllowed++
nLineNumber := 1
endif
endif
return (nAllowed)