From 99aa934ff6741f21207e1c443be360b5a3f88d37 Mon Sep 17 00:00:00 2001 From: "Alexander S.Kresin" Date: Fri, 20 Apr 2001 15:03:37 +0000 Subject: [PATCH] 2001-04-20 19:00 GMT+3 Alexander Kresin --- harbour/ChangeLog | 11 + harbour/contrib/libmisc/dbftools.c | 19 +- harbour/contrib/mysql/mysql.c | 29 +- harbour/tests/db_brows.ch | 69 ++- harbour/tests/db_brows.prg | 800 ++++++++++++----------------- 5 files changed, 426 insertions(+), 502 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 7aeeb2bc8e..8dcd551490 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,14 @@ +2001-04-20 19:00 GMT+3 Alexander Kresin + * contrib/libmisc/dbftools.c + * fieldtype() fixed accordingly to RDD changes + * contrib/mysql/mysql.c + * sqlConnect() fixed for version older than 3.22.34 + + added support for mysql_affected_rows() and mysql_field_count() + * tests/db_brows.ch + * tests/db_brows.prg + * some improvements + + 2001-04-20 16:30 CET Martin Vogel + contrib/libct/charop.c diff --git a/harbour/contrib/libmisc/dbftools.c b/harbour/contrib/libmisc/dbftools.c index 2b920fe6cb..5d89b3c091 100644 --- a/harbour/contrib/libmisc/dbftools.c +++ b/harbour/contrib/libmisc/dbftools.c @@ -46,7 +46,24 @@ HB_FUNC( FIELDTYPE ) pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); pField = pArea->lpFields + uiField - 1; - hb_retc( ( char * ) &( pField->uiType ) ); + switch( pField->uiType ) + { + case HB_IT_STRING: + hb_retc( "C" ); + break; + case HB_IT_LONG: + hb_retc( "N" ); + break; + case HB_IT_DATE: + hb_retc( "D" ); + break; + case HB_IT_LOGICAL: + hb_retc( "L" ); + break; + case HB_IT_MEMO: + hb_retc( "M" ); + break; + } } HB_FUNC( FIELDSIZE ) diff --git a/harbour/contrib/mysql/mysql.c b/harbour/contrib/mysql/mysql.c index 11f55ac745..29f46c1510 100644 --- a/harbour/contrib/mysql/mysql.c +++ b/harbour/contrib/mysql/mysql.c @@ -70,18 +70,27 @@ HB_FUNC(SQLCONNECT) // MYSQL *mysql_real_connect(MYSQL*, char * host, char * user, char * password, char * db, uint port, char *, uint flags) { - MYSQL * mysql = NULL; + MYSQL * mysql; #if MYSQL_VERSION_ID > 32200 /* from 3.22.x of MySQL there is a new parameter in mysql_real_connect() call, that is char * db which is not used here */ - if ( (mysql = mysql_init((MYSQL*) 0)) ) - mysql_real_connect( mysql, _parc(1), _parc(2), _parc(3), NULL, 0, NULL, 0); + if ( (mysql = mysql_init((MYSQL*) 0)) ) + { + if( mysql_real_connect( mysql, _parc(1), _parc(2), _parc(3), NULL, 0, NULL, 0) ) + _retnl((long) mysql); + else + { + mysql_close( mysql ); + _retnl( 0 ); + } + } + else + _retnl( 0 ); #else - mysql = mysql_real_connect(NULL, _parc(1), _parc(2), _parc(3), 0, NULL, 0); -#endif - + mysql = mysql_real_connect(NULL, _parc(1), _parc(2), _parc(3), 0, NULL, 0); _retnl((long) mysql); +#endif } @@ -220,6 +229,10 @@ HB_FUNC(SQLNUMFI) // unsigned int mysql_num_fields(MYSQL_RES *) _retnl(mysql_num_fields(((MYSQL_RES *)_parnl(1)))); } +HB_FUNC(SQLFICOU) // unsigned int mysql_num_fields(MYSQL_RES *) +{ + _retnl(mysql_field_count(((MYSQL *)_parnl(1)))); +} HB_FUNC(SQLLISTF) // MYSQL_RES *mysql_list_fields(MYSQL *, char *); { @@ -294,3 +307,7 @@ HB_FUNC(SQLAND) _retnl(_parnl(1) & _parnl(2)); } +HB_FUNC(SQLAFFROWS) +{ + _retnl( mysql_affected_rows( (MYSQL *)_parnl(1) ) ); +} diff --git a/harbour/tests/db_brows.ch b/harbour/tests/db_brows.ch index a46f1b17c8..b5b7e0e890 100644 --- a/harbour/tests/db_brows.ch +++ b/harbour/tests/db_brows.ch @@ -2,29 +2,46 @@ * $Id$ */ // Header file for db_brows.prg -#define KLRECF 200 -#define LI_LEN 24 -#define LI_NSTR mslist[1] -#define LI_CLR mslist[2] // Color of a window -#define LI_CLRV mslist[3] // Color of a current line -#define LI_BSKIP mslist[4] // Codeblock for a 'skip' operation -#define LI_BGTOP mslist[5] // Codeblock for a 'go top' -#define LI_BGBOT mslist[6] // Codeblock for a 'go bottom' -#define LI_BEOF mslist[7] // Codeblock for a 'eof' checking -#define LI_BBOF mslist[8] // Codeblock for a 'bof' checking -#define LI_B1 mslist[9] -#define LI_MSF mslist[10] // Array of codeblocks for columns -#define LI_NAMES mslist[11] // Array of the fields names -#define LI_NMCLR mslist[12] // Color of field names line -#define LI_FREEZE mslist[13] // Number of fields to 'freeze' from left -#define LI_RCOU mslist[14] -#define LI_MSREC mslist[15] -#define LI_PRFLT mslist[16] -#define LI_TEKZP mslist[17] -#define LI_KOLZ mslist[18] -#define LI_VALID mslist[19] // Array of codeblocks for postvalidation while changing a field -#define LI_WHEN mslist[20] // Array of codeblocks for prevalidation while changing a field -#define LI_MSNAME mslist[21] -#define LI_MSTYP mslist[22] -#define LI_MSLEN mslist[23] -#define LI_MSDEC mslist[24] \ No newline at end of file +#define LI_LEN 42 +#define LI_NSTR mslist[1] +#define LI_CLR mslist[2] // Color of a window +#define LI_CLRV mslist[3] // Color of a current line +#define LI_BSKIP mslist[4] // Codeblock for a 'skip' operation +#define LI_BGTOP mslist[5] // Codeblock for a 'go top' +#define LI_BGBOT mslist[6] // Codeblock for a 'go bottom' +#define LI_BEOF mslist[7] // Codeblock for a 'eof' checking +#define LI_BBOF mslist[8] // Codeblock for a 'bof' checking +#define LI_B1 mslist[9] +#define LI_MSF mslist[10] // Array of codeblocks for columns +#define LI_NAMES mslist[11] // Array of the fields names +#define LI_NMCLR mslist[12] // Color of field names line +#define LI_FREEZE mslist[13] // Number of fields to 'freeze' from left +#define LI_RCOU mslist[14] +#define LI_MSREC mslist[15] +#define LI_PRFLT mslist[16] +#define LI_TEKZP mslist[17] +#define LI_KOLZ mslist[18] +#define LI_VALID mslist[19] // Array of codeblocks for postvalidation while changing a field +#define LI_WHEN mslist[20] // Array of codeblocks for prevalidation while changing a field +#define LI_MSNAME mslist[21] +#define LI_MSTYP mslist[22] +#define LI_MSLEN mslist[23] +#define LI_MSDEC mslist[24] +#define LI_EXPFI mslist[25] +#define LI_BDESHIN mslist[26] +#define LI_BDESHOUT mslist[27] +#define LI_RECNO mslist[28] +#define LI_BGOTO mslist[29] +#define LI_Y1 mslist[30] +#define LI_X1 mslist[31] +#define LI_Y2 mslist[32] +#define LI_X2 mslist[33] +#define LI_LSOHR mslist[34] +#define LI_LVIEW mslist[35] +#define LI_NCOLUMNS mslist[36] +#define LI_LEFTVISIBLE mslist[37] +#define LI_NLEFT mslist[38] +#define LI_COLPOS mslist[39] +#define LI_XPOS mslist[40] +#define LI_MSED mslist[41] +#define LI_COLCOUNT mslist[42] \ No newline at end of file diff --git a/harbour/tests/db_brows.prg b/harbour/tests/db_brows.prg index 1da1c4f9f2..cd99ca5c28 100644 --- a/harbour/tests/db_brows.prg +++ b/harbour/tests/db_brows.prg @@ -8,44 +8,35 @@ *+ *+ Date : 30/09/1999 *+ Time : 19:20 -*+ *+ Placed in the public domain *+ -*+ Source Module => DB_BROWSE.PRG +*+ To compile it you need to build libmisc.lib from /contrib/libmisc +*+ +*+ Source Module => DB_BROWS.PRG *+ *+ Functions: Function Main() *+ Function DBFLIST() +*+ Function DBFLIST() *+ Function FLDCOUNT() -*+ Function MSFNEXT() -*+ Procedure MSFBACK() *+ Function VIVNAMES() *+ Function WNDVIVOD() -*+ Procedure VIVSTR() +*+ Static Procedure VIVSTR() *+ Function FLDSTR() +*+ Function GetBuf() *+ Function InitList() -*+ Function FGOTOP() -*+ Function FGOBOT() -*+ Procedure FSKIP() -*+ Function FBOF() -*+ Function FEOF() -*+ Procedure FLMSFLD() *+ Function Defpict() *+ Function NUM_STR() -*+ Function readexit() -*+ Function updated() *+ *+ Tables: USE &filename *+ -*+ Reformatted by Click! 2.00 on Sep-30-1999 at 7:17 pm +*+ Reformatted by Click! 2.00 on Apr-20-2001 at 11:46 am *+ *+膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊膊 #include "fileio.ch" #include "db_brows.ch" -MEMVAR mslist,x1,y1,x2,y2,title,maskey -MEMVAR kolfld, firstfld, prmsf -MEMVAR klfs, razmer, numfld, xfld, first_f, str_bar +MEMVAR str_bar *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ @@ -54,19 +45,16 @@ MEMVAR klfs, razmer, numfld, xfld, first_f, str_bar *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ FUNCTION Main( filename ) - -LOCAL vybkey -PRIVATE mslist[ LI_LEN ] - IF filename = Nil - ? 'You should sign filename to browse in command line.' +LOCAL vybkey := 1 + IF filename == Nil + ? 'Dbf browse demo' + ? 'Syntax:' + ? '','db_brows filename' QUIT ENDIF - // select a USE &filename - Initlist() - vybkey := 1 DO WHILE vybkey <> 0 - vybkey := DBFLIST( 3, 1, 76, 20, filename ) + vybkey := DBFLIST(, 3, 1, 76, 20, filename ) DO CASE CASE vybkey = 13 // Enter // ... @@ -76,125 +64,142 @@ PRIVATE mslist[ LI_LEN ] // ... ENDCASE ENDDO -RETURN Nil + RETURN Nil *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ *+ Function DBFLIST() *+ -*+ Called from ( sample.prg ) 1 - function main() +*+ Called from ( db_brows.prg ) 1 - function main() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -FUNCTION DBFLIST - -LOCAL rezproc, xkey, rez, fipos, wndbuf, oldcolors, ym, xm, i -LOCAL prview, prsohr, predit, predxx -LOCAL fbar1, fbar2, vartmp, varbuf -LOCAL GetList := {} #ifdef VER_MOUSE - PARAMETERS x1,y1,x2,y2,title,maskey,ctrl_ar +FUNCTION DBFLIST( mslist, x1, y1, x2, y2, title, maskey, ctrl_ar ) #else - PARAMETERS x1,y1,x2,y2,title,maskey +FUNCTION DBFLIST( mslist, x1, y1, x2, y2, title, maskey ) #endif -PRIVATE kolfld, firstfld, prmsf -PRIVATE klfs, razmer, numfld, xfld, first_f + +LOCAL rezproc, xkey, rez, fipos, wndbuf, predit, predxx, oldcolors +LOCAL ym, xm, i +LOCAL fbar1, fbar2, vartmp, varbuf, razmer +LOCAL GetList := {} + +MEMVAR str_bar + + IF mslist == Nil + mslist := InitList() + ENDIF IF TYPE( "str_bar" ) <> "C" - PRIVATE str_bar := "" +PRIVATE str_bar := "" ENDIF - IF x1 > 99 - x1 := x1 - 100 - prsohr := .F. + LI_Y1 := y1 + LI_X1 := x1 + LI_Y2 := y2 + LI_X2 := x2 + IF LI_MSF == Nil + LI_COLCOUNT := FCOUNT() ELSE - prsohr := .T. - ENDIF - IF y1 > 99 - y1 := y1 - 100 - prview := .T. - ELSE - prview := .F. - ENDIF - klfs := FCOUNT() - numfld := LI_MSF - IF VALTYPE( numfld ) = "N" - predxx := predit := LI_MSF - prmsf := .F. - ELSE - predxx := predit := IIF( ASCAN( LI_MSF, 3 ) <> 0, 3, IIF( ASCAN( LI_MSF, 2 ) <> 0, 2, 1 ) ) - prmsf := .T. - i := LEN( LI_MSF ) - DO WHILE i > 0 .AND. LI_MSF[ i ] = Nil - i -- - ENDDO - IF i < LEN( LI_MSF ) - klfs := i + LI_COLCOUNT := LEN( LI_MSF ) + IF LI_MSTYP == Nil + LI_MSTYP := ARRAY( LI_COLCOUNT ) + LI_MSLEN := ARRAY( LI_COLCOUNT ) + LI_MSDEC := ARRAY( LI_COLCOUNT ) + FOR i := 1 TO LI_COLCOUNT + IF VALTYPE( LI_MSF[ i ] ) == "B" + vartmp := EVAL( LI_MSF[ i ], mslist, i ) + LI_MSTYP[ i ] := VALTYPE( vartmp ) + IF LI_MSTYP[ i ] == "C" + LI_MSLEN[ i ] := LEN( vartmp ) + ELSEIF LI_MSTYP[ i ] == "N" + vartmp := STR( vartmp ) + LI_MSLEN[ i ] := LEN( vartmp ) + LI_MSDEC[ i ] := IIF( '.' $ vartmp, LI_MSLEN[ i ] - AT( '.', vartmp ), 0 ) + ELSEIF LI_MSTYP[ i ] == "D" + LI_MSLEN[ i ] := 8 + ELSEIF LI_MSTYP[ i ] == "L" + LI_MSLEN[ i ] := 1 + ENDIF + ELSE + LI_MSTYP[ i ] := FieldType( FIELDPOS( LI_MSF[ i ] ) ) + ENDIF + NEXT ENDIF ENDIF - IF predit > 1 - SET CURSOR ON + IF VALTYPE( LI_MSED ) = "N" + predxx := predit := LI_MSED ELSE - SET CURSOR OFF + predxx := predit := IIF( ASCAN( LI_MSED, 3 ) <> 0, 3, IIF( ASCAN( LI_MSED, 2 ) <> 0, 2, 1 ) ) ENDIF + SET CURSOR ( predit > 1 ) SET EXACT OFF - IF prsohr - wndbuf := SAVESCREEN( y1, x1, y2, x2 ) + IF LI_LSOHR + wndbuf := SAVESCREEN( LI_Y1, LI_X1, LI_Y2, LI_X2 ) ENDIF oldcolors := SETCOLOR() SETCOLOR( LI_CLR ) - @ y1, x1, y2, x2 BOX "谀砍倌莱 " + @ LI_Y1, LI_X1, LI_Y2, LI_X2 BOX "谀砍倌莱 " IF title <> Nil - @ y1, ( x2 - x1 - 1 - LEN( title ) ) / 2 + x1 SAY " " + title + " " + @ LI_Y1, ( LI_X2 - LI_X1 - 1 - LEN( title ) ) / 2 + LI_X1 SAY " " + title + " " ENDIF IF title <> Nil .AND. LI_NAMES <> Nil - y1 ++ + LI_Y1 ++ ENDIF - razmer := y2 - y1 - 1 + razmer := LI_Y2 - LI_Y1 - 1 IF .NOT. LI_PRFLT - LI_KOLZ := EVAL( LI_RCOU ) + LI_KOLZ := EVAL( LI_RCOU, mslist ) ENDIF - STORE 1 TO numfld - firstfld := LI_FREEZE + 1 - firstfld := MSFNEXT( firstfld ) - first_f := firstfld + LI_COLPOS := 1 + LI_NLEFT := LI_FREEZE + 1 + // DO MSFNEXT WITH mslist,LI_NLEFT + LI_LEFTVISIBLE := LI_NLEFT STORE .T. TO rez - kolfld := FLDCOUNT( x1 + 2, x2 - 2, firstfld ) - VIVNAMES( firstfld ) - IF EVAL( LI_BEOF ) - EVAL( LI_BGTOP ) + LI_NCOLUMNS := FLDCOUNT( mslist, LI_X1 + 2, LI_X2 - 2, LI_NLEFT ) + VIVNAMES( mslist, LI_NLEFT ) + IF EVAL( LI_BEOF, mslist ) + EVAL( LI_BGTOP, mslist ) LI_NSTR := 1 ELSE - EVAL( LI_BSKIP, - ( LI_NSTR - 1 ) ) - IF EVAL( LI_BBOF ) + EVAL( LI_BSKIP, mslist, - ( LI_NSTR - 1 ) ) + IF EVAL( LI_BBOF, mslist ) + EVAL( LI_BGTOP, mslist ) LI_NSTR := 1 ENDIF ENDIF - WNDVIVOD() - EVAL( LI_BSKIP, ( LI_NSTR - 1 ) ) + WNDVIVOD( mslist ) + EVAL( LI_BSKIP, mslist, ( LI_NSTR - 1 ) ) IF LI_KOLZ = 0 .AND. predit = 3 LI_NSTR := 0 KEYBOARD CHR( 24 ) ENDIF DO WHILE rez SETCOLOR( LI_CLR ) - EVAL( LI_B1 ) + EVAL( LI_B1, mslist ) // IF predit>1 - // SETCOLOR(LI_CLRV+"*") // 傠ぅ忪 徕喈 + // SETCOLOR(LI_CLRV+"*") && 傠ぅ忪 徕喈 // ELSE SETCOLOR( LI_CLRV ) // ENDIF - VIVSTR( firstfld, LI_NSTR + y1, IF( predit > 1, numfld, 0 ) ) + VIVSTR( mslist, LI_NSTR + LI_Y1, IIF( predit > 1, LI_COLPOS, 0 ) ) SETCOLOR( LI_CLR ) // 摗酄忪 ㈦ぅ -/* - IF .NOT. ( TYPE("Sx_Keyno()") == "U") - @ y1+2,x2,y2-2,x2 BOX LEFT(str_bar,1) - @ y1+1,x2 SAY SUBSTR(str_bar,2,1) - @ y2-1,x2 SAY SUBSTR(str_bar,2,1) - fbar1="Sx_Keyno()" - fbar2="Sx_KeyCount()" - @ y1+2+INT(IIF(LI_PRFLT,LI_TEKZP,&fbar1)*(y2-y1-4)/IIF(LI_PRFLT,LI_KOLZ,&fbar2)),x2 SAY RIGHT(str_bar,1) - ENDIF -*/ - IF prview + // +#ifdef RDD_AX + @ LI_Y1 + 2, LI_X2, LI_Y2 - 2, LI_X2 BOX LEFT( str_bar, 1 ) + @ LI_Y1 + 1, LI_X2 SAY SUBSTR( str_bar, 2, 1 ) + @ LI_Y2 - 1, LI_X2 SAY SUBSTR( str_bar, 2, 1 ) + @ LI_Y1 + 2 + INT( IIF( LI_PRFLT, LI_TEKZP, Ax_Keyno() ) * ( LI_Y2 - LI_Y1 - 4 ) / IIF( LI_PRFLT, LI_KOLZ, Ax_KeyCount() ) ), LI_X2 SAY RIGHT( str_bar, 1 ) +#else + IF .NOT. ( TYPE( "Sx_Keyno()" ) == "U" ) + @ LI_Y1 + 2, LI_X2, LI_Y2 - 2, LI_X2 BOX LEFT( str_bar, 1 ) + @ LI_Y1 + 1, LI_X2 SAY SUBSTR( str_bar, 2, 1 ) + @ LI_Y2 - 1, LI_X2 SAY SUBSTR( str_bar, 2, 1 ) + fbar1 := "Sx_Keyno()" + fbar2 := "Sx_KeyCount()" + @ LI_Y1 + 2 + INT( IIF( LI_PRFLT, LI_TEKZP, &fbar1 ) * ( LI_Y2 - LI_Y1 - 4 ) / IIF( LI_PRFLT, LI_KOLZ, &fbar2 ) ), LI_X2 SAY RIGHT( str_bar, 1 ) + ENDIF +#endif + // + IF LI_LVIEW xkey := 27 ELSE #ifdef VER_MOUSE @@ -206,13 +211,13 @@ PRIVATE klfs, razmer, numfld, xfld, first_f ELSEIF xkey = 501 ym := M_YTEXT() xm := M_XTEXT() - IF ( ym <= y1 .OR. ym >= y2 .OR. xm <= x1 .OR. xm >= x2 ) - IF xm <= x2 .AND. xm >= x1 .AND. ( ym = y1 .OR. ym = y2 ) + IF ( ym <= LI_Y1 .OR. ym >= LI_Y2 .OR. xm <= LI_X1 .OR. xm >= LI_X2 ) + IF xm <= LI_X2 .AND. xm >= LI_X1 .AND. ( ym = LI_Y1 .OR. ym = LI_Y2 ) M_SHOW() i := SECONDS() DO WHILE SECONDS() - i < 0.05 ENDDO - KEYBOARD CHR( IIF( ym = y1, 5, 24 ) ) + KEYBOARD CHR( IIF( ym = LI_Y1, 5, 24 ) ) M_HIDE() LOOP ELSEIF ctrl_ar <> Nil @@ -238,125 +243,128 @@ PRIVATE klfs, razmer, numfld, xfld, first_f xkey := INKEY( 0 ) #endif ENDIF - VIVSTR( firstfld, LI_NSTR + y1, 0 ) // 徕喈 + VIVSTR( mslist, LI_NSTR + LI_Y1, 0 ) // 徕喈 IF xkey < 500 DO CASE CASE xkey = 24 // 娿噌 ě - IF ( LI_KOLZ > 0 .OR. predit = 3 ) .AND. ( LI_KOLZ = 0 .OR. .NOT. EVAL( LI_BEOF ) ) - EVAL( LI_BSKIP, 1 ) - IF EVAL( LI_BEOF ) .AND. ( predit < 3 .OR. LI_PRFLT ) - EVAL( LI_BSKIP, - 1 ) + IF ( LI_KOLZ > 0 .OR. predit = 3 ) .AND. ( LI_KOLZ = 0 .OR. .NOT. EVAL( LI_BEOF, mslist ) ) + EVAL( LI_BSKIP, mslist, 1 ) + IF EVAL( LI_BEOF, mslist ) .AND. ( predit < 3 .OR. LI_PRFLT ) + EVAL( LI_BSKIP, mslist, - 1 ) ELSE - IF EVAL( LI_BEOF ) - vartmp := firstfld - firstfld := first_f - numfld := first_f - kolfld := FLDCOUNT( x1 + 2, x2 - 2, firstfld ) - IF vartmp > first_f - EVAL( LI_BSKIP, - 1 ) - EVAL( LI_BSKIP, - ( LI_NSTR - 1 ) ) - WNDVIVOD() - EVAL( LI_BSKIP, LI_NSTR - 1 ) - EVAL( LI_BSKIP ) + IF EVAL( LI_BEOF, mslist ) + vartmp := LI_NLEFT + LI_NLEFT := LI_LEFTVISIBLE + LI_COLPOS := LI_LEFTVISIBLE + LI_NCOLUMNS := FLDCOUNT( mslist, LI_X1 + 2, LI_X2 - 2, LI_NLEFT ) + IF vartmp > LI_LEFTVISIBLE + EVAL( LI_BSKIP, mslist, - 1 ) + EVAL( LI_BSKIP, mslist, - ( LI_NSTR - 1 ) ) + WNDVIVOD( mslist ) + EVAL( LI_BSKIP, mslist, LI_NSTR - 1 ) + EVAL( LI_BSKIP, mslist ) ENDIF ENDIF LI_NSTR ++ IF LI_NSTR > razmer LI_NSTR := razmer - SCROLL( y1 + 1, x1 + 1, y2 - 1, x2 - 1, 1 ) - VIVSTR( firstfld, y2 - 1, 0 ) + SCROLL( LI_Y1 + 1, LI_X1 + 1, LI_Y2 - 1, LI_X2 - 1, 1 ) + VIVSTR( mslist, LI_Y2 - 1, 0 ) ENDIF - IF EVAL( LI_BEOF ) + IF EVAL( LI_BEOF, mslist ) KEYBOARD CHR( 13 ) ENDIF ENDIF ENDIF CASE xkey = 5 .AND. LI_KOLZ > 0 // 娿噌 ⅱム - EVAL( LI_BSKIP, - 1 ) - IF EVAL( LI_BBOF ) - EVAL( LI_BGTOP ) + EVAL( LI_BSKIP, mslist, - 1 ) + IF EVAL( LI_BBOF, mslist ) + EVAL( LI_BGTOP, mslist ) ELSE - LI_NSTR := LI_NSTR - 1 + LI_NSTR -- IF LI_NSTR = 0 LI_NSTR := 1 - SCROLL( y1 + 1, x1 + 1, y2 - 1, x2 - 1, - 1 ) - VIVSTR( firstfld, y1 + 1, 0 ) + SCROLL( LI_Y1 + 1, LI_X1 + 1, LI_Y2 - 1, LI_X2 - 1, - 1 ) + VIVSTR( mslist, LI_Y1 + 1, 0 ) ENDIF ENDIF CASE xkey = 4 .AND. LI_KOLZ <> 0 // 娿噌 酄 IF predit > 1 - IF numfld < kolfld - numfld ++ + IF LI_COLPOS < LI_NCOLUMNS + LI_COLPOS ++ LOOP ENDIF ENDIF - IF kolfld + firstfld - LI_FREEZE - 1 < klfs - i := firstfld + kolfld - DO WHILE kolfld + firstfld - LI_FREEZE - 1 < klfs .AND. firstfld + kolfld == i - firstfld ++ - firstfld := MSFNEXT( firstfld ) - kolfld := FLDCOUNT( x1 + 2, x2 - 2, firstfld ) + IF LI_NCOLUMNS + LI_NLEFT - LI_FREEZE - 1 < LI_COLCOUNT + i := LI_NLEFT + LI_NCOLUMNS + DO WHILE LI_NCOLUMNS + LI_NLEFT - LI_FREEZE - 1 < LI_COLCOUNT .AND. LI_NLEFT + LI_NCOLUMNS = i + LI_NLEFT ++ + // DO MSFNEXT WITH mslist,LI_NLEFT + LI_NCOLUMNS := FLDCOUNT( mslist, LI_X1 + 2, LI_X2 - 2, LI_NLEFT ) ENDDO - numfld := i - firstfld + 1 - EVAL( LI_BSKIP, - ( LI_NSTR - 1 ) ) - WNDVIVOD() - EVAL( LI_BSKIP, LI_NSTR - 1 ) + LI_COLPOS := i - LI_NLEFT + 1 + EVAL( LI_BSKIP, mslist, - ( LI_NSTR - 1 ) ) + WNDVIVOD( mslist ) + EVAL( LI_BSKIP, mslist, LI_NSTR - 1 ) ENDIF - VIVNAMES( firstfld ) + VIVNAMES( mslist, LI_NLEFT ) CASE xkey = 19 // 娿噌 ア IF predit > 1 - IF numfld <> 1 - numfld -- + IF LI_COLPOS <> 1 + LI_COLPOS -- LOOP ENDIF ENDIF - IF firstfld > first_f - firstfld -- - DO MSFBACK WITH firstfld - kolfld := FLDCOUNT( x1 + 2, x2 - 2, firstfld ) - numfld := 1 - EVAL( LI_BSKIP, - ( LI_NSTR - 1 ) ) - WNDVIVOD() - EVAL( LI_BSKIP, LI_NSTR - 1 ) + IF LI_NLEFT > LI_LEFTVISIBLE + LI_NLEFT -- + // DO MSFBACK WITH mslist,LI_NLEFT + LI_NCOLUMNS := FLDCOUNT( mslist, LI_X1 + 2, LI_X2 - 2, LI_NLEFT ) + LI_COLPOS := 1 + EVAL( LI_BSKIP, mslist, - ( LI_NSTR - 1 ) ) + WNDVIVOD( mslist ) + EVAL( LI_BSKIP, mslist, LI_NSTR - 1 ) ENDIF - VIVNAMES( firstfld ) + VIVNAMES( mslist, LI_NLEFT ) CASE xkey = 3 // PgDn - EVAL( LI_BSKIP, razmer - LI_NSTR + 1 ) + EVAL( LI_BSKIP, mslist, razmer - LI_NSTR + 1 ) LI_NSTR := 1 - IF EVAL( LI_BEOF ) - EVAL( LI_BSKIP, - 1 ) + IF EVAL( LI_BEOF, mslist ) + EVAL( LI_BSKIP, mslist, - 1 ) ENDIF - WNDVIVOD() + WNDVIVOD( mslist ) CASE xkey = 18 // PgUp IF LI_NSTR > 1 - EVAL( LI_BSKIP, - ( LI_NSTR - 1 ) ) + EVAL( LI_BSKIP, mslist, - ( LI_NSTR - 1 ) ) LI_NSTR := 1 ELSE - EVAL( LI_BSKIP, - razmer ) - IF EVAL( LI_BBOF ) - EVAL( LI_BGTOP ) + EVAL( LI_BSKIP, mslist, - razmer ) + IF EVAL( LI_BBOF, mslist ) + EVAL( LI_BGTOP, mslist ) ENDIF - WNDVIVOD() + WNDVIVOD( mslist ) ENDIF CASE xkey = 6 .AND. LI_KOLZ > 0 // End - EVAL( LI_BGBOT ) - EVAL( LI_BSKIP, - ( razmer - 1 ) ) - LI_NSTR := WNDVIVOD() - EVAL( LI_BSKIP, LI_NSTR - 1 ) + EVAL( LI_BGBOT, mslist ) + EVAL( LI_BSKIP, mslist, - ( razmer - 1 ) ) + IF EVAL( LI_BBOF, mslist ) + EVAL( LI_BGTOP, mslist ) + ENDIF + LI_NSTR := WNDVIVOD( mslist ) + EVAL( LI_BSKIP, mslist, LI_NSTR - 1 ) CASE xkey = 1 .AND. LI_KOLZ > 0 // Home LI_NSTR := 1 - EVAL( LI_BGTOP ) - WNDVIVOD() + EVAL( LI_BGTOP, mslist ) + WNDVIVOD( mslist ) CASE xkey = 13 .AND. predit < 2 // Enter rez := .F. rezproc := xkey CASE ( xkey = 13 .OR. ( xkey > 47 .AND. xkey < 58 ) .OR. ( xkey > 64 .AND. xkey < 91 ) ; .OR. ( xkey > 96 .AND. xkey < 123 ) .OR. ( xkey > 127 .AND. xkey < 176 ) .OR. ( xkey > 223 .AND. xkey < 240 ) ) .AND. predit > 1 // Enter // 惀ㄠ牠ē - fipos := numfld + firstfld - 1 - LI_FREEZE + fipos := LI_COLPOS + LI_NLEFT - 1 - LI_FREEZE IF LI_WHEN = Nil .OR. LEN( LI_WHEN ) < fipos .OR. LI_WHEN[ fipos ] = Nil .OR. EVAL( LI_WHEN[ fipos ] ) - IF prmsf - vartmp := IIF( LEN( LI_MSF ) < fipos, 1, LI_MSF[ fipos ] ) + IF VALTYPE( LI_MSED ) != "N" + vartmp := IIF( LEN( LI_MSED ) < fipos, 1, LI_MSED[ fipos ] ) IF VALTYPE( vartmp ) = "N" IF vartmp <> 2 LOOP @@ -368,19 +376,19 @@ PRIVATE klfs, razmer, numfld, xfld, first_f SET CURSOR ON SETCOLOR( LI_CLRV + "," + LI_CLRV ) IF xkey <> 13 - KEYBOARD CHR( xkey ) + KEYBOARD CHR( xkey ) + GetBuf() ENDIF vartmp := READEXIT( .T. ) varbuf := FIELDGET( fipos ) - @ LI_NSTR + y1, xfld GET varbuf PICTURE Defpict( fipos, x2 - x1 - 3 ) + @ LI_NSTR + LI_Y1, LI_XPOS GET varbuf PICTURE Defpict( mslist, fipos, LI_X2 - LI_X1 - 3 ) IF LI_VALID <> Nil .AND. LEN( LI_VALID ) >= fipos .AND. LI_VALID[ fipos ] <> Nil Getlist[ 1 ] :postBlock := LI_VALID[ fipos ] ENDIF READ IF LASTKEY() <> 27 .AND. UPDATED() - IF EVAL( LI_BEOF ) + IF EVAL( LI_BEOF, mslist ) APPEND BLANK - LI_KOLZ := EVAL( LI_RCOU ) + LI_KOLZ := EVAL( LI_RCOU, mslist ) ELSE IF .NOT. SET( _SET_EXCLUSIVE ) RLOCK() @@ -389,16 +397,19 @@ PRIVATE klfs, razmer, numfld, xfld, first_f ENDIF ENDIF ENDIF - FIELDPUT( fipos, varbuf ) + IF LI_BDESHOUT != Nil .AND. VALTYPE( varbuf ) == "C" + varbuf := EVAL( LI_BDESHOUT, mslist, varbuf ) + ENDIF +FIELDPUT( fipos, varbuf ) IF .NOT. SET( _SET_EXCLUSIVE ) UNLOCK ENDIF ENDIF - IF ( LASTKEY() = 27 .OR. .NOT. UPDATED() ) .AND. EVAL( LI_BEOF ) + IF ( LASTKEY() = 27 .OR. .NOT. UPDATED() ) .AND. EVAL( LI_BEOF, mslist ) SETCOLOR( LI_CLR ) - @ LI_NSTR + y1, x1 + 1 CLEAR TO LI_NSTR + y1, x2 - 1 + @ LI_NSTR + LI_Y1, LI_X1 + 1 CLEAR TO LI_NSTR + LI_Y1, LI_X2 - 1 LI_NSTR -- - EVAL( LI_BSKIP, - 1 ) + EVAL( LI_BSKIP, mslist, - 1 ) ELSE IF ( vartmp := LASTKEY() ) <> 13 .AND. vartmp <> 27 .AND. vartmp < 32 KEYBOARD CHR( vartmp ) @@ -426,25 +437,25 @@ PRIVATE klfs, razmer, numfld, xfld, first_f ENDCASE #ifdef VER_MOUSE ELSE - IF ym > y1 .AND. ym < y2 .AND. xm > x1 .AND. xm < x2 + IF ym > LI_Y1 .AND. ym < LI_Y2 .AND. xm > LI_X1 .AND. xm < LI_X2 IF predit < 2 - IF LI_NSTR = ym - y1 + IF LI_NSTR = ym - LI_Y1 rez := .F. rezproc := 13 ELSE - EVAL( LI_BSKIP, ym - y1 - LI_NSTR ) - LI_NSTR := ym - y1 + EVAL( LI_BSKIP, mslist, ym - LI_Y1 - LI_NSTR ) + LI_NSTR := ym - LI_Y1 ENDIF ELSE - i := FLDCOUNT( x1 + 2, xm, firstfld ) + 1 - IF i <= FLDCOUNT( x1 + 2, x2 - 2, firstfld ) - IF i = 2 .AND. xm < x1 + 2 + LEN( FLDSTR( firstfld + numfld - 1 ) ) + i := FLDCOUNT( mslist, LI_X1 + 2, xm, LI_NLEFT ) + 1 + IF i <= FLDCOUNT( mslist, LI_X1 + 2, LI_X2 - 2, LI_NLEFT ) + IF i = 2 .AND. xm < LI_X1 + 2 + LEN( FLDSTR( mslist, LI_NLEFT + LI_COLPOS - 1 ) ) i := 1 ENDIF - IF numfld <> i .OR. LI_NSTR <> ym - y1 - numfld := i - EVAL( LI_BSKIP, ym - y1 - LI_NSTR ) - LI_NSTR := ym - y1 + IF LI_COLPOS <> i .OR. LI_NSTR <> ym - LI_Y1 + LI_COLPOS := i + EVAL( LI_BSKIP, mslist, ym - LI_Y1 - LI_NSTR ) + LI_NSTR := ym - LI_Y1 ELSE KEYBOARD CHR( 13 ) ENDIF @@ -459,8 +470,11 @@ PRIVATE klfs, razmer, numfld, xfld, first_f ENDIF ENDDO - IF prsohr - RESTSCREEN( IIF( title <> Nil .AND. LI_NAMES <> Nil, y1 - 1, y1 ), x1, y2, x2, wndbuf ) + IF LI_LSOHR + RESTSCREEN( IIF( title <> Nil .AND. LI_NAMES <> Nil, LI_Y1 - 1, LI_Y1 ), LI_X1, LI_Y2, LI_X2, wndbuf ) + ELSE + SETCOLOR( LI_CLRV ) + VIVSTR( mslist, LI_NSTR + LI_Y1, IIF( predit > 1, LI_COLPOS, 0 ) ) ENDIF SETCOLOR( oldcolors ) SET CURSOR ON @@ -470,113 +484,53 @@ RETURN rezproc *+ *+ Function FLDCOUNT() *+ -*+ Called from ( sample.prg ) 6 - function dbflist() +*+ Called from ( db_brows.prg ) 6 - function dbflist() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -FUNCTION FLDCOUNT( xstrt, xend, fld1 ) +FUNCTION FLDCOUNT( mslist, xstrt, xend, fld1 ) -LOCAL klf, i - klf := 0 - i := IIF( LI_FREEZE > 0, 1, fld1 ) - i := MSFNEXT( i ) +LOCAL klf := 0, i := IIF( LI_FREEZE > 0, 1, fld1 ) DO WHILE .T. - xstrt := xstrt + MAX( LEN( FLDSTR( i ) ), IIF( LI_NAMES <> Nil .AND. LEN( LI_NAMES ) >= i, LEN( LI_NAMES[ i ] ), 0 ) ) - 1 + xstrt += MAX( LEN( FLDSTR( mslist, i ) ), IIF( LI_NAMES <> Nil .AND. LEN( LI_NAMES ) >= i, LEN( LI_NAMES[ i ] ), 0 ) ) - 1 IF xstrt > xend - RETURN IIF( klf = 0, 1, klf ) + EXIT ENDIF - klf := klf + 1 + klf ++ i := IIF( i = LI_FREEZE, fld1, i + 1 ) - i := MSFNEXT( i ) - xstrt := xstrt + 2 - IF i > klfs - RETURN IIF( klf = 0, 1, klf ) + xstrt += 2 + IF i > LI_COLCOUNT + EXIT ENDIF ENDDO RETURN IIF( klf = 0, 1, klf ) -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Function MSFNEXT() -*+ -*+ Called from ( sample.prg ) 2 - function dbflist() -*+ 2 - function fldcount() -*+ 2 - function vivnames() -*+ 2 - procedure vivstr() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -FUNCTION MSFNEXT( fldnext ) - -LOCAL vartmp - IF prmsf - DO WHILE fldnext <= LEN( LI_MSF ) .AND. fldnext <= klfs - vartmp := LI_MSF[ fldnext ] - IF VALTYPE( vartmp ) = "N" - IF vartmp = 1 - fldnext ++ - ELSE - EXIT - ENDIF - ELSE - EXIT - ENDIF - ENDDO - ENDIF -RETURN fldnext - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Procedure MSFBACK() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -PROCEDURE MSFBACK( fldnext ) - -LOCAL vartmp - IF prmsf - DO WHILE fldnext <= LEN( LI_MSF ) .AND. fldnext > first_f - vartmp := LI_MSF[ fldnext ] - IF VALTYPE( vartmp ) = "N" - IF vartmp = 1 - fldnext := fldnext - 1 - ELSE - EXIT - ENDIF - ELSE - EXIT - ENDIF - ENDDO - ENDIF -RETURN - *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ *+ Function VIVNAMES() *+ -*+ Called from ( sample.prg ) 3 - function dbflist() +*+ Called from ( db_brows.prg ) 3 - function dbflist() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -FUNCTION VIVNAMES( fifld ) +FUNCTION VIVNAMES( mslist ) -LOCAL i, x, oldc, fif +LOCAL i := 1, x, oldc, fif IF LI_NAMES <> Nil - x := x1 + 2 - i := 1 + x := LI_X1 + 2 IF LI_NMCLR <> Nil oldc := SETCOLOR( LI_NMCLR ) ENDIF - @ y1, x - 1 CLEAR TO y1, x2 - 1 - fif := IIF( LI_FREEZE > 0, 1, fifld ) - fif := MSFNEXT( fif ) - DO WHILE i <= kolfld .AND. fif <= LEN( LI_NAMES ) + @ LI_Y1, x - 1 CLEAR TO LI_Y1, LI_X2 - 1 + fif := IIF( LI_FREEZE > 0, 1, LI_NLEFT ) + // DO MSFNEXT WITH mslist,fif + DO WHILE i <= LI_NCOLUMNS .AND. fif <= LEN( LI_NAMES ) IF LI_NAMES[ fif ] <> Nil - @ y1, x SAY LI_NAMES[ fif ] + @ LI_Y1, x SAY LI_NAMES[ fif ] ENDIF - x := x + MAX( LEN( FLDSTR( fif ) ), LEN( LI_NAMES[ fif ] ) ) + 1 - fif := IIF( fif = LI_FREEZE, fifld, fif + 1 ) - fif := MSFNEXT( fif ) + x := x + MAX( LEN( FLDSTR( mslist, fif ) ), LEN( LI_NAMES[ fif ] ) ) + 1 + fif := IIF( fif = LI_FREEZE, LI_NLEFT, fif + 1 ) + // DO MSFNEXT WITH mslist,fif i ++ ENDDO IF LI_NMCLR <> Nil @@ -589,82 +543,79 @@ RETURN Nil *+ *+ Function WNDVIVOD() *+ -*+ Called from ( sample.prg ) 8 - function dbflist() +*+ Called from ( db_brows.prg ) 8 - function dbflist() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -FUNCTION WNDVIVOD +FUNCTION WNDVIVOD( mslist ) -LOCAL firstrec, nstr, tekzp1 +LOCAL firstrec, nstr := 1, tekzp1 IF LI_PRFLT tekzp1 := LI_TEKZP ENDIF - firstrec := RECNO() + firstrec := EVAL( LI_RECNO, mslist ) SETCOLOR( LI_CLR ) - @ y1+1,x1+1 CLEAR TO y2-1,x2-1 - @ y1, x1, y2, x2 BOX "谀砍倌莱 " - IF title <> Nil - @ y1, ( x2 - x1 - 1 - LEN( title ) ) / 2 + x1 SAY " " + title + " " - ENDIF - nstr := 1 + @ LI_Y1 + 1, LI_X1 + 1 CLEAR TO LI_Y2 - 1, LI_X2 - 1 DO WHILE .T. - VIVSTR( firstfld, nstr + y1, 0 ) - nstr := nstr + 1 - EVAL( LI_BSKIP, 1 ) - IF nstr > razmer .OR. EVAL( LI_BEOF ) + VIVSTR( mslist, nstr + LI_Y1, 0 ) + nstr ++ + EVAL( LI_BSKIP, mslist, 1 ) + IF nstr > LI_Y2 - LI_Y1 - 1 .OR. EVAL( LI_BEOF, mslist ) EXIT ENDIF ENDDO IF LI_PRFLT LI_TEKZP := tekzp1 ENDIF - GO firstrec + EVAL( LI_BGOTO, mslist, firstrec ) RETURN nstr - 1 *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -*+ Procedure VIVSTR() +*+ Static Procedure VIVSTR() *+ -*+ Called from ( sample.prg ) 4 - function dbflist() +*+ Called from ( db_brows.prg ) 5 - function dbflist() *+ 1 - function wndvivod() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -PROCEDURE VIVSTR( fifld, nstroka, vybfld ) +STATIC PROCEDURE VIVSTR( mslist, nstroka, vybfld ) -LOCAL x, i, shablon, sviv, fif - xfld := x := x1 + 2 +LOCAL x, i, shablon, sviv, fif, fldname + + LI_XPOS := x := LI_X1 + 2 IF LI_KOLZ > 0 - fif := IIF( LI_FREEZE > 0, 1, fifld ) - IF fifld <> first_f .AND. vybfld = 0 - @ nstroka, x1 + 1 SAY "<" + fldname := SPACE( 8 ) + fif := IIF( LI_FREEZE > 0, 1, LI_NLEFT ) + IF LI_NLEFT <> LI_LEFTVISIBLE .AND. vybfld = 0 + @ nstroka, LI_X1 + 1 SAY "<" ENDIF IF DELETED() - @ nstroka, x1 + 1 SAY "*" + @ nstroka, LI_X1 + 1 SAY "*" ENDIF - FOR i := 1 TO kolfld - IF i = numfld - xfld := x + FOR i := 1 TO LI_NCOLUMNS + IF i = LI_COLPOS + LI_XPOS := x ENDIF IF vybfld = 0 .OR. vybfld = i - MSFNEXT( fif ) - sviv := FLDSTR( fif ) - sviv := IIF( LEN( sviv ) < x2 - 1 - x, sviv, SUBSTR( sviv, 1, x2 - 1 - x ) ) - @ nstroka, x SAY sviv + // DO MSFNEXT WITH mslist,fif + sviv := FLDSTR( mslist, fif ) + sviv := IIF( LEN( sviv ) < LI_X2 - 1 - x, sviv, SUBSTR( sviv, 1, LI_X2 - 1 - x ) ) + @ nstroka, x SAY sviv ELSE - sviv := FLDSTR( fif ) - sviv := IIF( LEN( sviv ) < x2 - 1 - x, sviv, SUBSTR( sviv, 1, x2 - 1 - x ) ) + sviv := FLDSTR( mslist, fif ) + sviv := IIF( LEN( sviv ) < LI_X2 - 1 - x, sviv, SUBSTR( sviv, 1, LI_X2 - 1 - x ) ) ENDIF x := x + MAX( LEN( sviv ), IIF( LI_NAMES <> Nil .AND. LEN( LI_NAMES ) >= fif, LEN( LI_NAMES[ fif ] ), 0 ) ) + 1 - fif := IIF( fif = LI_FREEZE, fifld, fif + 1 ) + fif := IIF( fif = LI_FREEZE, LI_NLEFT, fif + 1 ) NEXT - MSFNEXT( fif ) - IF fif <= klfs .AND. vybfld = 0 - IF x2 - 1 - x > 0 - sviv := FLDSTR( fif ) - @ nstroka, x SAY SUBSTR( sviv, 1, x2 - 1 - x ) + // DO MSFNEXT WITH mslist,fif + IF fif <= LI_COLCOUNT .AND. vybfld = 0 + IF LI_X2 - 1 - x > 0 + sviv := FLDSTR( mslist, fif ) + @ nstroka, x SAY SUBSTR( sviv, 1, LI_X2 - 1 - x ) ENDIF - @ nstroka, x2 - 1 SAY ">" + @ nstroka, LI_X2 - 1 SAY ">" ENDIF ENDIF RETURN @@ -673,32 +624,41 @@ RETURN *+ *+ Function FLDSTR() *+ -*+ Called from ( sample.prg ) 1 - function dbflist() +*+ Called from ( db_brows.prg ) 1 - function dbflist() *+ 1 - function fldcount() *+ 1 - function vivnames() -*+ 3 - procedure vivstr() +*+ 3 - static procedure vivstr() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ -FUNCTION FLDSTR( numf ) +FUNCTION FLDSTR( mslist, numf ) LOCAL fldtype, rez, vartmp - IF prmsf + IF LI_MSF != Nil IF numf <= LEN( LI_MSF ) vartmp := LI_MSF[ numf ] IF ( fldtype := VALTYPE( vartmp ) ) = "B" - RETURN EVAL( vartmp ) + vartmp := EVAL( vartmp, mslist, numf ) + IF LI_MSTYP[ numf ] == "C" + RETURN PADR( vartmp, LI_MSLEN[ numf ] ) + ELSEIF LI_MSTYP[ numf ] == "N" + RETURN PADL( STR( vartmp, LI_MSLEN[ numf ], LI_MSDEC[ numf ] ), LI_MSLEN[ numf ] ) + ELSEIF LI_MSTYP[ numf ] == "D" + RETURN PADR( DTOC( vartmp ), LI_MSLEN[ numf ] ) + ELSEIF LI_MSTYP[ numf ] == "L" + RETURN PADR( IIF( vartmp, "T", "F" ), LI_MSLEN[ numf ] ) + ENDIF ELSEIF fldtype = "C" - RETURN " " + numf := FIELDPOS( vartmp ) ENDIF ENDIF ENDIF - fldtype := LI_MSTYP[ numf ] + fldtype := FIELDTYPE( numf ) DO CASE CASE fldtype = "C" rez := FIELDGET( numf ) CASE fldtype = "N" - rez := STR( FIELDGET( numf ), LI_MSLEN[ numf ], LI_MSDEC[ numf ] ) + rez := STR( FIELDGET( numf ), FIELDSIZE( numf ), FIELDDECI( numf ) ) CASE fldtype = "D" rez := DTOC( FIELDGET( numf ) ) CASE fldtype = "L" @@ -706,176 +666,76 @@ LOCAL fldtype, rez, vartmp CASE fldtype = "M" rez := " " ENDCASE + IF LI_BDESHIN <> Nil + rez := EVAL( LI_BDESHIN, mslist, rez ) + ENDIF RETURN rez +*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 +*+ +*+ Function GetBuf() +*+ +*+ Called from ( db_brows.prg ) 1 - function dbflist() +*+ +*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 +*+ +FUNCTION GetBuf + +LOCAL srez := "" + DO WHILE NEXTKEY() <> 0 + srez += CHR( INKEY( 0 ) ) + ENDDO +RETURN srez + *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ *+ Function InitList() *+ -*+ Called from ( sample.prg ) 1 - function main() +*+ Called from ( db_brows.prg ) 1 - function main() +*+ 1 - function dbflist() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ FUNCTION InitList - LI_NSTR := 1 - LI_CLR := "W+/B" - LI_CLRV := "R/W" - LI_BSKIP := { | x | FSKIP( x ) } - LI_BGTOP := { || FGOTOP() } - LI_BGBOT := { || FGOBOT() } - LI_BEOF := { || FEOF() } - LI_BBOF := { || FBOF() } - LI_B1 := { || DEVPOS( y2, x1 + 2 ), DEVOUT( IIF( LI_PRFLT, "敤忄" + STR( LI_TEKZP, 5 ), STR( RECNO(), 6 ) ) + "/" + STR( LI_KOLZ, 6 ) ) } - LI_MSF := 0 - LI_FREEZE := 0 - LI_RCOU := { || RECCOUNT() } - LI_MSREC := ARRAY( 50 ) - LI_PRFLT := .F. - LI_TEKZP := 1 - DO FLMSFLD -RETURN Nil - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Function FGOTOP() -*+ -*+ Called from ( sample.prg ) 1 - function initlist() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -FUNCTION FGOTOP - - IF LI_PRFLT - IF LI_KOLZ > 0 - LI_TEKZP := 1 - GO LI_MSREC[ 1 ] - ENDIF - ELSE - GO TOP - ENDIF -RETURN Nil - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Function FGOBOT() -*+ -*+ Called from ( sample.prg ) 1 - function initlist() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -FUNCTION FGOBOT - - IF LI_PRFLT - LI_TEKZP := LI_KOLZ - GO IIF( LI_KOLZ < 50, LI_MSREC[ LI_KOLZ ], LI_MSREC[ 50 ] ) - ELSE - GO BOTTOM - ENDIF -RETURN Nil - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Procedure FSKIP() -*+ -*+ Called from ( sample.prg ) 1 - function initlist() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -PROCEDURE FSKIP( kolskip ) - -LOCAL tekzp1 - IF LI_PRFLT - IF LI_KOLZ = 0 - RETURN - ENDIF - tekzp1 := LI_TEKZP - LI_TEKZP := LI_TEKZP + kolskip + IIF( tekzp1 = 0, 1, 0 ) - IF LI_TEKZP < 1 - LI_TEKZP := 0 - GO LI_MSREC[ 1 ] - ELSEIF LI_TEKZP > LI_KOLZ - LI_TEKZP := LI_KOLZ + 1 - GO IIF( LI_KOLZ < 50, LI_MSREC[ LI_KOLZ ], LI_MSREC[ 50 ] ) - ELSE - IF LI_TEKZP > 50 - 1 - SKIP IIF( tekzp1 = LI_KOLZ + 1, kolskip + 1, kolskip ) - ELSE - GO LI_MSREC[ LI_TEKZP ] - ENDIF - ENDIF - ELSE - SKIP kolskip - ENDIF -RETURN - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Function FBOF() -*+ -*+ Called from ( sample.prg ) 1 - function initlist() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -FUNCTION FBOF - - IF LI_PRFLT - RETURN IIF( LI_TEKZP = 0, .T., .F. ) - ENDIF -RETURN BOF() - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Function FEOF() -*+ -*+ Called from ( sample.prg ) 1 - function initlist() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -FUNCTION FEOF - - IF LI_PRFLT - RETURN IIF( LI_TEKZP > LI_KOLZ, .T., .F. ) - ENDIF -RETURN EOF() - -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -*+ Procedure FLMSFLD() -*+ -*+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 -*+ -PROCEDURE FLMSFLD - -LOCAL arlen - arlen := FCOUNT() - IF LI_MSNAME = Nil - LI_MSNAME := ARRAY( arlen ) - LI_MSTYP := ARRAY( arlen ) - LI_MSLEN := ARRAY( arlen ) - LI_MSDEC := ARRAY( arlen ) - AFIELDS( LI_MSNAME, LI_MSTYP, LI_MSLEN, LI_MSDEC ) - ENDIF -RETURN +LOCAL mslist := ARRAY( LI_LEN ) + LI_NSTR := LI_MSED := 1 + LI_CLR := "W+/B" + LI_CLRV := "R/W" + LI_BSKIP := { | a, x | DBSKIP( x ) } + LI_BGTOP := { || DBGOTOP() } + LI_BGBOT := { || DBGOBOTTOM() } + LI_BEOF := { || EOF() } + LI_BBOF := { || BOF() } + LI_B1 := { | a | DEVPOS( LI_Y2, LI_X1 + 2 ), DEVOUT( STR( RECNO(), 6 ) + "/" + STR( LI_KOLZ, 6 ) ) } + LI_FREEZE := 0 + LI_RCOU := { || RECCOUNT() } + LI_RECNO := { || RECNO() } + LI_BGOTO := { | a, n | DBGOTO( n ) } + LI_PRFLT := LI_LVIEW := .F. + LI_LSOHR := .T. + LI_BDESHIN := LI_BDESHOUT := LI_MSF := LI_MSTYP := LI_NAMES := Nil + LI_TEKZP := 1 +RETURN mslist *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ *+ Function Defpict() *+ -*+ Called from ( sample.prg ) 1 - function dbflist() +*+ Called from ( db_brows.prg ) 1 - function dbflist() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ FUNCTION Defpict( i, maxlen ) -LOCAL spict, fldd +LOCAL spict, fldd, fldtype := FIELDTYPE( i ), fldlen := FIELDSIZE( i ) DO CASE - CASE LI_MSTYP[ i ] = "C" - spict := IIF( maxlen = Nil, REPLICATE( "X", LI_MSLEN[ i ] ), "@S" + NUM_STR( maxlen, 2 ) ) - CASE LI_MSTYP[ i ] = "N" - fldd := LI_MSDEC[ i ] - spict := IIF( fldd = 0, REPLICATE( "9", LI_MSLEN[ i ] ), REPLICATE( "9", LI_MSLEN[ i ] - 1 - fldd ) + "." + REPLICATE( "9", fldd ) ) - CASE LI_MSTYP[ i ] = "D" + CASE fldtype == "C" + spict := IIF( maxlen = Nil, REPLICATE( "X", fldlen ), "@S" + NUM_STR( maxlen, 2 ) ) + CASE fldtype == "N" + fldd := FIELDDECI( i ) + spict := IIF( fldd = 0, REPLICATE( "9", fldlen ), REPLICATE( "9", fldlen - 1 - fldd ) + "." + REPLICATE( "9", fldd ) ) + CASE fldtype == "D" spict := "@D" ENDCASE RETURN spict @@ -884,7 +744,7 @@ RETURN spict *+ *+ Function NUM_STR() *+ -*+ Called from ( sample.prg ) 1 - function defpict() +*+ Called from ( db_brows.prg ) 1 - function defpict() *+ *+北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北北 *+ @@ -892,3 +752,5 @@ FUNC NUM_STR( NOM, KOLZN ) NOM := INT( NOM ) RETURN ( REPLICATE( "0", KOLZN - LEN( LTRIM( STR( NOM ) ) ) ) + LTRIM( STR( NOM ) ) ) + +*+ EOF: DB_BROWS.PRG