From fd18b30bcded9dc1bae9c2af9c1f60b96de2e680 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 19 Oct 1999 10:13:14 +0000 Subject: [PATCH] 19991019-11:55 GMT+1 --- harbour/ChangeLog | 14 ++++ harbour/source/rtl/browse.prg | 127 ++++++++++++++++++++++++--------- harbour/source/rtl/tbrowse.prg | 33 ++++++--- 3 files changed, 130 insertions(+), 44 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3a70837cd8..5c5698abb6 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +19991019-11:55 GMT+1 Victor Szel + * source/rtl/tbrowse.prg + ! Fixed the header/footer separator to be drawn until the border. + + ColorRect() support started. + - Removed the parameter from ::Configure() calls, it was not + used, and Clipper don't have such parameter. + * source/rtl/browse.prg + + Enhanced speed and compatibility. + - Incremental refreshing. + - Missing keys added. + - Status line added. + - Border fixed. + - Setkey support added. + 19991019-10:24 GMT+1 Antonio Linares * source/rtl/gt/gtwin.c * Windows apps only create a console when the debugger is linked. diff --git a/harbour/source/rtl/browse.prg b/harbour/source/rtl/browse.prg index 49aabfed94..c98a83d93d 100644 --- a/harbour/source/rtl/browse.prg +++ b/harbour/source/rtl/browse.prg @@ -43,68 +43,129 @@ function Browse( nTop, nLeft, nBottom, nRight ) local cOldScreen local n, nKey, nOldCursor local lExit := .f. + local lGotKey := .f. + local bAction if ! Used() return .f. - end + end - DEFAULT nTop TO 1, nLeft TO 0, nBottom TO MaxRow(), nRight TO MaxCol() + if PCount() < 4 + nTop := 1 + nLeft := 0 + nBottom := MaxRow() + nRight := MaxCol() + endif nOldCursor = SetCursor( 0 ) cOldScreen = SaveScreen( nTop, nLeft, nBottom, nRight ) - @ nTop, nLeft, nBottom, nRight BOX B_DOUBLE + @ nTop, nLeft TO nBottom, nRight + @ nTop + 3, nLeft SAY Chr( 198 ) + @ nTop + 3, nRight SAY Chr( 181 ) + @ nTop + 1, nLeft + 1 SAY Space( nRight - nLeft - 1 ) - oBrw = TBrowseDb( nTop + 1, nLeft + 1, nBottom - 1, nRight - 1 ) - oBrw:HeadSep = Chr( 205 ) + oBrw = TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 ) + oBrw:HeadSep = " " + Chr( 205 ) for n = 1 to FCount() - oBrw:AddColumn( TbColumnNew( FieldName( n ), FieldBlock( FieldName( n ) ) ) ) + oBrw:AddColumn( TBColumnNew( FieldName( n ), FieldBlock( FieldName( n ) ) ) ) next + oBrw:ForceStable() + while ! lExit - oBrw:ForceStable() + while !oBrw:stabilize() .and. NextKey() == 0 + enddo - nKey = InKey( 0 ) + if NextKey() == 0 - do case - case nKey == K_ESC - lExit = .t. + Statline( oBrw ) + oBrw:forceStable() - case nKey == K_UP - oBrw:Up() + nKey := Inkey( 0 ) - case nKey == K_DOWN - oBrw:Down() + if ( bAction := SetKey( nKey ) ) != nil + Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" ) + loop + endif + else + nKey := Inkey() + endif - case nKey == K_END - oBrw:End() + do case + case nKey == K_ESC + lExit = .t. - case nKey == K_HOME - oBrw:Home() + case nKey == K_UP + oBrw:Up() - case nKey == K_LEFT - oBrw:Left() + case nKey == K_DOWN + oBrw:Down() - case nKey == K_RIGHT - oBrw:Right() + case nKey == K_END + oBrw:End() - case nKey == K_PGUP - oBrw:PageUp() + case nKey == K_HOME + oBrw:Home() - case nKey == K_PGDN - oBrw:PageDown() + case nKey == K_LEFT + oBrw:Left() - case nKey == K_CTRL_PGUP - oBrw:GoTop() + case nKey == K_RIGHT + oBrw:Right() - case nKey == K_CTRL_PGDN - oBrw:GoBottom() - endcase + case nKey == K_PGUP + oBrw:PageUp() + + case nKey == K_PGDN + oBrw:PageDown() + + case nKey == K_CTRL_PGUP + oBrw:GoTop() + + case nKey == K_CTRL_PGDN + oBrw:GoBottom() + + case nKey == K_CTRL_LEFT + oBrw:panLeft() + + case nKey == K_CTRL_RIGHT + oBrw:panRight() + + case nKey == K_CTRL_HOME + oBrw:panHome() + + case nKey == K_CTRL_END + oBrw:panEnd() + + endcase end RestScreen( nTop, nLeft, nBottom, nRight, cOldScreen ) SetCursor( nOldCursor ) -return .t. \ No newline at end of file +return .t. + +static function Statline( oBrw ) + + local nTop := oBrw:nTop - 1 + local nRight := oBrw:nRight + + @ nTop, nRight - 27 SAY "Record " + + if LastRec() == 0 + @ nTop, nRight - 20 say " " + elseif RecNo() == LastRec() + 1 + @ nTop, nRight - 40 SAY " " + @ nTop, nRight - 20 SAY " " + else + @ nTop, nRight - 40 SAY iif( Deleted(), "", " " ) + @ nTop, nRight - 20 SAY PadR( LTrim( Str( RecNo() ) ) + "/" +; + Ltrim( Str( LastRec() ) ), 16 ) +; + iif( oBrw:hitTop, "", " " ) + endif + +return nil + diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 22a8c71d0d..22899af816 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -64,9 +64,11 @@ CLASS TBrowse 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 DATA lHeaders // Internal variable, indicate, are there column headers to paint + DATA aRect // The rectangle specified with ColorRect() + DATA aRectColor // The color positions to use in the rectangle specified with ColorRect() - METHOD New() // Constructor - METHOD Down() // Moves the cursor down one row + METHOD New() // Constructor + METHOD Down() // Moves the cursor down one row METHOD End() // Moves the cursor to the rightmost visible data column METHOD GoBottom() // Repositions the data source to the bottom of file METHOD GoTop() // Repositions the data source to the top of file @@ -82,10 +84,10 @@ CLASS TBrowse METHOD Up() // Moves the cursor up one row METHOD AddColumn( oCol ) INLINE ; - AAdd( ::aColumns, oCol ), ::Configure( 2 ), Self // Adds a TBColumn object to the TBrowse object + AAdd( ::aColumns, oCol ), ::Configure(), Self // Adds a TBColumn object to the TBrowse object - METHOD ColCount() INLINE Len( ::aColumns ) - METHOD ColorRect() VIRTUAL // Alters the color of a rectangular group of cells + METHOD ColCount() INLINE Len( ::aColumns ) + METHOD ColorRect() // Alters the color of a rectangular group of cells // Returns the display width of a particular column METHOD ColWidth( nColumn ) INLINE If( 0 < nColumn .and. nColumn <= Len( ::aColumns ),; ::aColumns[ nColumn ]:Width, nil ) @@ -104,7 +106,7 @@ CLASS TBrowse METHOD InsColumn( nPos, oCol ) INLINE ASize( ::aColumns, Len( ::aColumns + 1 ) ),; AIns( ::aColumns, nPos ),; - ::aColumns[ nPos ] := oCol, ::Configure( 2 ), oCol + ::aColumns[ nPos ] := oCol, ::Configure(), oCol // Insert a column object in a browse METHOD Invalidate() // Forces entire redraw during next stabilization @@ -140,6 +142,8 @@ METHOD New() CLASS TBrowse ::RelativePos = 1 ::aRedraw = nil ::lHeaders = .f. + ::aRect = nil + ::aRectColor = nil return Self @@ -149,7 +153,7 @@ METHOD DelColumn( nPos ) CLASS TBrowse ADel( ::aColumns, nPos ) ASize( ::aColumns, Len( ::aColumns ) - 1 ) - ::Configure( 2 ) + ::Configure() return oCol @@ -530,7 +534,7 @@ METHOD Stabilize() CLASS TBrowse DispOut( Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) endif if ! Empty( ::HeadSep ) //Drawing heading separator - DispOutAt( ::nTop + If( ::lHeaders, 1, 0 ), ::nLeft, Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) + DispOutAt( ::nTop + If( ::lHeaders, 1, 0 ), ::nLeft, Replicate( Right( ::HeadSep, 1 ), ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) if Len( ::HeadSep ) > 1 iW = 0 for n = If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible @@ -547,10 +551,10 @@ METHOD Stabilize() CLASS TBrowse else DispOut( Replicate( ::HeadSep, nColsWidth ), ::ColorSpec ) endif - DispOut( Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) + DispOut( Replicate( Right( ::HeadSep, 1 ), ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) endif if ! Empty( ::FootSep ) // Drawing footing separator - DispOutAt( ::nBottom - If( lFooters, 1, 0 ), ::nLeft, Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) + DispOutAt( ::nBottom - If( lFooters, 1, 0 ), ::nLeft, Replicate( Right( ::FootSep, 1 ), ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) if Len( ::FootSep ) > 1 iW = 0 for n = If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible @@ -567,7 +571,7 @@ METHOD Stabilize() CLASS TBrowse else DispOut( Replicate( ::FootSep, nColsWidth ), ::ColorSpec ) endif - DispOut( Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) + DispOut( Replicate( Right( ::FootSep, 1 ), ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) endif if lFooters // Drawing footers DispOutAt( ::nBottom, ::nLeft, Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec ) @@ -673,6 +677,13 @@ METHOD Up() CLASS TBrowse return Self +METHOD ColorRect( aRect, aRectColor ) CLASS TBrowse + + ::aRect = aRect + ::aRectColor = aRectColor + +return Self + function TBrowseNew( nTop, nLeft, nBottom, nRight ) local oBrw := TBrowse():New()