ADSISSHARED,ADSISREADONLY,ISSHARED,ISREADONLY EN TDBFH

[Miguel Salas]

#define _OBJECTS_CH
#define _VIDEO_CH
#define _DDE_CH
#define _ODBC_CH
#define _DLL_CH
#define _TREE_CH

#include "Fivewin.ch"
#include "TSBrowse.ch"
#Include "TDBFDBF.CH"
#ifdef __HARBOUR__
#INCLUDE "ADS.CH"
REQUEST ADS
REQUEST AdsKeyNo
REQUEST AdsKeyCount
REQUEST AdsGetRelKeyPos
REQUEST AdsSetRelKeyPos
#endif


#define CLR_PINK nRgb(200,225,245) //nRGB( 255, 128, 128)
#define CLR_NBLUE nRGB(200,255,200) //nRGB( 128, 128, 192)

//Graficas
#define GRAPH_TYPE_BAR 1
#define GRAPH_TYPE_LINE 2
#define GRAPH_TYPE_POINT 3
#define GRAPH_TYPE_ALL 4

static oWnd, lInit
MEMVAR cEmpresa, nEmpresa, oBmpLogo, oBmp, cFntW, cBmp, cFont

//----------------------------------------------------------------------------//

function cachaza()
local oBar, oBrush, oIcon, oTimer, oIni
//local cFileMp3 := "f:\campo\bas\LunaFies.mp3"
LOCAL cBmpFondo := ""
local cFileMp3 := ""

PUBLIC cEmpresa, nEmpresa, oBmp, cFntW, cFont, cBmp

SET 3DLOOK ON
SET CENTURY On
SET DATE TO FRENCH
SET EPOCH TO 1999
lInit := .T.
/* INI oIni FILE ".\TABHRA.ini"

GET cEmpresa SECTION "EMPRESA" ENTRY "NomEmp" OF oIni
GET nEmpresa SECTION "EMPRESA" ENTRY "NumEmp" OF oIni
GET cFont SECTION "EMPRESA" ENTRY "fuente" OF oIni DEFAULT "Arial"
GET cFntW SECTION "EMPRESA" ENTRY "hFont" OF oIni

ENDINI
*/
//SetHandleCount( 99 )
DbfCdx()
// DEFINE BRUSH oBrush FILE ".\INGFAGSA.bmp"

cEmpresa := "Fagsa"
nEmpresa := 1
cFont := "Arial"
cFtntW :=""
DEFINE ICON oIcon NAME "Truck"

DEFINE WINDOW oWnd MDI ; //FROM 4,10 TO (MaxRow()-4), (MaxCol()-10) ;
MENU gMenu() ;
TITLE "Salida de cachaza por Horas " ;
ICON oIcon

DEFINE BUTTONBAR oBar OF oWnd 3D
DEFINE BUTTON NAME "tabla" NOBORDER OF oBar ;
ACTION ( CachazaXHora() );
TOOLTIP "Cachaza por horas"

SET MESSAGE OF oWnd ;
TO "Fomento Azucarero del Golfo, S.A. de C.V. Pánuco, Veracruz, México, www.ifagsa.com.mx" ;
CENTERED DATE TIME KEYBOARD


oWnd:bPainted := { |hDc| DrawBmp( hDc , oWnd , cBmpFondo ) }

ACTIVATE WINDOW oWnd maximized //;
// on init CachazaXHora()




return( nil )

//----------------------------------------------------------------------------//

static function gMenu()

local oMenu

