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

Updating TBrowse files

Browse Source
This commit is contained in:
Alexander S.Kresin
1999-08-12 18:47:11 +00:00
parent 65d6662d67
commit 5de5b52de3
5 changed files with 134 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

84
harbour/ChangeLog
View File

@@ -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 <dholm@jsd-llc.com>
* funclist.txt
* Updated the status of several functions to S or R
@@ -19,20 +27,20 @@
19990812-14:10 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*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 <alinares@fivetech.com>
* source/rtl/tbrowse.prg
* enhanced
@@ -139,13 +147,13 @@
Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* 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 <Gonzalo.Diethelm@jda.cl>
19990809-12:20 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*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 <Gonzalo.Diethelm@jda.cl>
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 <Gonzalo.Diethelm@jda.cl>
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 <Gonzalo.Diethelm@jda.cl>
*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 <info@szelvesz.hu>
* source/runner/runner.c
source/runner/Makefile
@@ -543,12 +551,12 @@ Mon Aug 09 11:53:18 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
Fri Aug 06 20:04:05 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* 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

20
harbour/funclist.txt
View File

@@ -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;

11
harbour/source/rtl/tbcolumn.prg
View File

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

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

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

15
harbour/tests/working/testbrw.prg
View File

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