home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
CLIPPER
/
NCCLIB.ZIP
/
NCCVIEW.ZIP
/
G_VIEW.PRG
< prev
next >
Wrap
Text File
|
1993-11-07
|
16KB
|
508 lines
//═══════════════════════════════════════════════════════╕
// Program .....: G_View │
// CopyRight ...: 1993 National Computer Consultants │
// All rights are reserved. │
// Author ......: Greg Rice │
//═══════════════════════════════════════════════════════╛
#include "dbstruct.ch"
#include "fileio.ch"
#include "inkey.ch"
#include "g_menu.ch"
#define ON 1
#define OFF 0
#define TO_SAVE 1
#define TO_OPEN 2
#define CRLF chr(13)+chr(10)
Function g_Viewcreate()
LOCAL nPickCount , ;
fc , ;
i , ;
FullScreen , ;
nBottom , ;
reverse , ;
d_Start , ;
InsScreen , ;
InsKey , ;
InsBottom , ;
pos , ;
scrn , ;
cColor := SetColor() , ;
ok := .f. , ;
InsSele := 0 , ;
nCounter := 0 , ;
nFieldSele := 0 , ;
nKey := 0 , ;
aPickDisp := {} , ;
aPickFull := {} , ;
aPickRef := {} , ;
aNewStru := {} , ;
nExitKeys := { 97, 65, K_F10, K_INS , K_DEL } , ;
dbF_structure := ACLONE( WinViewStru() ) , ;
dbstruct := dbstruct()
if Empty(alias())
Return( NIL )
endif
FullScreen := savescreen()
ShowSelectBox(dbF_structure)
setcolor(popup_color())
NccMesg('..LOADING..',07+min(maxrow()-14,len(dbF_structure)),'center,02,46')
AEVAL(dbF_structure,{ |fi_stru| aadd(aPickDisp,space(7)+;
padr(fi_stru[DBS_NAME],10,' ')+ ;
space(4)+fi_stru[DBS_TYPE]+space(4)+;
str(fi_stru[DBS_LEN],3)+space(4)+ ;
str(fi_stru[DBS_DEC],3)+' '), ;
nCounter++ })
AEVAL(dbstruct,{ |fi_stru| aadd(aPickFull,space(1)+;
padr(fi_stru[DBS_NAME],10,' ')+ ;
space(1)+fi_stru[DBS_TYPE]+space(1)+;
str(fi_stru[DBS_LEN],3)+space(1)+ ;
str(fi_stru[DBS_DEC],3)+' ') })
nPickCount := 0
WHILE len(aPickDisp) # 0
fc := ltrim(str(nCounter))
keyboard ''
nBottom := 05+min(maxrow()-14,nCounter)
nFieldSele := arraydsp( aPickDisp,;
'Field List',;
IF(nPickCount == 0,;
'',;
'Selections:'+ltrim(str(nPickCount))+' ';
)+;
'Field Count:'+fc,;
06,04,nBottom,43,nFieldSele,;
IF(nFieldSele>((nBottom-6)/2)+1,;
int(((nBottom-6)/2)),;
nFieldSele-1;
),;
.f.,nExitKeys, ;
{ |o| dView_MouseReader(o,06,04,nBottom,43), ;
menu1Reader(o,06,04,nBottom,43) ;
} ;
)
nKey := lastkey()
Do Case
Case nKey == K_RETURN
IF subs(aPickDisp[nFieldSele],6,1) == chr(251)
adel(aPickRef, ascan(aPickRef,nFieldSele))
asize(aPickRef, LEN(aPickRef)-1)
aPickDisp[nFieldSele] := space(7) + subs(aPickDisp[nFieldSele],8)
nPickCount--
i := 1
scrn := savescreen(07+min(maxrow()-14,nCounter),04,;
07+min(maxrow()-14,nCounter),43)
NccMesg(' Wait...Re-Sequencing ',07+min(maxrow()-14,;
nCounter),'center,04,43')
FOR i = 1 to nCounter
aPickDisp[i] := seq(aPickRef,i) + subs(aPickDisp[i],5)
NEXT
restscreen(07+min(maxrow()-14,nCounter),04,;
07+min(maxrow()-14,nCounter),43,scrn)
ELSEIF subs(aPickDisp[nFieldSele],6,1) # chr(251)
aadd(aPickRef, nFieldSele)
aPickDisp[nFieldSele] := seq(aPickRef,nFieldSele) + ' ' + ;
chr(251) + ' ' + ;
subs(aPickDisp[nFieldSele],8)
nPickCount++
END
Case nKey == K_INS .or. nKey == 48 .or. uppe(chr(nKey)) == 'A'
InsScreen := savescreen(03,49,10+min(maxrow()-14,len(aPickFull)-1),79)
setcolor(popup_color())
WinBox(03,49,09+min(maxrow()-14,len(aPickFull)-1),77,0,4)
WinBox(10+min(maxrow()-14,len(aPickFull)-1),49,12+min(maxrow()-14,len(aPickFull)-1),77,0,4)
shadow(03,49,12+min(maxrow()-14,len(aPickFull)-1),77)
NccMesg('[Esc]-Abort [Enter]-Select',11+min(maxrow()-14,len(aPickFull)-1),'center,50,76')
InsBottom := 06+min(maxrow()-14,fcount()-1)
InsSele := arraydsp(aPickFull,;
'Select Field to '+if(uppe(chr(nKey))='A','Add','Insert'),;
'Field Count:'+ltrim(str(fcount())),;
06,51,InsBottom,74,InsSele,;
IF(InsSele>((InsBottom-6)/2)+1,;
int(((InsBottom-6)/2)),;
InsSele-1;
),;
.f., ;
, ;
{ |o| dView_MouseReader(o,06,51,InsBottom,74), ;
menuReader(o,06,51,InsBottom,74) ;
} ;
)
InsKey := lastkey()
IF InsKey == K_RETURN
IF uppe(chr(nKey)) == 'A'
aadd(aPickDisp,space(7)+;
padr(dbstruct[InsSele,DBS_NAME],10,' ')+ ;
space(4)+dbstruct[InsSele,DBS_TYPE]+space(4)+;
str(dbstruct[InsSele,DBS_LEN],3)+space(4)+ ;
str(dbstruct[InsSele,DBS_DEC],3)+' ')
aadd(dbF_structure,dbstruct[InsSele])
nFieldSele := len(aPickDisp)
ELSE
aadd(aPickDisp,NIL)
aadd(dbF_structure,NIL)
ains(aPickDisp,nFieldSele)
ains(dbF_structure,nFieldSele)
aPickDisp[nFieldSele] := space(7)+;
padr(dbstruct[InsSele,DBS_NAME],10,' ')+ ;
space(4)+dbstruct[InsSele,DBS_TYPE]+space(4)+;
str(dbstruct[InsSele,DBS_LEN],3)+space(4)+ ;
str(dbstruct[InsSele,DBS_DEC],3)+' '
dbF_structure[nFieldSele] := dbstruct[InsSele]
END
InsSele := if(InsSele < len(aPickFull),InsSele+1,InsSele)
nCounter++
END
restscreen(03,49,10+min(maxrow()-14,len(aPickFull)-1),79,InsScreen)
restscreen(,,,,FullScreen)
ShowSelectBox(dbF_structure)
Case nKey == K_DEL .or. nKey == 46
adel(dbF_structure,nFieldSele)
adel(aPickDisp,nFieldSele)
aSize(dbF_structure,len(dbF_structure)-1)
aSize(aPickDisp,len(aPickDisp)-1)
nCounter--
restscreen(0,0,maxrow(),maxcol(),FullScreen)
ShowSelectBox(dbF_structure)
Otherwise
exit
EndCase
END
IF len(aPickDisp) # 0
IF nPickCount # 0 .and. nKey # K_ESC
NccMesg(' Wait...Creating table ',07+min(maxrow()-14,nCounter),;
'center,04,43')
FOR i = 1 to Len(aPickRef)
aadd(aNewStru, dbF_structure[aPickRef[i]])
NEXT
WinViewStru( , aNewStru )
WinViewFields( , stru_load(aNewStru) )
ok := .t.
ELSEIF nKey # K_ESC
WinViewStru( , dbF_structure )
WinViewFields( , stru_load(dbF_structure) )
ok := .t.
END
END
restscreen(,,,,FullScreen)
SetColor( cColor )
Return( NIL )
STATIC Function seq( aArray,nRef )
LOCAL ret_val := 0
ret_val := ascan( aArray, nRef )
Return( if(ret_val == 0, space(4),str(ret_val,4,0)) )
STATIC Function ShowSelectBox( aArray )
setcolor(popup_color())
WinBox(03,02,08+min(maxrow()-14,len( aArray )),46,0,4)
WinBox(9+min(maxrow()-14,len( aArray )),02,12+min(maxrow()-14,len( aArray )),46,0,4)
shadow(03,02,12+min(maxrow()-14,len( aArray )),46)
NccMesg('<A-Add> <Ins-Insert> <Del-Delete>',10+min(maxrow()-14,len( aArray )),'center,03,45')
NccMesg('<Esc-Abort> <Enter-Select> <F10-Save>',11+min(maxrow()-14,len( aArray )),'center,03,45')
Return( NIL )
Function Stru_Load( y )
local i := {}
AEVAL( y,;
{|x| aadd(i,padr(x[DBS_NAME],10,' ')+;
space(2)+x[DBS_TYPE]+space(2)+str(x[DBS_LEN],3)+space(2)+;
str(x[DBS_DEC],3));
};
)
Return( i )
STATIC Function menu1Reader(o,TopRow,LeftColumn,BottomRow,RightColumn)
LOCAL row , ;
col , ;
button , ;
Mouse := MouseSys() , ;
nKey := 0
row := Mouse:Row
col := Mouse:Column
button := Mouse:Button
if lastkey() # 0
nKey := lastkey()
endif
if button # 0
Do Case
Case row == BottomRow+5 .and. col >= LeftColumn+3 .and. ;
col <= LeftColumn+9
nKey := asc('A')
Case row == BottomRow+5 .and. col >= LeftColumn+12 .and. ;
col <= LeftColumn+23
nKey := K_INS
Case row == BottomRow+5 .and. col >= LeftColumn+26 .and. ;
col <= LeftColumn+37
nKey := K_DEL
Case row == BottomRow+6 .and. col >= LeftColumn+1 .and. ;
col <= LeftColumn+11
nKey := K_ESC
Case row == BottomRow+6 .and. col >= LeftColumn+14 .and. ;
col <= LeftColumn+27
nKey := K_RETURN
Case row == BottomRow+6 .and. col >= LeftColumn+30 .and. ;
col <= LeftColumn+39
nKey := K_F10
EndCase
endif
keyboard chr(nKey)
inkey()
Return( nKey )
STATIC Function menuReader(o,TopRow,LeftColumn,BottomRow,RightColumn)
LOCAL row , ;
col , ;
button , ;
Mouse := MouseSys() , ;
nKey := 0
row := Mouse:Row
col := Mouse:Column
button := Mouse:Button
if lastkey() # 0
nKey := lastkey()
endif
if button # 0
Do Case
Case row == BottomRow+5 .and. col >= LeftColumn-1 .and. ;
col <= LeftColumn+9
nKey := K_ESC
Case row == BottomRow+5 .and. col >= LeftColumn+11 .and. ;
col <= LeftColumn+24
nKey := K_RETURN
EndCase
endif
keyboard chr(nKey)
inkey()
Return( nKey )
Function g_Browse()
WinTop(, WinObj():TopRow -4 )
WinLeft(, WinObj():LeftColumn -1 )
WinBottom(, WinObj():BottomRow +1 )
WinRight(, WinObj():RightColumn +1 )
OpenWindow()
Return( NIL )
Function g_Record()
LOCAL y, head := Winobj():Head
WinTop(, WinObj():TopRow -4 )
WinLeft(, WinObj():LeftColumn -1 )
WinBottom(, WinObj():BottomRow +1 )
WinRight(, WinObj():RightColumn +1 )
y := NccViewit():New( WinTop() +4, ;
WinLeft() +1, ;
WinBottom() -1, ;
WinRight() -1 ;
)
y:DataBlock := { |l| RecDisplay( WinObj(), l ) }
y:GoTopBlock := { || WinObj():UserSlot[2] := 1 }
y:GoBottomBlock := { || WinObj():UserSlot[2] := ;
len(WinViewStru()) ;
}
y:SkipBlock := { |n| RecSkipper( WinObj(), n ) }
y:UserSlot := { ;
{ || FileBase(WinFilename(),".DBF") } , ;
1 , ;
{ || drawline(head) } , ;
y:StatusBlock ;
}
y:StatusBlock := { |n| RecStatus( y, n ) }
y:UseStyle := .t.
WinObj( , y)
WindowFrame(y)
WinObj():Activate()
Return( NIL )
STATIC Function RecStatus( o, n )
if ! eof()
@ o:TopRow-3,o:LeftColumn say 'Record:'+;
padr(ltrim(str(recno())) + '/' + ltrim(str(lastrec())),14,' ')
endif
if Deleted()
NccMesg( "<Deleted>", o:TopRow-3,'Center,' + str(o:RightColumn)+','+ str(o:LeftColumn)+['] )
else
NccMesg( " ", o:TopRow-3,'Center,'+str(o:RightColumn)+','+str(o:LeftColumn)+['] )
endif
@ o:TopRow-2,o:LeftColumn say 'Field:'+;
padr(ltrim(str(o:UserSlot[2])) + '/' + ltrim(str(len(WinViewStru()))),14,' ')
eval( o:userslot[4], n )
Return( NIL )
STATIC Function RecDisplay( o, l )
LOCAL x := WinViewStru(Current_window()) , ;
y := o:userslot[2] , ;
width := o:RightColumn - o:LeftColumn + 1
if eof() .or. ! l
Return( space( width ) )
else
scroll( o:CurrentRow,o:LeftColumn,o:CurrentRow,o:RightColumn,0)
@row(),col() say subs(;
padr(;
subs( x[y][1],1,1 )+;
subs( lower( x[y][1] ),2 ),;
10,;
'.';
) + ;
":" +;
dto_String( fieldget( fieldpos( x[y][1] ) ) ), ;
1, ;
width;
)
endif
Return( '' )
STATIC Function RecSkipper( o , n)
local nActual := 0, nDirection := if(n<0,-1,1)
if n == 0
Return( 0 )
endif
while nActual # n
if n > 0
if o:userslot[2] # len(WinViewStru(Current_Window()))
o:userslot[2]++
else
exit
endif
else
if o:userslot[2] # 1
o:userslot[2]--
else
exit
endif
endif
nActual += nDirection
enddo
Return( nActual )
STATIC Function Drawline( head )
Local x := WinObj()
@x:TopRow - 1, x:LeftColumn say ;
Replicate(Head, x:RightColumn - x:LeftColumn + 1 )
Return( NIL )