MENU oMenu
MENUITEM "&Consultas"
MENU
MENUITEM "&Cachaza por hora..." ;
ACTION CachazaXHora()
SEPARATOR
MENUITEM "&Salir" ACTION oWnd:End()
ENDMENU
*
MENUITEM "&Ventanas"
MENU
MENUITEM "&Titulo Vertical" ACTION oWnd:Tile() ;
WHEN Len( oWnd:oWndClient:aWnd ) > 0
MENUITEM "&Titulo Horizontal" ACTION oWnd:Tile( .t. ) ;
WHEN Len( oWnd:oWndClient:aWnd ) > 0
MENUITEM "&Cascada" ACTION oWnd:Cascade() ;
WHEN Len( oWnd:oWndClient:aWnd ) > 0
MENUITEM "&Siguiente ventana" + Chr( 9 ) + "Ctrl+F6" ;
ACTION oWnd:NextWindow() ;
WHEN Len( oWnd:oWndClient:aWnd ) > 1
SEPARATOR
MENUITEM "&Alinea Iconos" ACTION oWnd:ArrangeIcons() ;
WHEN Len( oWnd:oWndClient:aWnd ) > 0

MENUITEM "&Iconiza Todo" ACTION oWnd:IconizeAll() ;
WHEN Len( oWnd:oWndClient:aWnd ) > 0

MENUITEM "C&ierra Todo" ACTION oWnd:CloseAll() ;
WHEN Len( oWnd:oWndClient:aWnd ) > 0
ENDMENU

oMenu:AddHelp( "FAGSA", "JLAS" )

ENDMENU

return( oMenu )

//-------------------------------------------------------------------------------//

STATIC FUNCTION Refr_Wnd( hDC )

LOCAL hWnd, nColor := 255
LOCAL aRect, nSteps
LOCAL oBrush, nI

LOCAL aCoor

IF lInit
aCoor := GetCoors(GetDeskTopWindow()) // Coordenadas de ventana
IF aCoor[ 3 ] >= 768 // si > 600x800 la centra
aCoor[ 1 ] := ( aCoor[ 3 ] - 580 ) / 2
aCoor[ 2 ] := ( aCoor[ 4 ] - 800 ) / 2
aCoor[ 3 ] := 580
aCoor[ 4 ] := 800
oWnd:Move( aCoor[ 1 ], aCoor[ 2 ], aCoor[ 4 ], aCoor[ 3 ] )
ELSE
oWnd:Maximize()
ENDIF
lInit:=.F.
ENDIF

hWnd := oWnd:hWnd
aRect := GetClientRect( hWnd )
nSteps:=( aRect[ 3 ] - aRect[ 1 ] ) / 3

aRect[ 3 ] := 0
FOR nI := 1 to nSteps
aRect[ 3 ] += 3
DEFINE BRUSH oBrush COLOR RGB( nColor, nColor, nColor )
FillRect( hDC, aRect, oBrush:hBrush )
RELEASE BRUSH oBrush
aRect[ 1 ] += 3
nColor -= 1
NEXT nI

SetBkMode( hDC, 1 )
SetTextColor( hDC, CLR_WHITE )
DrawText(hDC, "© Miguel Salas",{oWnd:nHeight - 105, oWnd:nWidth - 135, oWnd:nHeight - 10, oWnd:nWidth - 10 } )

RETURN (NIL)

//----------------------------------------------------------------------------//

function CachazaXHora()

local oWndChild, oBar, oLbx, oACachaza
local bData, oBtn, oGet, oFont, bcolor, ;
oFont1, oIco
//Local aBrush := Array(2)
LOCAL aArr := {}
LOCAL nTot := ARRAY(10)
LOCAL nAcumAnt[ 1 ]
LOCAL nPromedio := 0, dFecha1
LOCAL nTonSem[ 1 ]


DATABASE NEW oACachaza FILE ".\dat\acachaza.DBF" SHARED via "DBFCDX" ;
INDEX aCachaza.CDX

oACachaza:lBuffer := .T.
oACachaza:Setorder(1)

IF oACachaza:LASTREC() == 0
MsgInfo("Tabla vacia" + CRLF + "No hay nada que mostrar")
oACachaza:End()
return nil
ENDIF

oACachaza:last()

dFecha1 := oACachaza:AH_fecha

// CursorWait()

DEFINE FONT oFont1 NAME "MS Sans Serif" SIZE 0, -12
DEFINE ICON oIco NAME "alert.ico"

DEFINE WINDOW oWndChild MDIchild ;
OF oWnd

DEFINE BUTTONBAR oBar OF oWndChild 3D

