home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
exodem.zip
/
TBNET.PRG
< prev
next >
Wrap
Text File
|
1993-06-04
|
5KB
|
147 lines
/*
┌─────────────────────────────────────────────────────────────────────────┐
▌│ │
▌│ Program : TBNet.PRG │
▌│ purpose : Networkable Tbrowse (slightly modified source from │
▌│ Greg Lief's book on Networking with Clipper 5.2) │
▌│ belongs to test series for exospace (beta 1) │
▌│ author : Dieter Crispien │
▌│ compile : /m /n /w /a │
▌│ link : exospace fi tbnet exo cl 501 │
▌│ utilities: dbcre8 1000 creates a test.dbf for this │
▌│ Comment : TBNet even runs fine when eating up 370 k using │
▌│ eatmem 370 │
▌│ mem /c reports 228 k free memory after this │
▌└─────────────────────────────────────────────────────────────────────────┘
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
To get maximum execution speed, do NOT use any memory manager!
Testen Sie die Programm-Ausführung mit und ohne Speichermanager!
Auch EMM386 NOEMS ist eine gute Einstellung.
Alle Speichermanager können so eingestellt werden, daß nicht alles
verfügbares Memory als EMS verwaltet wird.
Wenn Sie EATMEM haben, oder auf andere Weise möglichst viel Speicher
belegen, werden Sie sehen daß das Programm sogar noch mit unter 250K
freiem Basisspeicher läuft!
*/
#include "box.ch"
#include "inkey.ch"
#include "setcurs.ch"
#define REFRESH_TIME 10
field last,first,city,state,salary,hiredate,Notes
memvar GETLIST
function main
local x
local b := TBrowseDB(1, 1, maxrow()-1, maxcol()-1)
local c
local nKey
local nseconds := 0, nTimeDiff
set scoreboard off
setcursor(SC_NONE)
use TEST
if !file("TE_LAST.NTX")
index on upper(last) to TE_LAST
endif
if !file("TE_SALRY.NTX")
index on str(salary,8)+dtos(hiredate) to TE_SALRY
endif
USE TEST shared
set index to TE_LAST,TE_SALRY
set order to 2
c := TBColumnNew("Last name First City"+;
" St hired salary days", { || Show() } )
b:HeadSep := "═══"
b:AddColumn( c )
@ b:nTop - 1, b:nLeft - 1, b:nBottom + 1, b:nRight + 1 box B_SINGLE + ' '
@ b:nBottom +1, 5 SAY "Press ALT-M and you'll have a look into memory wonderland!!!" color "+GR/N"
do while nKey != K_ESC
dispbegin()
do while ( nKey := inkey() ) == 0 .and. ! b:stabilize(); enddo
dispend()
if nKey == 0
// replacing inkey(0) to refresh every 10 seconds
do while ( nKey := inkey() ) == 0
nTimeDiff := Seconds() - nSeconds
@ 0,2 SAY nTimeDiff PICT "99.9"
if nTimeDiff > REFRESH_TIME
nseconds := seconds()
b:refreshAll()
dispbegin()
do while ! b:stabilize(); enddo
dispend()
endif
enddo
endif
do case
case nKey == K_UP; b:up()
case nKey == K_DOWN; b:down()
case nKey == K_LEFT; b:left()
case nKey == K_RIGHT; b:right()
case nKey == K_PGUP; b:pageUp()
case nKey == K_PGDN; b:pageDown()
case nKey == K_CTRL_PGUP;b:goTop()
case nKey == K_CTRL_PGDN;b:goBottom()
case nKey == K_ALT_M; dispmemory()
case nKey == K_ENTER .or. nKey == 32
select Test
if Rlock()
edit()
commit; unlock
else
Alert( "Someone's working on this record...." )
endif
endcase
enddo
dbclosearea()
return nil
******************************************************************************
static function Show()
local nDauer := date() - hiredate
return last+" "+substr(first,1,10)+" "+substr(city,1,15)+" "+state+" "+;
dtoc(hiredate)+str(salary,9)+" "+str(nDauer,5)
******************************************************************************
static function edit(b)
local cSave := savescreen(6,10,12,40)
dispbox(6,10,12,40,2)
@ 7,11 clear to 11,39
@ 7,11 say "Last : "+Test->first
@ 8,11 say "First : "+Test->last
@ 9,11 say "hire date : "+dtoc(Test->hiredate)
@ 10,11 say "salary : "+str(Test->salary,6)
@ 11,11 say "new salary :" GET Test->salary
READ
restscreen(6,10,12,40,cSave)
return NIL
function dispmemory()
local t:= 5, l := 4, b := 14, r := 51
local cScreen
cScreen := savescreen(t,l,b,r)
@ t,l,b,r box B_DOUBLE+" " color "+GR/N"
@ t+1,l+1 SAY "available swap space..............(0)"+str( memory(0),8)
@ t+2,l+1 SAY "größter zusammenhängender Block...(1)"+str( memory(1),8)
@ t+3,l+1 SAY "free for RUN .....................(2)"+str( memory(2),8)
@ t+4,l+1 SAY "free for variables ...............(3)"+str( memory(3),8)
@ t+5,l+1 SAY "free not allocated EMM ...........(4)"+str( memory(4),8)
@ t+6,l+1 SAY "size of fixed heap .............(101)"+str( memory(101),8)
@ t+7,l+1 SAY "number of segments in fixed heap(102)"+str( memory(102),8)
@ t+8,l+1 SAY "not allocated conventional memo.(104)"+str( memory(104),8)
inkey(0)
restscreen(t,l,b,r,cScreen)
return nil