fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

19991019-11:55 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-10-19 10:13:14 +00:00
parent e1aaf99e29
commit fd18b30bcd
3 changed files with 130 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -1,3 +1,17 @@
19991019-11:55 GMT+1 Victor Szel <info@szelvesz.hu>
* 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 <alinares@fivetech.com>
* source/rtl/gt/gtwin.c
* Windows apps only create a console when the debugger is linked.

127
harbour/source/rtl/browse.prg
View File

@@ -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.
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 "<none> "
elseif RecNo() == LastRec() + 1
@ nTop, nRight - 40 SAY " "
@ nTop, nRight - 20 SAY " <new>"
else
@ nTop, nRight - 40 SAY iif( Deleted(), "<Deleted>", " " )
@ nTop, nRight - 20 SAY PadR( LTrim( Str( RecNo() ) ) + "/" +;
Ltrim( Str( LastRec() ) ), 16 ) +;
iif( oBrw:hitTop, "<bof>", " " )
endif
return nil

33
harbour/source/rtl/tbrowse.prg
View File

@@ -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()