DEFINE BUTTON NAME "Primero" ;
NOBORDER OF oBar TOOLTIP "Inicio de Zafra" ;
ACTION ( oACachaza:first(), dFecha1 := oACachaza:AH_fecha, aArr := {},;
CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, @nPromedio, oWndChild, @nTonSem ) )

DEFINE BUTTON NAME "Previo" ;
NOBORDER OF oBar TOOLTIP "Dia Anterior";
ACTION ( dFecha1--, aArr := {},;
CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, @nPromedio, oWndChild, @nTonSem) )


DEFINE BUTTON NAME "Siguiente" ;
NOBORDER OF oBar TOOLTIP "Siguiente Registro";
ACTION ( dFecha1++, aArr := {}, ;
CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt,dFecha1, @nPromedio, oWndChild, @nTonSem) )

DEFINE BUTTON NAME "Ultimo" ;
NOBORDER OF oBar TOOLTIP OemToAnsi( "Ultimo Registro" ) ;
ACTION ( oACachaza:LAST() , dFecha1 := oACachaza:AH_fecha, aArr := {}, ;
CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, @nPromedio, oWndChild, @nTonSem ) )

DEFINE BUTTON NAME "Buscar" ;
NOBORDER OF oBar TOOLTIP "Busca una Fecha especifica";
ACTION ( dFecha1 := msgdate(,"Dia de Zafra"), aArr := {}, ;
CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, @nPromedio, oWndChild, @nTonSem ) )

DEFINE BUTTON NAME "Impresora" GROUP ;
NOBORDER OF oBar TOOLTIP "Imprimir ";
ACTION oLbx:Report("Salida de Cachaza por hora", .T.)

DEFINE BUTTON NAME "Histogr" ;
NOBORDER OF oBar TOOLTIP "Gráfica de la entrada por horas";
ACTION msginfo( "Hola" ) //Graficar( aArr, dFecha1, nPromedio )

DEFINE BUTTON NAME "Actualizar" GROUP ;
NOBORDER OF oBar TOOLTIP "Refresca datos";
ACTION aArr := {},;
CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, @nPromedio, oWndChild, @nTonSem )

DEFINE BUTTON NAME "Salir" GROUP ;
NOBORDER OF oBar TOOLTIP "Salir de esta pantalla";
ACTION oWndChild:End()

@ 00, 00 BROWSE oLbx ALIAS ARRAY OF oWndChild UPDATE

CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, @nPromedio, oWndChild, @nTonSem )

? "hola3"

bColor := { || If( oLbx:nAt % 2 == 0, CLR_PINK, CLR_NBLUE ) }

oLbx:lCellbrw := .T.
// oLbx:SetColor( { 2, 4 }, { aBrush[1], aBrush[2] } )

oLbx:SetColor( { 1, 3, 5, 6, 13, 15 }, ;
{ CLR_BLUE, CLR_YELLOW, CLR_BLUE, ;
{ CLR_WHITE, CLR_HRED }, ; // degraded cursor background color
CLR_WHITE, CLR_HRED } ) // text colors

oLbx:SetColor( { 2, 4, 14 }, ;
{ { CLR_WHITE, CLR_HBLUE }, ; // degraded cells background color
{ CLR_HGRAY, CLR_BLACK }, ; // degraded headers backgroud color
{ CLR_HRED, CLR_HGREEN } } ) // degraded order column background color


ADD COLUMN TO BROWSE oLbx DATA ARRAY ELEMENT 1;
TITLE "Dia" ;
SIZE 70 ;
COLORS CLR_BLACK, bColor; // background color from a Code Block
3DLOOK TRUE, TRUE, TRUE; // cells, titles, footers
ALIGN DT_LEFT, DT_CENTER, DT_RIGHT ; // cells, title, footer
FOOTER { || "Dia Anterior" + CRLF +;
"Del dia" + CRLF + ;
"A LA SEMANA" + CRLF +;
"Dia Anterior" + CRLF +;
"Del Dia" + CRLF +;
"Total" }

