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

2000-09-23 15:55 GMT+2 Maurilio Longo <maurilio.longo@libero.it>

Browse Source
This commit is contained in:
Maurilio Longo
2000-09-23 14:01:38 +00:00
parent 9a9c195307
commit d19b0841bd
4 changed files with 236 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/ChangeLog
View File

@@ -1,3 +1,14 @@
2000-09-23 15:55 GMT+2 Maurilio Longo <maurilio.longo@libero.it>
*contrib/mysql/tmysql.prg
! a couple of little fixes.
+contrib/mysql/tsqlbrw.prg
+ a TBrowser for a query (needs a lot of extra work)
*contrib/mysql/makefile
+ added tsqlbrw.prg to compiled files
*source/rtl/tbcolumn.prg
* moved column init to New() method. TBColumnNew() function is now empty and simply returns
TBColumn():New(...)
2000-09-22 18:27 GMT+2 Maurilio Longo <maurilio.longo@libero.it>
*contrib/mysql/tmysql.prg
! a couple of little fixes.

4
harbour/contrib/mysql/tmysql.prg
View File

@@ -218,8 +218,8 @@ CLASS TMySQLQuery
METHOD Skip(nRows) // Same as clipper ones
METHOD Bof() INLINE ::nCurRow < 1
METHOD Eof() INLINE ::nCurRow > ::nNumRows
METHOD Bof() INLINE ::nCurRow == 1
METHOD Eof() INLINE ::nCurRow == ::nNumRows
METHOD RecNo() INLINE ::nCurRow
METHOD LastRec() INLINE ::nNumRows

186
harbour/contrib/mysql/tsqlbrw.prg Normal file
View File

@@ -0,0 +1,186 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* MySQL TBrowse
* A TBrowse on a MySQL Table / query
*
* Copyright 2000 Maurilio Longo <maurilio.longo@libero.it>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbclass.ch"
#include "common.ch"
#include "dbstruct.ch"
#include "mysql.ch"
CLASS TBColumnSQL from TBColumn
DATA oBrw // pointer to Browser containing this column, needed to be able to
// retreive field values from Browse instance variable oCurRow
MESSAGE Block METHOD Block() // When evaluating code block to get data from source this method gets called
METHOD New(cHeading, bBlock, oBrw) // Saves inside column a copy of container browser
ENDCLASS
METHOD New(cHeading, bBlock, oBrw) CLASS TBColumnSQL
super:New(cHeading, bBlock)
::oBrw := oBrw
return Self
METHOD Block() CLASS TBColumnSQL
local xValue := ::oBrw:oCurRow:FieldGet(::Cargo)
local bBlock := "{|| '"
if ISNUMBER(xValue)
xValue := Str(xValue)
elseif ISDATE(xValue)
xValue := DToC(xValue)
endif
bBlock += xValue + " '}"
return &(bBlock)
/*--------------------------------------------------------------------------------------------------*/
/*
This class is more or less like a TBrowseDB() object in that is receives an oQuery/oTable
object and gives back a browseable view of it
*/
CLASS TBrowseSQL from TBrowse
DATA oCurRow // Active row inside table / sql query
DATA oQuery // Query / table object which we are browsing
METHOD New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable)
ENDCLASS
METHOD New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable) CLASS TBrowseSQL
local i, oCol
super:New()
if nTop != NIL
::nTop := nTop
endif
if nLeft != NIL
::nLeft := nLeft
endif
if nBottom != NIL
::nBottom := nBottom
endif
if nRight != NIL
::nRight := nRight
endif
::oQuery := oQuery
// positioning blocks
::SkipBlock := {|n| ::oCurRow := Skipper(@n, ::oQuery), n }
::GoBottomBlock := {|| ::oCurRow := ::oQuery:GetRow(::oQuery:LastRec()), 1 }
::GoTopBlock := {|| ::oCurRow := ::oQuery:GetRow(1), 1 }
// Let's get a row to build needed columns
::oCurRow := ::oQuery:GetRow()
::oQuery:Skip(-1)
// Add a column for each field
for i := 1 to ::oQuery:FCount()
// No bBlock now since New() would use it to find column length, but column is not ready yet at this point
oCol := TBColumnSQL():New(::oCurRow:FieldName(i), nil, Self)
oCol:Width := Max(::oCurRow:aFieldStruct[i][MYSQL_FS_LENGTH], Len(oCol:Heading))
oCol:Cargo := i
::AddColumn(oCol)
next
return Self
static function Skipper(nSkip, oQuery)
//LOCAL lAppend := APP_MODE_ACTIVE( oBrowse )
LOCAL i := 0
do case
case ( nSkip == 0 .or. oQuery:lastrec() == 0 )
// Skip 0 (significant on a network)
oQuery:Skip( 0 )
case ( nSkip > 0 .and. !oQuery:eof() )
while ( i < nSkip ) // Skip Foward
if oQuery:eof()
//iif( lAppend, i++, dbskip( -1 ) )
exit
endif
oQuery:Skip( 1 )
i++
enddo
case ( nSkip < 0 )
while ( i > nSkip ) // Skip backward
if oQuery:bof()
exit
endif
oQuery:Skip( -1 )
i--
enddo
endcase
nSkip := i
//Alert(Str(oQuery:RecNo()) + " : " + str(i))
return oQuery:GetRow(oQuery:RecNo())

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

@@ -51,7 +51,7 @@ CLASS TBColumn
DATA Width // Column display width
DATA ColPos // Temporary column position on screen
METHOD New() // Constructor
METHOD New( cHeading, bBlock ) // Constructor
#ifdef HB_COMPAT_C53
METHOD SetStyle()
@@ -59,14 +59,48 @@ CLASS TBColumn
ENDCLASS
METHOD New() CLASS TBColumn
METHOD New( cHeading, bBlock ) CLASS TBColumn
local cType
::DefColor := { 1, 2 }
::FootSep := ""
::ColPos := 1
::Width := 0
::Heading := iif(!Empty(cHeading), cHeading, "")
/* TOFIX: In Clipper the column widths are not determined at this point.
[vszakats] */
if ISBLOCK( bBlock )
::block := bBlock
cType := Valtype( Eval( bBlock ) )
do case
case cType == "N"
::Width := Len( Str( Eval( bBlock ) ) )
case cType == "L"
::Width := 1
case cType == "C"
::Width := Len( Eval( bBlock ) )
case cType == "D"
::Width := Len( DToC( Eval( bBlock ) ) )
otherwise
::Width := 0
endcase
::Width := iif( cHeading != NIL, Max( Len( cHeading ), ::Width ), ::Width )
endif
return Self
#ifdef HB_COMPAT_C53
METHOD SetStyle() CLASS TBColumn
@@ -75,42 +109,11 @@ METHOD SetStyle() CLASS TBColumn
return Self
#endif
/* TOFIX: In Clipper the column widths are not determined at this point.
[vszakats] */
function TBColumnNew( cHeading, bBlock )
local oCol := TBColumn():New()
local nWidth, cType
return TBColumn():New(cHeading, bBlock)
oCol:Heading := cHeading
if ISBLOCK( bBlock )
oCol:block := bBlock
cType := Valtype( Eval( bBlock ) )
do case
case cType == "N"
nWidth := Len( Str( Eval( bBlock ) ) )
case cType == "L"
nWidth := 1
case cType == "C"
nWidth := Len( Eval( bBlock ) )
case cType == "D"
nWidth := Len( DToC( Eval( bBlock ) ) )
otherwise
nWidth := 0
endcase
oCol:Width := iif( cHeading != NIL, Max( Len( cHeading ), nWidth ), nWidth )
endif
return oCol