From d19b0841bd6c2a520a968e2b15418d438610f434 Mon Sep 17 00:00:00 2001 From: Maurilio Longo Date: Sat, 23 Sep 2000 14:01:38 +0000 Subject: [PATCH] 2000-09-23 15:55 GMT+2 Maurilio Longo --- harbour/ChangeLog | 11 ++ harbour/contrib/mysql/tmysql.prg | 4 +- harbour/contrib/mysql/tsqlbrw.prg | 186 ++++++++++++++++++++++++++++++ harbour/source/rtl/tbcolumn.prg | 71 ++++++------ 4 files changed, 236 insertions(+), 36 deletions(-) create mode 100644 harbour/contrib/mysql/tsqlbrw.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9987c1327c..2409422e8a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,14 @@ +2000-09-23 15:55 GMT+2 Maurilio Longo + *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 *contrib/mysql/tmysql.prg ! a couple of little fixes. diff --git a/harbour/contrib/mysql/tmysql.prg b/harbour/contrib/mysql/tmysql.prg index 975a0bf285..6d5ac2b441 100644 --- a/harbour/contrib/mysql/tmysql.prg +++ b/harbour/contrib/mysql/tmysql.prg @@ -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 diff --git a/harbour/contrib/mysql/tsqlbrw.prg b/harbour/contrib/mysql/tsqlbrw.prg new file mode 100644 index 0000000000..b8b9d47437 --- /dev/null +++ b/harbour/contrib/mysql/tsqlbrw.prg @@ -0,0 +1,186 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * MySQL TBrowse + * A TBrowse on a MySQL Table / query + * + * Copyright 2000 Maurilio Longo + * 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()) + + diff --git a/harbour/source/rtl/tbcolumn.prg b/harbour/source/rtl/tbcolumn.prg index 912351e848..140f77da13 100644 --- a/harbour/source/rtl/tbcolumn.prg +++ b/harbour/source/rtl/tbcolumn.prg @@ -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