ADD COLUMN TO BROWSE oLbx DATA ARRAY ELEMENT 2;
TITLE "Hora" ;
ALIGN DT_CENTER, DT_CENTER; // let's align cells to right and center title
SIZE 44 ;
COLORS CLR_BLACK, bColor ; // background color from a Code Block
3DLOOK TRUE, TRUE, TRUE ; // cells, titles, footers
FOOTER "="

ADD COLUMN TO BROWSE oLbx DATA ARRAY ELEMENT 3;
TITLE "Bruto" ;
ALIGN DT_RIGHT, DT_CENTER;
SIZE 240 ;
COLORS CLR_BLACK, bColor;
3DLOOK TRUE, TRUE, TRUE;
FOOTER { || Transform( nTonsem[ 1 ], "#,###,###.###" ) + CRLF +; /* >Dia Anterior */
Transform( nTot[ 1 ], "##,###.###" ) + CRLF +; /* Del dia */
Transform( nTonsem[ 1 ] + nTot[ 1 ], "###,###.###" ) + CRLF +; /* A LA SEMANA */
Transform( nAcumAnt[1], "#,###,###.###" ) + CRLF +; /* >Dia Anterior */
Transform( nTot[ 1 ], "##,###.###" ) + CRLF +; /* Del Dia */
Transform( nAcumAnt[ 1 ] + nTot[ 1 ], "#,###,###.###" ) } /* >Total */


ADD SUPER HEADER TO oLbx FROM COLUMN 3 TO COLUMN 3 ;
TITLE OemToAnsi("Toneladas de cachaza por horas") 3DLOOK



oLbx:nHeightCell += 6
oLbx:nHeightSuper += 7
oLbx:ChangeFont( oFont1,, 1)
//oLbx:SetColor( {3,4},{CLR_BLACK,CLR_HGRAY} )
oLbx:SetColor({9},{CLR_RED},)

// 3D text bas-relief in all headers
oLbx:Set3DText( .T., .T.,, 3 )

// 3D text raised in cells of column 2
//oLbx:Set3DText( .T., .T., 2, 1 )

// adjust the header height
oLbx:nHeightHead := 25

oWndChild:SetControl(oLbx)
? "hola4"

ACTIVATE WINDOW oWndChild ;
VALID ( oLbx:End(), oFont1:End(), oIco:End(), SysRefresh(),;
oACachaza:End(), .T. )

return nil

/*-------------------------------------------------------------*/

static function CargaDatos( oACachaza, oLbx, aArr, nTot, nAcumAnt, dFecha1, nPromedio, oWndChild, nTonSem )

local nTGCN := 0, n
local dFecha2, dFechaini
LOCAL oDb := oACachaza:Clone() //Clonamos la base datos en memoria
LOCAL nPromTH := 0, nPromHras := 0, nTonsHra := 0

Afill( nTot, 0)

IF oACachaza:Ah_fecha == DATE()
IF oACachaza:Ah_Hora < "06"
dFecha1--
ENDIF
ENDIF
dFecha2 := dFecha1 + 1
// busca la fecha a consultar ( B£squeda aproximada )
oACachaza:SEEK(dtos(dFecha1)+"06", .T., .F. )
IF oACachaza:Eof() .OR. oACachaza:AH_fecha != dFecha1

MsgAlert("Sin Informaci¢n en :"+dtoc(dfecha1))
RETURN .F.
ENDIF

oACachaza:Prior()

if oACachaza:bof()

FOR n := 1 TO 1
nAcumAnt[ n ] := 0
nTonSem[ n ] := 0
NEXT

else

nAcumAnt[ 1 ] := oACachaza:ah_a_tonbr

oACachaza:Next()

FOR n := 1 TO 1
nTonSem[ n ] := 0
NEXT

dFechaIni := oDb:aH_fecha - ( dow( oDb:ah_fecha ) - 1 )
IF dFechaIni != dFecha1

oDb:Setscope( dtos( dFechaIni )+ "06", DTOS( dFecha1 ) + "05" )

do while ! oDb:Eof()

nTonSem[ 1 ] += oDb:ah_h_tonbr
oDb:next():qload()

