Monster Media 1993 #2/Image.iso/clipper/exodem.zip/TBNET.PRG

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