home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
CLIPPER
/
NCCLIB.ZIP
/
NCCVIEW.ZIP
/
G_DATA.PRG
< prev
next >
Wrap
Text File
|
1993-12-12
|
20KB
|
681 lines
//═══════════════════════════════════════════════════════╕
// Program .....: G_Data │
// CopyRight ...: 1993 National Computer Consultants │
// All rights are reserved. │
// Author ......: Greg Rice │
//═══════════════════════════════════════════════════════╛
#include "inkey.ch"
#include "dbstruct.ch"
#include "nccview.ch"
#include "fileio.ch"
#include "mouse.ch"
#include "g_menu.ch"
#define BUFFER 250
#define CRLF Chr(13) + chr(10)
#define ON 1
#define OFF 0
#define TO_SAVE 1
#define TO_OPEN 2
Function g_DataClose()
dbCloseArea()
WinFilename( , "" )
WinIndexfiles( , {""} )
WinViewFields( , {""} )
WinViewStru( , {""} )
ShowBackGround()
OpenDesktop()
Return( NIL )
Function g_DataOpen()
local GetList := {} , ;
xFile := "*.DBF" + space( BUFFER - 5 ) , ;
sCursor := Set(_SET_CURSOR) , ;
nWorkArea := Current_Window() , ;
sColor := SetColor() , ;
cScreen := savescreen() , ;
scrn := savescreen(maxrow()-5,0,maxrow(),79) , ;
Mouse := MouseSys() , ;
nPos := 0 , ;
i
for i = 1 to len(windows())
if empty(alias(i))
nWorkArea := i
exit
endif
next
SetColor( popup_color() )
WinBox(maxrow()-5,03,maxrow()-2,31,0,4,.t.)
@ maxrow()-4,05 say 'Open Database Window #' get nWorkArea pict '##'
@ maxrow()-3,05 say 'File: ' get xFile picture '@KS18'
@ maxrow(),0 say ' Enter the database file name. Wildcards are Ok.' color 'w+/r'
Set Cursor On
Read
Set( _SET_CURSOR, sCursor )
Setcolor( sColor )
if lastkey() # K_ESC
if nWorkArea > 0 .and. nWorkArea < 11
While "?" $ xFile .or. "*" $ xFile
setcolor( popup_color() )
xFile := DirPick( xFile,,42 )
SetColor( sColor )
Enddo
xFile := rtrim(trim(xFile))
nPos := Rat( ".", xFile )
xFile := SUBSTR(xFile, 1, nPos-1)
if select(Substr(xFile,1,nPos-1)) != 0
SetColor( "W+/R" )
WinBox(9,19,15,62,,5,.t.)
@ 11,22 say 'This file is already open in a window.'
@ 13,24 say 'Click the mouse or press any key'
Mouse:ClearButtons()
Mouse:Show()
While Mouse:Button == 0 .and. Mouse:Ascii == 0
Mouse:Update()
Enddo
Mouse:Hide()
SetColor( sColor )
restscreen(,,,,cScreen)
Return( NIL )
endif
if File( xFile ) .or. File( xFile + '.DBF' )
Sele (nWorkArea)
dbCloseArea()
WinFilename(nWorkArea , "" )
WinIndexfiles(nWorkArea , {""} )
WinViewFields(nWorkArea , {""} )
WinViewStru(nWorkArea , {""} )
Sele (nWorkArea)
if ffshare( xFile )
WinFilename(nWorkArea , uppe(ltrim(trim(xFile))) )
WinViewFields(nWorkArea , stru_load(dbstruct()) )
WinViewStru( nWorkArea, dbstruct() )
Window_Active( .t. )
Current_Window( nWorkArea )
endif
elseif ! lastkey() == K_ESC
NccMesg( 'File not Found... Press any key', maxrow(), 'center')
Mouse:ClearButtons()
Mouse:Show()
While Mouse:Button == 0 .and. Mouse:Ascii == 0
Mouse:Update()
Enddo
Mouse:Hide()
endif
endif
endif
SetColor( sColor )
restscreen(maxrow()-5,0,maxrow(),79,scrn)
Return( NIL )
Function g_DispStru()
local xh := setcolor(), scrn := savescreen(), n := {}, xTop
AEVAL(dbstruct(),{ |fi_stru| aadd(n,space(1)+;
padr(fi_stru[DBS_NAME],10,' ')+ ;
space(5)+fi_stru[DBS_TYPE]+space(5)+;
str(fi_stru[DBS_LEN],3)+space(5)+ ;
str(fi_stru[DBS_DEC],3)+' ') })
setColor( popup_color() )
xTop := int(((maxrow()/2) - 4 ))
arraydsp( n, ;
'Fieldname Type Len Dec', ;
'File Structure' ;
,xTop,21,xTop+09,55, ;
0, ;
0, ;
.t., ;
, ;
{ |o| dView_MouseReader(o,xTop,21,xTop+09,55) ;
} ;
)
restscreen(,,,,scrn)
setcolor( xh )
Return( NIL )
//───────────────────────────────────────────────────────────────────┐
// Function g_FView( fname, tophead, LineLength, TabOffset, start) │
//───────────────────────────────────────────────────────────────────┘
Function g_FView( fname, tophead, LineLength, TabOffset, start, mHelp )
local x, v, h, nKey, scrn := savescreen( 1, 0, maxrow(), 79), ;
rscreen, handle, Mouse := MouseSys(), Button, Row, nPos, ;
Column, Escrn, sColor := SetColor(), GetList := {}, ;
xTFile := "*.TXT" + space(13), sCursor := Set(_SET_CURSOR)
local clr := {;
"", ; // main
"", ; // hBar
"", ; // vBar
"", ; // Ruler
"", ; // hBarHighLight
"" ; // vBarHighLight
}
ShowBackGround()
start := 0
if ! mHelp
@ maxrow(),0 say ' Enter the file name. Wildcards are ok.' color 'w+/r'
SetColor( popup_color() )
WinBox(maxrow()-5,03,maxrow()-3,36,0,4,.t.)
@ maxrow()-4,05 say 'File Name :' get xTFile picture '@KS25'
Set Cursor On
Read
Set( _SET_CURSOR, sCursor )
Setcolor( sColor )
ShowBackGround()
if LastKey() == K_ESC
restscreen( 1, 0, maxrow(), 79, scrn)
Return( NIL )
endif
fname := ltrim(trim(xTFile))
endif
if (handle := fopen(fname, FO_READ)) == -1
@ maxrow(),0 say ' Select a Text file with the mouse or keyboard.' color 'w+/r'
sColor := Setcolor()
While "?" $ fname .or. "*" $ fname
setcolor( popup_color() )
fname := DirPick( fname,,44 )
SetColor( sColor )
Enddo
if LastKey() == K_ESC
restscreen( 1, 0, maxrow(), 79, scrn)
Return( NIL )
endif
fname := ltrim(trim(fname))
nPos := Rat( ".", fname )
tophead := SUBSTR(fname, 1, nPos+4)
if (handle := fopen(fname, FO_READ)) == -1
NccPopUp('\nUnable to Open File\nPress any key to continue...\n', ;
Popup_Color(), 5 )
restscreen( 1, 0, maxrow(), 79, scrn)
Return( NIL )
endif
else
if (handle := fopen(fname, FO_READ)) == -1
NccPopUp('\nUnable to Open File\nPress any key to continue...\n', ;
Popup_Color(), 5 )
restscreen( 1, 0, maxrow(), 79, scrn)
Return( NIL )
endif
endif
if iscolor()
clr[1] := 'W+/B'
clr[2] := 'W+/R'
clr[3] := 'W+/R'
clr[4] := 'N/G'
clr[5] := 'GR+'
clr[6] := 'GR+'
else
clr[1] := 'N/W'
clr[2] := 'N/W'
clr[3] := 'N/W'
clr[4] := 'N/W'
clr[5] := 'N'
clr[6] := 'N'
endif
SetColor(clr[1])
WinBox(3,2,21,75,,4,.t.)
@ 03,03 say "[■]═╡"
@row(),col() say " File Name: " + tophead color 'W/RB+'
@row(),col() say "╞"
fseek(handle,start,0)
x := dViewTXT():New(4,3,20,74,handle)
x:StatusBlock := { || "" }
x:InverseColor := setcolor()
x:TabDisplacement := if(TabOffset == nil, 10, val(TabOffset) )
x:MaxLineLen := if(LineLength == nil, 512, val(LineLength) )
SetColor(clr[2])
v := NccVBar():New( 4,75,20,75, x:FileLen )
v:InverseColor := clr[5]
SetColor(clr[3])
h := NccHBar():New( 21,03,21,74, x:MaxLineLen - x:LeftPosition )
h:InverseColor := clr[6]
SetColor(clr[1])
x:Activate()
v:Activate()
h:Activate()
@ maxrow(),0 say ' Use the or PGUP/PGDN keys to Navigate or use the mouse on the corner arrows' color 'w+/r'
Mouse:Activate()
Mouse:Delay := 0
while .t.
x:Stabilize()
SetColor(clr[1])
v:Update( x:FilePos )
h:Update( x:LeftPosition )
Mouse:MouseRead()
if Mouse:Ascii # 0
nKey := Mouse:Ascii
else
Button := Mouse:Button
Row := Mouse:Row
Column := Mouse:Column
Do Case
Case Button == 2
Exit
Case Button == 1 .and. Row == 3 .and. Column == 4
Exit
Case Button == 1 .and. Row == 4 .and. Column == 75
x:Home() ; x:Up()
Case Button == 1 .and. Row == 20 .and. Column == 75
x:End() ; x:Down()
Case Button == 1 .and. Row == 21 .and. Column == 3
x:Left() // ; h:Update(x:LeftPosition)
Case Button == 1 .and. Row == 21 .and. Column == 74
x:Right() // ; h:Update(x:LeftPosition)
Case Button == 1 .and. ( Row >= 4 .and. Row <= 19 .and. Column == 75 )
if v:nOnBar > Row
x:Home() ; x:PageUp() // x:Up(x:FilePos - Row)
else
x:End() ; x:PageDown() // x:Down(Row - x:FilePos)
endif
EndCase
LOOP
endif
Do Case
Case nKey == K_ESC
exit
Otherwise
if nKey == K_DOWN .or. nKey == K_CTRL_PGDN .or. nKey == K_PGDN
x:End()
elseif nKey == K_UP .or. nKey == K_CTRL_PGUP .or. nKey == K_PGUP
x:Home()
elseif nKey == K_LEFT
x:Left()
elseif nKey == K_RIGHT
x:Right()
endif
x:StandardKeys( nKey )
EndCase
enddo
fclose(handle)
restscreen( 1, 0, maxrow(), 79, scrn)
Return ( NIL )
//────────────────────┐
// Create New DBF │
//────────────────────┘
Function g_DataNew( mNew )
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 , ;
aNewField := ARRAY(1,4) , ;
aPickDisp := {} , ;
aPickFull := {} , ;
aPickRef := {} , ;
aNewStru := {} , ;
nExitKeys := { 97, 65, K_F10, K_INS , K_DEL } , ;
dbF_structure := ACLONE( WinViewStru() ) , ;
dbstruct := dbstruct() , ;
mSelect := Select() , ;
mFile := ALIAS()
/*
if mNew // Empty(alias())
SELECT 11
CREATE nccviews.ext
* add first new field as yet undefined
APPEND BLANK
REPLACE field_name WITH "NewField", field_type WITH "C",;
field_len WITH 10,field_dec WITH 0
USE
SELECT 11
CREATE xtemp.dbf FROM nccviews.ext
if File('nccviews.ext')
Delete File nccviews.ext
endif
dbF_structure := dbstruct()
dbstruct := dbstruct()
else
if Empty(alias())
Return( NIL )
endif
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
FieldEdit( @aPickDisp, nFieldSele )
Case nKey == K_INS .or. nKey == 48 .or. uppe(chr(nKey)) == 'A'
aNewField[1][ DBS_NAME ] := "NEWFIELD2"
aNewField[1][ DBS_TYPE ] := "C"
aNewField[1][ DBS_LEN ] := 10
aNewField[1][ DBS_DEC ] := 0
IF uppe(chr(nKey)) == 'A'
aadd(aPickDisp,space(7)+padr(aNewField[1,DBS_NAME],10,' ')+ ;
space(4)+aNewField[1,DBS_TYPE]+space(4)+;
str(aNewField[1,DBS_LEN],3)+space(4)+ ;
str(aNewField[1,DBS_DEC],3)+' ')
aadd(dbF_structure,{ "NEWFIELD2", "C", 10, 0 })
nFieldSele := len(aPickDisp)
ELSE
aadd(aPickDisp,NIL)
aadd(dbF_structure,NIL)
ains(aPickDisp,nFieldSele)
ains(dbF_structure,nFieldSele)
aPickDisp[nFieldSele] := space(7)+;
padr(aNewField[1,DBS_NAME],10,' ')+ ;
space(4)+aNewField[1,DBS_TYPE]+space(4)+;
str(aNewField[1,DBS_LEN],3)+space(4)+ ;
str(aNewField[1,DBS_DEC],3)+' '
dbF_structure[nFieldSele] := dbstruct[aNewField]
END
// InsSele := if(InsSele < len(aPickFull),InsSele+1,InsSele)
nCounter++
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)
Case nKey == K_F10
NccMesg(' Wait...Creating table ',07+min(maxrow()-14,nCounter),;
'center,04,43')
if File('ncctemp.dbf')
Delete File ncctemp.dbf
endif
DBCREATE("ncctemp",dbF_structure)
SELECT(mSelect)
USE
SELECT 11
USE ncctemp
APPEND FROM (mFile)
mFile := mFile + ".dbf"
if File(mFile)
Delete File (mFile)
endif
USE
RENAME 'ncctemp.dbf' TO (mFile)
ok := .t.
exit
Otherwise
exit
EndCase
END
IF ok
g_DataClose()
ELSE
restscreen(,,,,FullScreen)
SetColor( cColor )
ENDIF
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> <F10-Save>',11+min(maxrow()-14,len( aArray )),'center,03,45')
Return( NIL )
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 FieldEdit( aPickDisp, nFieldSele )
Local sCursor := Set( _SET_CURSOR ), GetList := {}
@ row(), col() get aPickDisp[nFieldSele]
set cursor on
Read
set( _SET_CURSOR, sCursor )
Return( NIL )