ENDDO

ENDIF

ENDIF

nTGCN := 0

oACachaza:setscope(dtos( dFecha1) + "06", DTOS(dFecha2) + "05" )

DO WHILE ( ! oACachaza:eof() )

nTGCN += oACachaza:ah_h_tonbr
AADD( aArr, {transform(oACachaza:ah_fecha, "@D"),;
strzero(val(oACachaza:ah_hora) + 1,2),;
oACachaza:ah_h_tonbr, ;
nTGCN,;
oACachaza:ah_a_tonbr } )

oACachaza:skip(1)

ENDDO


// Totalizar columnas
AEval( aArr, { | e | nTot[1] += e[ 3 ], ; // Tons Brutas
nTot[2] := nTGCN , ; // Acumulado parcial
nTonsHra += e[ 4 ] })

nPromedio := round( nTot[1] / len( aArr ), 3 )

nPromTH := nTonsHra / nTGCN

oWndChild:SetText( "Dia de Zafra: "+ DTOC( dFecha1 ) +space(10)+;
"Promedio por Hora:"+LTRIM( str( nPromedio ) ) + " Tons." )

oLbx:SetArray( aArr )
oLbx:refresh()

oACachaza:ClearScope()

return .T.
//----------------------------------------------------------------------------//

FUNCTION DrawBmp( hDc , oWnd , cBmpFile )
/*
FUNCTION DrawBmp( hDc , oWnd , cBmpFile )
Autor : Víctor Manuel Tomás Díaz
Vikthor
*/

LOCAL nTop, nLeft, nBottom, nRight
LOCAL oBmpFondo
LOCAL nWidth := oWnd:nWidth(), nHeight := oWnd:nHeight()

DEFAULT cBmpFile := ""

DEFINE BITMAP oBmpFondo FILE ( cBmpFile )

IF oWnd:oMsgBar != nil // Si la ventana tiene Barra de mensajes
nHeight -= oWnd:oMsgBar:nHeight
ENDIF
IF oWnd:oBar != nil // Si la Ventana tiene Barra de botones
nHeight -= oWnd:oBar:nHeight
ENDIF
nHeight -= 40 // +- Altura de la barra de titulo y menu
#IFDEF __HARBOUR__
DrawBitmap( hDC, oBmpFondo:hBitmap , 0, 0, nWidth, nHeight )
#ELSE
IF At("2.1",FWVERSION) > 0
DrawBitmap( hDC, oBmpFondo:hBmpPal , 0, 0, nWidth, nHeight )
ELSE
DrawBitmap( hDC, oBmpFondo:hBitmap , 0, 0, nWidth, nHeight )
ENDIF
#ENDIF
oBmpFondo:End()
RETURN( NIL )

[Antonio Linares]

> 2.- Cada que le toca procesar algo se cicla.

Que error te da ?

[FiveWiDi]

Hola a todos,

hace días que empecé a revisar/modificar TDBF, y ya consigo utilizarla aún sin eliminar TIndex de Fivewin.

Creo que el método Clone() es erróneo para la versión actual de Harbour, me explico.

Este método realiza:

oClon:aTField := __objClone( oDb:aTField )
oClon:aTIndex := __objClone( oDb:aTIndex )
#else
oClon:aTField := oClone( oDb:aTField )
oClon:aTIndex := oClone( oDb:aTIndex )


clonando en realidad unas ARRAYs de objetos.

Por tanto debería realizarse un Aclone() y posteriormente un Oclone() de cada elemento de la nueva ARRAY.

Saludos.
Carlos G.

[FiveWiDi]

LOCAL oDb := oACachaza:Clone() //Clonamos la base datos en

Prueba con sustituir la línea anterior por esta otra:

LOCAL oDb := oACachaza:Clone( .T. ) //Clonamos la base datos en

Si no me equivoco en la misma función, estás estableciendo un Scope a oDb y otro a oAcachaza cuando ambas tienen el mismo alias/área de trabajo (no me he fijado si hay más cosas).

