From 5de5b52de34c3db9bea511e3775bdbd917d7f0c3 Mon Sep 17 00:00:00 2001 From: "Alexander S.Kresin" Date: Thu, 12 Aug 1999 18:47:11 +0000 Subject: [PATCH] Updating TBrowse files --- harbour/ChangeLog | 84 +++++++++++++++-------------- harbour/funclist.txt | 20 +++---- harbour/source/rtl/tbcolumn.prg | 11 +++- harbour/source/rtl/tbrowse.prg | 87 +++++++++++++++++++------------ harbour/tests/working/testbrw.prg | 15 +++++- 5 files changed, 134 insertions(+), 83 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f3b540d36b..7f4fc55c0f 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,11 @@ +19990812-22:29 GMT+3 Alexander Kresin + * source/rtl/tbrowse.prg + * source/rtl/tbcolumn.prg + * tests/working/testbrw.prg + * added some functionality + * funclist.txt + * updated status of TBrowse functions + 19990812-14:15 EDT David G. Holm * funclist.txt * Updated the status of several functions to S or R @@ -19,20 +27,20 @@ 19990812-14:10 GMT+2 Ryszard Glab *source/compiler/harbour.y - * PARAMETERS statement can be used before LOCAL statement - (the stack frame is calculated correctly) - * PARAMETERS statement cannot be used if there are local - parameters (parameters inside '()') declared already - + * PARAMETERS statement can be used before LOCAL statement + (the stack frame is calculated correctly) + * PARAMETERS statement cannot be used if there are local + parameters (parameters inside '()') declared already + *include/compiler.h - + added wParamNum member to _FUNC structure - + + added wParamNum member to _FUNC structure + *include/hberrors.h - + added new error code ERR_PARAMETERS_NOT_ALLOWED - + + added new error code ERR_PARAMETERS_NOT_ALLOWED + *source/rtl/console.c - * corrected `\0` to '\x0' for OS_UNIX_COMPATIBLE - + * corrected `\0` to '\x0' for OS_UNIX_COMPATIBLE + 19990812-08:32 GMT+1 Antonio Linares * source/rtl/tbrowse.prg * enhanced @@ -139,13 +147,13 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm - * source/Makefile: - Moved the debug directory after rdd. + * source/Makefile: + Moved the debug directory after rdd. - * source/hbpp/hbpp.c: - * source/rtl/filesys.c: - * source/runner/runner.c: - Got rid of several warnings. + * source/hbpp/hbpp.c: + * source/rtl/filesys.c: + * source/runner/runner.c: + Got rid of several warnings. 199908.09-15:24 GMT+3 Alexander Kresin * source/hbpp/hbpp.c @@ -154,8 +162,8 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm 19990809-12:20 GMT+2 Ryszard Glab *source/compiler/harbour.y - * restored all code related to debugger - * fixed alias expressions in '=' statement + * restored all code related to debugger + * fixed alias expressions in '=' statement 199908.09-13:12 GMT+3 Alexander Kresin * source/hbpp/hbpp.c @@ -242,8 +250,8 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm definitions of data types. *include/langapi.h - - removed declaration of extern langDef (Watcom reported error) - see TODO comment in this file + - removed declaration of extern langDef (Watcom reported error) + see TODO comment in this file *include/pcode.h - removed unused HB_P_PUSHWORD @@ -255,8 +263,8 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm HB_P_PUSHFIELD HB_P_POPALIASEDFIELD HB_P_PUSHALIASEDFIELD - NOTE: - You have to rebuild all harbour libraries and object files ! + NOTE: + You have to rebuild all harbour libraries and object files ! *source/vm/hvm.c + added initial support for aliased expressions (fields are not @@ -268,24 +276,24 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm *tests/working/alias.prg + new file to check if aliased expressions are handled correctly - (only manual check at this moment - by looking at generated + (only manual check at this moment - by looking at generated C code) *test/working/Makefile + added alias.prg into BAD_PRG_SOURCES because it cannot be run yet - - removed debugger.prg + - removed debugger.prg *source/rtl/console.c - - io.h cannot be included on Linux/GCC (placed inside #ifdef) + - io.h cannot be included on Linux/GCC (placed inside #ifdef) *source/vm/dynsym.c - + restored definition of SYM_ALLOCATED because it is local symbol - NOTE: - When compared then this symbol _have to_ be type casted - to SYMBOLSCOPE. If it will be not type casted then some - compilers will compare (int)-1 with (char)-1 which is never - true! (I am changing it for the second time :) - + + restored definition of SYM_ALLOCATED because it is local symbol + NOTE: + When compared then this symbol _have to_ be type casted + to SYMBOLSCOPE. If it will be not type casted then some + compilers will compare (int)-1 with (char)-1 which is never + true! (I am changing it for the second time :) + 19990808-11:50 GMT+1 Victor Szel * source/runner/runner.c source/runner/Makefile @@ -543,12 +551,12 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm Fri Aug 06 20:04:05 1999 Gonzalo A. Diethelm - * config/rules.cf: - Added the removal of *.core to the clean target. + * config/rules.cf: + Added the removal of *.core to the clean target. - * source/hbpp/hbpp.c: - * source/hbpp/stdalone/hbpp.c: - Fixed two unused variable warnings. + * source/hbpp/hbpp.c: + * source/hbpp/stdalone/hbpp.c: + Fixed two unused variable warnings. 199908.06-22:12 GMT+3 Alexander Kresin * include/hbpp.h diff --git a/harbour/funclist.txt b/harbour/funclist.txt index 1cc3ce1b2e..70573c38cb 100644 --- a/harbour/funclist.txt +++ b/harbour/funclist.txt @@ -335,8 +335,8 @@ GetNew ;N; :Insert ;N; :OverStrike ;N; ; TBROWSE OBJECT -TBrowseNew ;N; -TBrowseDB ;N; +TBrowseNew ;S; +TBrowseDB ;S; :AutoLite ;N; :Cargo ;N; :ColCount ;N; @@ -360,27 +360,27 @@ TBrowseDB ;N; :RowPos ;N; :SkipBlock ;N; :Stable ;N; -:Down ;N; +:Down ;S; :end ;N; :GoBottom ;N; :GoTop ;N; :Home ;N; -:Left ;N; +:Left ;S; :PageDown ;N; :PageUp ;N; :PanEnd ;N; :PanHome ;N; :PanLeft ;N; :PanRight ;N; -:Right ;N; -:Up ;N; -:AddColumn ;N; +:Right ;S; +:Up ;S; +:AddColumn ;S; :ColorRect ;N; :ColWidth ;N; :Configure ;N; :DeHilite ;N; :DelColumn ;N; -:ForceStable ;N; +:ForceStable ;S; :GetColumn ;N; :Hilite ;N; :InsColumn ;N; @@ -388,9 +388,9 @@ TBrowseDB ;N; :RefreshAll ;N; :RefreshCurrent ;N; :SetColumn ;N; -:Stabilize ;N; +:Stabilize ;S; ; TBCOLUMN OBJECT -TBColumnNew ;N; +TBColumnNew ;S; :Block ;N; :Cargo ;N; :ColorBlock ;N; diff --git a/harbour/source/rtl/tbcolumn.prg b/harbour/source/rtl/tbcolumn.prg index 234efdab34..fd55baba6c 100644 --- a/harbour/source/rtl/tbcolumn.prg +++ b/harbour/source/rtl/tbcolumn.prg @@ -53,10 +53,19 @@ return Self function TBColumnNew( cHeading, bBlock ) local oCol := TBColumn():New() + loca nWidth, nType := Valtype( Eval( bBlock ) ) oCol:Heading = cHeading oCol:block = bBlock - oCol:Width = If( cHeading != nil, Len( cHeading ), Len( Eval( bBlock ) ) ) + do case + case nType = "N" + nWidth = 10 + case nType = "L" + nWidth = 3 + case nType = "C" + nWidth = Len( Eval( bBlock ) ) + endcase + oCol:Width = If( cHeading != nil, Max( Len( cHeading ), nWidth ), nWidth ) return oCol diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index f5bc048121..808427e16b 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -52,8 +52,8 @@ CLASS TBrowse DATA rowPos // Current cursor row position DATA skipBlock // Code block used to reposition data source DATA stable // Indicates if the TBrowse object is stable - DATA aRedraw - DATA RelativePos + DATA aRedraw // Array of logical items indicating, is appropriate row need to be redraw + DATA RelativePos // Indicates record position relatively position of first record on the screen METHOD New() // Constructor METHOD Down() // Moves the cursor down one row @@ -61,14 +61,14 @@ CLASS TBrowse METHOD GoBottom() VIRTUAL // Repositions the data source to the bottom of file METHOD GoTop() VIRTUAL // Repositions the data source to the top of file METHOD Home() VIRTUAL // Moves the cursor to the leftmost visible data column - METHOD Left() VIRTUAL // Moves the cursor left one column + METHOD Left() // Moves the cursor left one column METHOD PageDown() VIRTUAL // Repositions the data source downward METHOD PageUp() VIRTUAL // Repositions the data source upward METHOD PanEnd() VIRTUAL // Moves the cursor to the rightmost data column METHOD PanHome() VIRTUAL // Moves the cursor to the leftmost visible data column METHOD PanLeft() VIRTUAL // Pans left without changing the cursor position METHOD PanRight() VIRTUAL // Pans right without changing the cursor position - METHOD Right() VIRTUAL // Moves the cursor right one column + METHOD Right() // Moves the cursor right one column METHOD Up() // Moves the cursor up one row METHOD AddColumn( oCol ) INLINE ; @@ -113,6 +113,7 @@ METHOD New() CLASS TBrowse ::nBottom = MaxRow() ::nRight = MaxCol() ::AutoLite = .t. + ::leftVisible = 1 ::ColPos = 1 ::Freeze = 0 ::HitBottom = .f. @@ -159,6 +160,36 @@ METHOD Down() CLASS TBrowse return Self +METHOD Left() CLASS TBrowse + if ::ColPos > ::leftVisible + ::ColPos-- + ::aRedraw[ ::RowPos ] = .F. + ::stable = .f. + else + if ::ColPos > 1 + ::leftVisible-- + ::ColPos-- + AFill( ::aRedraw, .F. ) + ::stable = .f. + endif + endif +return Self + +METHOD Right() CLASS TBrowse + if ::ColPos < ::rightVisible + ::ColPos++ + ::aRedraw[ ::RowPos ] = .F. + ::stable = .f. + else + if ::ColPos < Len( ::aColumns ) + ::leftVisible++ + ::ColPos++ + AFill( ::aRedraw, .F. ) + ::stable = .f. + endif + endif +return Self + METHOD ForceStable() CLASS TBrowse while ! ::Stabilize() @@ -173,15 +204,9 @@ METHOD Stabilize() CLASS TBrowse local n, nRow, lDisplay := .t. local nWidth := ::nRight - ::nLeft + 1 // Visible width of the browse - local nColsWidth := 0 // Total width of visible columns plus ColSep - local nColsVisible := 0 // Number of columns that fit on the browse width - local lHeaders := .f. // Are there column headers to paint ? - - // Calculate how many columns fit on the browse width including ColSeps - while nColsWidth < nWidth .and. nColsVisible < Len( ::aColumns ) - nColsWidth += ::aColumns[ ++nColsVisible ]:Width - nColsWidth += Len( ::ColSep ) - end + local nColsWidth := 0 // Total width of visible columns plus ColSep + local nColsVisible := ::leftVisible - 1 // Number of columns that fit on the browse width + local lHeaders := .f. // Are there column headers to paint ? // Are there any column header to paint ? for n = 1 to Len( ::aColumns ) @@ -192,19 +217,29 @@ METHOD Stabilize() CLASS TBrowse next if ::aRedraw == Nil .or. ! ::aRedraw[ 1 ] + // Calculate how many columns fit on the browse width including ColSeps + while nColsVisible < Len( ::aColumns ) .and. nColsWidth + ::aColumns[ nColsVisible+1 ]:Width < nWidth + nColsWidth += ::aColumns[ ++nColsVisible ]:Width + nColsWidth += Len( ::ColSep ) + end + ::rightVisible = nColsVisible if ::aRedraw == nil ::RowCount = ::nBottom - ::nTop + 1 - If( lHeaders, 1, 0 ) ::aRedraw = Array( ::RowCount ) AFill( ::aRedraw, .F. ) endif + else + nColsWidth = ::aColumns[::rightVisible]:ColPos + ; + ::aColumns[::rightVisible]:Width - ::aColumns[::leftVisible]:ColPos endif if lHeaders .and. .not. ::aRedraw[ 1 ] SetPos( ::nTop, ::nLeft ) DevOut( Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) - for n = 1 to Len( ::aColumns ) - DevOut( ::aColumns[ n ]:Heading, ::ColorSpec ) - if ::ColSep != nil + for n = ::leftVisible to ::rightVisible + ::aColumns[ n ]:ColPos = Col() + DevOut( Padr( ::aColumns[ n ]:Heading, ::aColumns[ n ]:Width ), ::ColorSpec ) + if ::ColSep != nil .and. n < ::rightVisible DevOut( ::ColSep, ::ColorSpec ) endif next @@ -220,14 +255,7 @@ METHOD Stabilize() CLASS TBrowse if nRow > ::RowCount if !::stable - if ::RowPos != ::RelativePos - lDisplay = Eval( ::SkipBlock, ::RowPos - ::RelativePos ) != 0 - else - lDisplay = .T. - endif - if .not. lDisplay .and. ::RowPos > 1 - ::RowPos-- - endif + Eval( ::SkipBlock, ::RowPos - ::RelativePos ) ::RelativePos = ::RowPos if ::AutoLite @ ::nTop + ::RowPos - If( lHeaders, 0, 1 ), ::aColumns[ ::ColPos ]:ColPos ; @@ -240,23 +268,18 @@ METHOD Stabilize() CLASS TBrowse else if nRow != ::RelativePos lDisplay = Eval( ::SkipBlock, nRow - ::RelativePos ) != 0 - else - lDisplay = .T. endif ::RelativePos = nRow SetPos( ::nTop + nRow + If( lHeaders, 0, -1 ), ::nLeft ) - DevOut( Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) - for n = 1 to nColsVisible - if nRow == 1 - ::aColumns[ n ]:ColPos = Col() - endif + DevOut( Space( ::aColumns[::leftVisible]:ColPos - ::nLeft ), ::ColorSpec ) + for n = ::leftVisible to ::rightVisible if lDisplay DevOut( PadR( Eval( ::aColumns[ n ]:block ),; ::aColumns[ n ]:Width ), ::ColorSpec ) else DevOut( Space( ::aColumns[ n ]:Width ), ::ColorSpec ) endif - if ::ColSep != nil + if ::ColSep != nil .and. n < ::rightVisible DevOut( ::ColSep, ::ColorSpec ) endif next diff --git a/harbour/tests/working/testbrw.prg b/harbour/tests/working/testbrw.prg index 92670d25ee..91e4cb12e0 100644 --- a/harbour/tests/working/testbrw.prg +++ b/harbour/tests/working/testbrw.prg @@ -9,27 +9,32 @@ function Main() local oBrowse := TBrowseNew( 5, 5, 15, 30 ) - local aTest := { "This", "is", "a", "browse", "on", "an", "array", "test" } + local aTest := { "This", "is", "a", "browse", "on", "an", "array", "test", "with", "a", "long", "data" } local n := 1 local nKey local lEnd := .f. oBrowse:colorSpec = "W+/B, N/BG" + oBrowse:ColSep = "³" oBrowse:GoTopBlock = { || n := 1 } oBrowse:GoBottomBlock = { || n := Len( aTest ) } oBrowse:SkipBlock = { | nSkip, nPos | nPos := n,; n := If( nSkip > 0, Min( Len( aTest ), n + nSkip ),; Max( 1, n + nSkip )), n - nPos } - oBrowse:AddColumn( TBColumnNew( "First", { || aTest[ n ] } ) ) + oBrowse:AddColumn( TBColumnNew( "First", { || n } ) ) oBrowse:AddColumn( TBColumnNew( "Second", { || aTest[ n ] } ) ) oBrowse:AddColumn( TBColumnNew( "Third", { || aTest[ n ] } ) ) + oBrowse:AddColumn( TBColumnNew( "Forth", { || aTest[ n ] } ) ) + oBrowse:AddColumn( TBColumnNew( "Fifth", { || n } ) ) Alert( oBrowse:ClassName() ) Alert( oBrowse:GetColumn( 1 ):ClassName() ) SetCursor( 0 ) + set color to "W+/B" + @ 4,4,16,31 BOX "ÚÄ¿³ÙÄÀ³ " while ! lEnd oBrowse:ForceStable() @@ -46,6 +51,12 @@ function Main() case nKey == K_UP oBrowse:Up() + + case nKey == K_LEFT + oBrowse:Left() + + case nKey == K_RIGHT + oBrowse:Right() endcase end