Por otro lado este es el metodo Clone() de Tdbf.prg modificado (sin optimizar) que utilizo con FWH 7.01 y parece que funciona correctamente:

Saludos
******************************
METHOD Clone( lNewArea, cComment ) CLASS TDbf

local oDb := Self
local oClon

DEFAULT lNewArea := .f.
DEFAULT cComment := ::cComment

if lNewArea
oClon := DbfServer( oDb:cFile )
oClon:New( oDb:cFile, oDb:cName, oDb:cRDD, cComment, oDb:cPath )
#ifdef __HARBOUR__

//oClon:aTField := __objClone( oDb:aTField )
//oClon:aTIndex := __objClone( oDb:aTIndex )

// 2 línias sustituyen 2 anteriores. CG
oClon:aTField := aclone( oDb:aTField )
oClon:aTIndex := aclone( oDb:aTIndex )

#else

//oClon:aTField := oClone( oDb:aTField )
//oClon:aTIndex := oClone( oDb:aTIndex )

// 2 línias sustituyen 2 anteriores. CG
oClon:aTField := aclone( oDb:aTField )
oClon:aTIndex := aclone( oDb:aTIndex )

#endif

oClon:FieldCount := len( oClon:aTField )
AEval( oClon:aTField, { |o| o:oDbf := oClon } )
AEval( oClon:aTIndex, { |o| o:oDbf := oClon } )
oClon:Activate( oDb:lRecycle, oDb:lShared, oDb:lReadOnly, oDb:lProtec )

else
#ifdef __HARBOUR__
oClon := __objClone( oDb )

//oClon:aTField := __objClone( oDb:aTField )
//oClon:aTIndex := __objClone( oDb:aTIndex )

// 2 línias sustituyen 2 anteriores. CG
oClon:aTField := aclone( oDb:aTField )
oClon:aTIndex := aclone( oDb:aTIndex )

#else
oClon := oClone( oDb )

//oClon:aTField := oClone( oDb:aTField )
//oClon:aTIndex := oClone( oDb:aTIndex )

// 2 línias sustituyen 2 anteriores. CG
oClon:aTField := aclone( oDb:aTField )
oClon:aTIndex := aclone( oDb:aTIndex )

#endif

oClon:cComment := cComment
AEval( oClon:aTField, { |o| o:oDbf := oClon } )
AEval( oClon:aTIndex, { |o| o:oDbf := oClon } )

endif

// Inicio líneas añadidas CG
oClon:AutoField()
AEval( oClon:aTField, { |o| o:Activate() } )
oclon:AutoIndex()
oClon:IdxActivate()
// Fin líneas añadidas CG

return( oClon )
******************************

[Miguel Salas]

hola podrias pasarme la tdbfh y si tienes la TSbrowse que tienes funcionando con FW701, quizas por alli este el mal, ya que no me deja usar objetos database, set index, etc, esto que estube haciendo me parece demasiado para actualizar mis programas, imaginate si este es uno solo y no he podido hacerlo funcionar, que sera cuando me ponga a corregirlos todos, si me dijeron "nada mas recompila y ya", pues asi debe ser, si todos mis programas funcionan con FW2.4, deden funcionar con 7.01 sin cambios, o minimos cambios.

[Antonio Linares]

Miguel,

FWH siempre mantiene compatibilidad con el código anterior, lo que ocurre es que si se está usando una librería de terceros como en este caso es la clase TDbf, pues pueden aparecer este tipo de errores por el uso de funciones que han cambiado en Harbour, etc.

[Miguel Salas]

totalmente de acuedo Antonio, por eso pido si alguien tiene funcionando estas libs con 701 , me las haga llegar, talvez desde alli esta mi error.
Gracias

[FiveWiDi]

totalmente de acuedo Antonio, por eso pido si alguien tiene funcionando estas libs con 701 , me las haga llegar, talvez desde alli esta mi error.
Gracias

Prueba con este:

http://hyperupload.com/download/0207653 ... 1.zip.html

Parece que funciona con Harbour 1.01 y FiveWin 7.04

Saludos
Carlos G.