Clases y Prgs

Clases y Prgs

Postby servicomver » Tue Nov 09, 2010 9:37 pm

Hola a todos:
Por necesidad pretendo cambiarme a xharbour, deje fivewin 2.3 pero me pasa lo siguiente:
no consigo modificar el archivo buildx.bat para usar varios prgs.
como se incluyen las clases en ese archivo ???'

Estoy empezando con un programa sencillo, antes usaba TWbrowse, tBtnGet, y asi varias librerias y clases, pero por lo que he leido creo que ya no funcionan en xharbour.

donde puedo conseguir esas clases nuevas y librerias.

Aprovechando de su tiempo y paciencia ojala puedan enviarme un ejemplo de enlace de varios prg con varias clases.

y algun ejemplo de wbrowse.
servicomver@hotmail.com
Gracias y saludos
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm

Re: Clases y Prgs

Postby Patricio Avalos Aguirre » Wed Nov 10, 2010 1:57 pm

Hola

revisa este link, Utilities / Utilidades

http://forums.fivetechsupport.com/viewforum.php?f=17
Saludos
Patricio

__________________________________________________________________
Version: Harbour 3.2.0dev (r1307082134),Compiler: Borland C++ 5.8.2 (32-bit)
PCode version: 0.3, FWH 13.2
http://www.sialm.cl
User avatar
Patricio Avalos Aguirre
 
Posts: 1060
Joined: Fri Oct 07, 2005 1:56 pm
Location: La Serena, Chile

Re: Clases y Prgs

Postby servicomver » Wed Nov 10, 2010 6:20 pm

estoy tratando de ir poco a poco con el cambio de fivewin a xharbour
pero algo tan simple como este codigo que encontre no me funciona
Include "FiveWin.Ch"


Function Main()
Local oDlg
Local oGet
local cVar := space( 30 )

DEFINE DIALOG oDlg from 0,0 to 400,400 pixel

@ 15,15 get oGet var cVar picture "@!" bitmap "chkyes.bmp" action( msginfo( "action" ) );
size 120,12 of oDlg pixel


ACTIVATE DIALOG oDlg

return nil
al compilar sale el error:
E0030 SYNTAX ERROR: "PARSE ERROR AT "@" "


UTILIZO ESTE BUILDX.BAT

@ECHO OFF
CLS
ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
ECHO ³ FiveWin for xHarbour 6.12 - December 2006 xHarbour development power ³Ü
ECHO ³ (c) FiveTech, 1993-2006 for Microsoft Windows 95/98/NT/2000/ME and XP ³Û
ECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ
ECHO ÿ ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß

if A%1 == A GOTO :SINTAX
if NOT EXIST %1.prg GOTO :NOEXIST

ECHO Compiling...

set hdir=c:\xharbour
set bcdir=c:\bcc55

%hdir%\bin\harbour %1 /n /i..\include;%hdir%\include /w /p %2 %3 > clip.log
@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT

echo -O2 -e%1.exe -I%hdir%\include %1.c > b32.bc
%bcdir%\bin\bcc32 -M -c -v @b32.bc
:ENDCOMPILE

IF EXIST %1.rc %bcdir%\bin\brc32 -r %1

echo c0w32.obj + > b32.bc
echo %1.obj, + >> b32.bc
echo %1.exe, + >> b32.bc
echo %1.map, + >> b32.bc
echo ..\lib\Fivehx.lib ..\lib\FiveHC.lib + >> b32.bc
echo %hdir%\lib\rtl.lib + >> b32.bc
echo %hdir%\lib\vm.lib + >> b32.bc
echo %hdir%\lib\gtgui.lib + >> b32.bc
echo %hdir%\lib\lang.lib + >> b32.bc
echo %hdir%\lib\macro.lib + >> b32.bc
echo %hdir%\lib\rdd.lib + >> b32.bc
echo %hdir%\lib\dbfntx.lib + >> b32.bc
echo %hdir%\lib\dbfcdx.lib + >> b32.bc
echo %hdir%\lib\dbffpt.lib + >> b32.bc
echo %hdir%\lib\hbsix.lib + >> b32.bc
echo %hdir%\lib\debug.lib + >> b32.bc
echo %hdir%\lib\common.lib + >> b32.bc
echo %hdir%\lib\pp.lib + >> b32.bc

rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> b32.bc
rem echo %hdir%\lib\Ace32.lib + >> b32.bc

echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc
echo %bcdir%\lib\psdk\nddeapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\iphlpapi.lib, >> b32.bc

IF EXIST %1.res echo %1.res >> b32.bc

rem uncomment this line to use the debugger and comment the following one
rem %bcdir%\bin\ilink32 -Gn -Tpe -s -v @b32.bc
%bcdir%\bin\ilink32 -Gn -aa -Tpe -s -v @b32.bc

IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Application successfully built
%1
GOTO EXIT
ECHO

rem delete temporary files
@del %1.c

:LINKERROR
ECHO * There are errors
GOTO EXIT

:SINTAX
ECHO SYNTAX: Build [Program] {-- No especifiques la extensi¢n PRG
ECHO {-- Don't specify .PRG extension
GOTO EXIT

:NOEXIST
ECHO The specified PRG %1 does not exist

:EXIT

ALGUNA SUGERENCIA, OBVIO QUE ALGO ESTOY HACIENDO MAL.
LO QUE INTENTO ES PONER UN BOTON EN UN GET COMO LO HACIA CON BTNGET EN FIVEWIN
SALUDOS
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm

Re: Clases y Prgs

Postby Patricio Avalos Aguirre » Wed Nov 10, 2010 7:54 pm

Hola

Yo utilizo estos archivos, pueden que te sirvan

Ademas debes crear las carpetas
Code: Select all  Expand view  RUN
OBJ
C
RECURSO
 


do.bat
Code: Select all  Expand view  RUN
@ECHO OFF
CLS
ECHO Compiling...
ECHO.

c:\borland\bcc582\bin\make -fwcta.rmk

if errorlevel 1 goto error
Wcta
goto fin

:error
pause

:fin

 


wcta.rmk
Code: Select all  Expand view  RUN
HBDIR=c:\xharbour
BCDIR=c:\borland\bcc582
FWDIR=c:\fwh

#change these paths as needed
.path.PRG = .\;.\Classes;.\classes\dt;
.path.OBJ = .\obj
.path.CH  = $(FWDIR)\include;$(HBDIR)\include;include
.path.C   = .\;.\C
.path.rc  = .\

#important: Use Uppercase for filenames extensions, in the next two rules!

PRG =        \
Wcta.PRG    \
Articu.PRG    \
Indica.PRG     \
FastRepH.PRG

PROJECT    : wCta.exe

#$(BCDIR)\bin\ilink32 -Gn -aa -Tpe -s @b32.bc

Wcta.exe  : $(PRG:.PRG=.OBJ) $(C:.C=.OBJ) recurso\wcta.res recurso\toolbar1.res
   $(BCDIR)\bin\ilink32 -Gn -aa -Tpe -s @b32.bc

.PRG.OBJ:
  $(HBDIR)\bin\harbour $< /a /n /w1 /es2 /Oobj\ /I$(FWDIR)\include;$(HBDIR)\include;include
  $(BCDIR)\bin\bcc32 -c -tWM -I$(HBDIR)\include -oobj\$& obj\$&.c

.C.OBJ:
  echo -c -tWM -D__HARBOUR__ -DHB_API_MACROS > tmp
  echo -I$(HBDIR)\include;$(FWDIR)\include >> tmp
  $(BCDIR)\bin\bcc32 -oobj\$& @tmp c\$&.c
  del tmp
 


b32.bc
Code: Select all  Expand view  RUN
c:\borland\bcc582\lib\c0w32.obj +
OBJ\Wcta.Obj +
OBJ\Articu.obj OBJ\indica.obj OBJ\FastRepH.OBJ, +
wcta.exe, +
wcta.map, +
c:\Fwh\lib\FiveHX.LIB +
c:\Fwh\lib\FiveHc.LIB +
c:\xharbour\lib\rtl.lib  +
c:\xharbour\lib\vm.lib    +
c:\xharbour\lib\gtgui.lib +
c:\xharbour\lib\lang.lib  +
c:\xharbour\lib\macro.lib +
c:\xharbour\lib\codepage.lib +
c:\xharbour\lib\rdd.lib   +
c:\xharbour\lib\dbfcdx.lib+
c:\xharbour\lib\dbffpt.lib+
c:\xharbour\lib\hbsix.lib +
c:\xharbour\lib\common.lib+
c:\xharbour\lib\pp.lib    +
c:\xharbour\lib\pcrepos.lib+
c:\xharbour\lib\ct.lib +
c:\borland\bcc582\lib\cw32.lib +
c:\borland\bcc582\lib\import32.lib +
c:\borland\bcc582\lib\psdk\odbc32.lib+
c:\borland\bcc582\lib\psdk\rasapi32.lib+
c:\borland\bcc582\lib\psdk\nddeapi.lib+
c:\borland\bcc582\lib\psdk\msimg32.lib+
c:\borland\bcc582\lib\psdk\iphlpapi.lib,, +
recurso\wcta.res recurso\toolbar1.res
Saludos
Patricio

__________________________________________________________________
Version: Harbour 3.2.0dev (r1307082134),Compiler: Borland C++ 5.8.2 (32-bit)
PCode version: 0.3, FWH 13.2
http://www.sialm.cl
User avatar
Patricio Avalos Aguirre
 
Posts: 1060
Joined: Fri Oct 07, 2005 1:56 pm
Location: La Serena, Chile

Re: Clases y Prgs

Postby servicomver » Wed Nov 10, 2010 10:12 pm

ya intente con tu ejemplo pero en la linea que uso para poner el action al get me marca el siguiente error
error e0030: syntax error "parse error at @

necesito alguna clase especial TGET para poder hacerlo ????
alguien la tiene, o alguna solucion ???
gracias
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm

Re: Clases y Prgs

Postby wmormar » Thu Nov 11, 2010 5:34 am

servicomver,

El error que mencionas quiere decir que la sintaxis no es correcta. Verifica que la sintaxis sea correcta y compila de nuevo.
William, Morales
Saludos

méxico.sureste
User avatar
wmormar
 
Posts: 1074
Joined: Fri Oct 07, 2005 10:41 pm
Location: México

Re: Clases y Prgs

Postby Patricio Avalos Aguirre » Thu Nov 11, 2010 3:49 pm

Hola

Al parecer la version de FWH que tienes no acepta el comando ACTION..

revisa el archivo fivewin.ch a ver si la tiene
Saludos
Patricio

__________________________________________________________________
Version: Harbour 3.2.0dev (r1307082134),Compiler: Borland C++ 5.8.2 (32-bit)
PCode version: 0.3, FWH 13.2
http://www.sialm.cl
User avatar
Patricio Avalos Aguirre
 
Posts: 1060
Joined: Fri Oct 07, 2005 1:56 pm
Location: La Serena, Chile

Re: Clases y Prgs

Postby servicomver » Thu Nov 11, 2010 11:50 pm

Ya logre enlazar varios prg y usar las librerias q antes usaba en fivewin
pero resulta que al usar la clase twbrowse se "borran" los registros y queda en negro al mover el cursor

ya desinstale todo y volvi a instalar (por tantas pruebas que he hecho) y no encuentro el problema:

asi quedo el buildx.bat
@ECHO OFF
CLS
ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
ECHO ³ FiveWin for xHarbour 7.01 - January 2007 xHarbour development power ³Ü
ECHO ³ (c) FiveTech, 1993-2006 for Microsoft Windows 95/98/NT/2000/ME and XP ³Û
ECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ
ECHO ÿ ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß


set hdir=c:\xharbour
set bcdir=c:\bcc55
set fwdir=c:\fwh
set lib=%xdir%\lib;%bcdir%\lib;%fwdir%\lib
set include=%xdir%\include;%bcdir%\include;%fwdir%\include

if A%1 == A GOTO :SINTAX
if NOT EXIST %1.prg GOTO :NOEXIST

ECHO Compiling...

%hdir%\bin\harbour %1 /n /i%fwdir%\include;%hdir%\include /w /p %2 %3 > clip.log
%hdir%\bin\harbour btnget /n /i%fwdir%\include;%hdir%\include /w /p %2 %3 > clip.log
%hdir%\bin\harbour wbrowse /n /i%fwdir%\include;%hdir%\include /w /p %2 %3 > clip.log


@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT

rem echo -O2 -e%1.exe -I%hdir%\include %1.c > b32.bc
rem %bcdir%\bin\bcc32 -M -c -v @b32.bc

%bcdir%\bin\bcc32 -M -c -v -O2 -I%hdir%\include %1.c
%bcdir%\bin\bcc32 -M -c -v -O2 -I%hdir%\include %btnget.c

%bcdir%\bin\bcc32 -M -c -v -O2 -I%hdir%\include %wbrowse.c



:ENDCOMPILE

IF EXIST %1.rc %bcdir%\bin\brc32 -r %1

echo c0w32.obj + > b32.bc
echo %1.obj btnget.obj wbrowse.obj, + >> b32.bc
echo %1.exe, + >> b32.bc
echo %1.map, + >> b32.bc
echo %fwdir%\lib\Fivehx.lib %fwdir%\lib\FiveHC.lib + >> b32.bc
echo %hdir%\lib\rtl.lib + >> b32.bc
echo %hdir%\lib\vm.lib + >> b32.bc
echo %hdir%\lib\gtgui.lib + >> b32.bc
echo %hdir%\lib\btnget32.lib + >> b32.bc
echo %hdir%\lib\twbrowse.lib + >> b32.bc
echo %hdir%\lib\lang.lib + >> b32.bc
echo %hdir%\lib\macro.lib + >> b32.bc
echo %hdir%\lib\rdd.lib + >> b32.bc
echo %hdir%\lib\dbfntx.lib + >> b32.bc
echo %hdir%\lib\dbfcdx.lib + >> b32.bc
echo %hdir%\lib\dbffpt.lib + >> b32.bc
echo %hdir%\lib\hbsix.lib + >> b32.bc
echo %hdir%\lib\debug.lib + >> b32.bc
echo %hdir%\lib\common.lib + >> b32.bc
echo %hdir%\lib\pp.lib + >> b32.bc

rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> b32.bc
rem echo %hdir%\lib\Ace32.lib + >> b32.bc

echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc
echo %bcdir%\lib\psdk\nddeapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\iphlpapi.lib, >> b32.bc

IF EXIST %1.res echo %1.res >> b32.bc

rem uncomment this line to use the debugger and comment the following one
rem %bcdir%\bin\ilink32 -Gn -Tpe -s -v @b32.bc
%bcdir%\bin\ilink32 -Gn -aa -Tpe -s -v @b32.bc

IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Application successfully built
%1
GOTO EXIT
ECHO

rem delete temporary files
@del %1.c

:LINKERROR
ECHO * There are errors
GOTO EXIT

:SINTAX
ECHO SYNTAX: Build [Program] {-- No especifiques la extensi¢n PRG
ECHO {-- Don't specify .PRG extension
GOTO EXIT

:NOEXIST
ECHO The specified PRG %1 does not exist

:EXIT



el ejemplo es el que viene por default en la clase twbrowse 2.1 , al mover el cursor los registros se ponen negros (no se ven) solo se ve el cursor activo , el que tiene el prompt, alguna idea ???
no movi nada del ejemplo:

#include "FiveWin.ch"
#include "WColors.ch"

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

function Main()

local oWnd, oLbx
local cKey:= "Upper(Nombre)", oItem
local cDefaultMsg:= "(C) 1994-2002, CeSoTech PC Solutions"
local oFont

DEFINE FONT oFont NAME GetSysFont() SIZE 0,-10

use clientes
index on &cKey to clientes


DEFINE WINDOW oWnd FROM 0,0 TO 33,47 +25 ;
TITLE "Welcome to TWBrowse ::bSeek .and. MultiLine FAST Power !!!" ICON "\FWH\ICONS\FiveWin.ico" ;

oWnd:SetFont( oFont )

TWBrowse():lHScroll:= .F.
@0,0 LISTBOX oLbx FIELDS clientes->nombre + CRLF + clientes->Direccion, ;
clientes->Telefono, ;
Str(clientes->edad,2) ;
OF oWnd SIZE 480,200 ;
HEADERS "Apellido y Nombres y Direccion",;
"Telefono", "Edad" ;
SIZES 250,50,50


oWnd:oClient:= oLbx

oLbx:bBkColor:= {|nRow,nCol,nStyle| If( nStyle==0 .and. nCol==2, ;
CLR_YELLOW, ) }

oLbx:lAdjLastCol := .F.
oLbx:nLineStyle := 2
oLbx:bSeek := {|lRet| oLbx:DbfSeek(.T.) }
oLbx:bUpdateBuffer:= {|| UpdateBuffer( oWnd:oMsgBar, ;
cDefaultMsg, oLbx:cBuffer ) }
oLbx:nLineHeight*= 2
oLbx:nHeaderStyle:= 2

SET MESSAGE OF oWnd TO cDefaultMsg DATE KEYBOARD NOINSET



DEFINE MSGITEM oItem OF oWnd:oMsgBar PROMPT "www.cesotech.com.ar" ;
COLOR GetSysColor(COLOR_HIGHLIGHTTEXT),GetSysColor( COLOR_HIGHLIGHT );
SIZE 135 ACTION WinExec("Start www.cesotech.com.ar",0)


ACTIVATE WINDOW oWnd

RELEASE FONT oFont

return nil

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

static function UpdateBuffer( oMsgBar, cDefaultMsg, cBuffer )
local nClrText:= oMsgBar:nClrText
local cMsg
if Len( cBuffer ) > 0
cMsg:= "Buscando: " + cBuffer
oMsgBar:nClrText:= CLR_BLUE
else
cMsg:= cDefaultMsg
endif
oMsgBar:SetMsg( PadR( cMsg ,200) )
oMsgBar:nClrText:= nClrText
return Nil

//----------------------------------------------------------------------------//
Function GetSysFont() ; return "MS Sans Serif"
//----------------------------------------------------------------------------//


tabien se borra la cabecera se pone de color negro
saludos.
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm

Re: Clases y Prgs

Postby servicomver » Fri Nov 12, 2010 4:27 pm

Alguien tendra la clase twbrowse para xharbour .99 fwh 6.12 bc55 ??

encontre una pero tiene el error de que los registros al mover el cursor se ponen en negro. segun lei en un post el maestro antonio hace referencia a este error y porpone modificar unas lines, pero el numero de line que menciona no "concuerda" con lo que tiene me clase wbrowse.

pretendo hacer un listbox con efecto 3d y todas las demas propiedades de la clase twbrowse

Saludos, mi correo es:
servicomver@hotmail.com
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm

Re: Clases y Prgs

Postby servicomver » Tue Nov 16, 2010 9:01 pm

Nuevamente por aqui:
Les comento, ya logre adecuar el buildx.bat para compilar varios archivos, logre usar la clase btnget32 y funciona correctamente, el problema ahora es que no he podido encontrar una clase que funcione correctamente.
sigo con el mismo ejemplo.
sample02.prg
ya no marca errores de enlazado o compilado, solo que ahora se ve solo un instante el ejemplo, es decir se abre y se alcanza a ver que dibuja el browse pero se cierra inmediatamente.

usando el ejemplo sample01.prg
lo abre pero no muestra los datos que contiene la dbf y si le doy al boton agregar se cierra por completo, aqui el fuente:
Code: Select all  Expand view  RUN
#include "FiveWin.ch"


Function Main()
 LOCAL aTotal:= {0,0,0, Nil, Nil, Nil}
 LOCAL aDatos:= {} // Array MultiDimensional
                   // Cod.Art.  Descrip.  Cantidad  $Unitario  $Total  MarcaDeNuevo
 LOCAL l3d:= .F.
 LOCAL oDlg, oLbx, cPic:= "@ze 999,999.99", oFont
 LOCAL hBmp:= ReadBitMap( 0, "finger.bmp" ) // Dedicado a mi amigo Mario Goanzalez

    If Alert("Quiere verlo en 3D ??", {"Aceptar","Cancelar"}) == 1
       l3D:= .T.
    EndIf

    DEFINE FONT oFont NAME "Times New Roman" SIZE 0,-15 BOLD

    DEFINE DIALOG oDlg FROM 0,0 TO 21,55 TITLE "::bEdit's TWBrowse Power !!!"

       TWBrowse():lHScroll:= .F.
       @2,2 LISTBOX oLbx FIELDS ""                                      ;
                         HEADER "Id","Articulo", "Descripcion", "Cantidad",  ;
                                "Unitario", "Total"                     ;
                         OF oDlg SIZE 207,100 PIXEL                     ;
                         SIZES 25,50, 130, 67,60,60

           oLbx:bLine:= {|nAt| nAt:= oLbx:nAt,                      ;
                               If( Len(aDatos)<1 .or. nAt>Len(aDatos),;
                                 Array(6),                            ;
                                 { If( oLbx!=Nil .and. oLbx:lSelect, hBmp, 0 ),;
                                   If( aDatos[nAt,1]==0,Space(4),StrZero( aDatos[nAt,1], 4 ) ),    ;
                                   aDatos[nAt,2],                       ;
                                   Transform( aDatos[nAt,3], cPic ),    ;
                                   Transform( aDatos[nAt,4], cPic ),    ;
                                   Transform( aDatos[nAt,5], cPic )  } ) }

           oLbx:aJustify:= { 2, 2, .f., .t., .t. , .t. }
           oLbx:SetArray( aDatos )

           oLbx:lAdjLastCol:= .f.

           oLbx:lAutoEdit  := .t.
           oLbx:lAutoSkip  := .t.

           oLbx:nLineStyle  := 2
           oLbx:nHeaderStyle:= 2

           oLbx:bBkColor:= {|nRow,nCol,nStyle| ;
                              if( nStyle==1,if( nCol%2==0, CLR_RED   , CLR_GREEN ),) }
           oLbx:bTextColor:= {|nRow,nCol,nStyle| ;
                              if( nStyle==1,if( nCol%2==0, CLR_YELLOW, CLR_WHITE ),) }
                                                                               
           If l3D
              oLbx:Set3DStyle()
           EndIf


           oLbx:bEdit:= {|nCol, cBuffer, lFirstEdit|;
                          EditaCelda( oLbx, nCol, cBuffer, aDatos, lFirstEdit, aTotal ) }


       @105, 110 SAY "Neto Gravado " OF oDlg PIXEL
       @115, 110 SAY "I.V.A. 21%   " OF oDlg PIXEL
       @125, 110 SAY "Total        " OF oDlg PIXEL
       @105, 150 SAY aTotal[4] PROMPT aTotal[1] PICTURE '@ZE 999,999.99' OF oDlg PIXEL RIGHT SIZE 50,10
       @115, 150 SAY aTotal[5] PROMPT aTotal[2] PICTURE '@ZE 999,999.99' OF oDlg PIXEL RIGHT SIZE 50,10
       @125, 150 SAY aTotal[6] PROMPT aTotal[3] PICTURE '@ZE 999,999.99' OF oDlg PIXEL RIGHT SIZE 50,10



       @137,10  BUTTON "Agrega" OF oDlg PIXEL ;
                ACTION ( NewReg( aDatos, oLbx ), oLbx:Edit() )  SIZE 50,Nil

       @137,80  BUTTON "Modifica" OF oDlg PIXEL ;
                ACTION If( Len(aDatos) > 0 .and.                      ;
                           oLbx:nAt <= Len(aDatos) .and. oLbx:nAt > 0,;
                           oLbx:Edit(), )       SIZE 50,Nil

       @137,150 BUTTON "Elimina" OF oDlg PIXEL ;
                ACTION If( Len(aDatos) > 0 .and.                      ;
                           oLbx:nAt <= Len(aDatos) .and. oLbx:nAt > 0 .and.  ;
                           Alert("Borra ?",{"ok","Cancela"}) == 1,      ;
                           DelReg( aDatos, oLbx, aTotal ),)  SIZE 50,Nil




    ACTIVATE DIALOG oDlg CENTERED



 RELEASE FONT oFont
 ReleaseDC( hBmp )

return Nil

//----------------------------------------------------------------------------//
Function GetSysFont() ; return "MS Sans Serif"


//----------------------------------------------------------------------------//
STATIC Function EditaCelda( oLbx, nCol, cBuffer, aDatos, lFirstEdit, aTotal )
 LOCAL aResult, nAt:= oLbx:nAt, uBuffer, lContinue:= .t.
 LOCAL bValid, nColReal:= nCol

    nCol--  // Para que sea como si no exisiera BitMap

    uBuffer:= aDatos[nAt,nCol]

    While .t.

       Do Case
          Case ( nCol == 2 .or. nCol == 5 ) .and. lFirstEdit
               Alert( "Columnas NO EDITABLES" )
               return .f.

          Case nCol == 1
               bValid:= {|| If( Empty( aResult:= SeekItem( uBuffer ) ), ;
                            (Alert( "Codigo Articulo Inexistente :-("),.F.) , .T. ) }

               If lContinue:= oLbx:lEditCol( nColReal, @uBuffer, "@ZE 9999", bValid,,CLR_YELLOW )
                  aDatos[nAt,1]:= uBuffer
                  aDatos[nAt,2]:= aResult[1]
                  aDatos[nAt,4]:= aResult[2]
               EndIf

          Case nCol == 3  // Cantidad
               If lContinue:= oLbx:lEditCol( nColReal,  @uBuffer, "@ZE 999,999.99",,,CLR_YELLOW )
                  If uBuffer <= 0
                     Alert("Debe Especificar una cantidad !!!")
                     Loop
                  EndIf
                  aDatos[nAt,3]:= uBuffer
               EndIf

          Case nCol == 4  // Unitario
               If lContinue:= oLbx:lEditCol( nColReal, @uBuffer, "@ZE 999,999.99",,,CLR_YELLOW )
                  aDatos[nAt,4]:= uBuffer
                  aDatos[nAt,6]:= .f.  // Ya no es un Nuevo Registro !!!
               EndIf

          Case nCol == 5 .and. ! lFirstEdit .and. Len( aDatos ) == nAt
               NewReg( aDatos, oLbx )

       EndCase

       If ! lContinue .and. aDatos[nAt,6] // Se habia agregado un nuevo Item !!!
          If Alert( "Cancela este Nuevo Registro", { "Ok","Cancelar" } ) == 1
             DelReg( aDatos, oLbx, aTotal )
             return .f.
          Else
             Loop
          EndIf
       EndIf

       Exit

    EndDo

    If Len( aDatos ) > 0
       aDatos[nAt,5]:= Round( aDatos[nAt,3] * aDatos[nAt,4], 2 )
       Suma( aDatos, aTotal )
    EndIf


    If lContinue
       Do Case
       Case oLbx:nLastKey == VK_UP
          return If( !GetKeyState(VK_SHIFT), -3, -2 )
       Case oLbx:nLastKey == VK_DOWN
          return If( !GetKeyState(VK_SHIFT),  3,  2 )
       Case oLbx:nLastKey == VK_TAB
          return If( GetKeyState(VK_SHIFT), -1, 1 )
       EndCase
    EndIf


return lContinue


//----------------------------------------------------------------------------//
STATIC Function SeekItem( nCod )  // Simulamos busqueda en Base de Datos :-)

    If nCod >= 1 .and. nCod <= 500
       return { "Producto " + StrZero( nCod, 4 ), nCod + 0.55 }
    EndIf

return ""
//----------------------------------------------------------------------------//
STATIC Function NewReg( aDatos, oLbx )
    Aadd( aDatos, {0,"",0,0,0,.t.} )
    oLbx:Refresh()
    oLbx:lHitBottom:= .f.
    oLbx:GoBottom()
    SysRefresh()
return Nil
//----------------------------------------------------------------------------//
STATIC Function DelReg( aDatos, oLbx, aTotal )
    ADel( aDatos, oLbx:nAt )
    ASize( aDatos, Len( aDatos ) - 1 )
    oLbx:GoUp()
    oLbx:Refresh()
    Suma( aDatos, aTotal )
return Nil
//----------------------------------------------------------------------------//
STATIC Function Suma( aDatos, aTotal )
    aTotal[1]:= 0
    AEval( aDatos, {|aItem| aTotal[1]+= aItem[5] } )
    aTotal[1]:= Round( aTotal[1], 2 )
    aTotal[2]:= Round( aTotal[1] * 0.21, 2 )
    aTotal[3]:= Round( aTotal[1] + aTotal[2],2 )
    AEval( aTotal, {|oSay| oSay:Refresh(.F.) }, 4 )

return Nil
//----------------------------------------------------------------------------//




alguna sugerencia ???
saludos.
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm

Re: Clases y Prgs

Postby Patricio Avalos Aguirre » Tue Nov 16, 2010 9:41 pm

Hola

Prueba enlazar la libreria de wbrowse antes de las de fivewin

Code: Select all  Expand view  RUN
wcta.exe, +
wcta.map, +
D:\APL\PRGS\LIB32\TWBRW32 +
c:\Fwh\lib\FiveHX.LIB +
 
Saludos
Patricio

__________________________________________________________________
Version: Harbour 3.2.0dev (r1307082134),Compiler: Borland C++ 5.8.2 (32-bit)
PCode version: 0.3, FWH 13.2
http://www.sialm.cl
User avatar
Patricio Avalos Aguirre
 
Posts: 1060
Joined: Fri Oct 07, 2005 1:56 pm
Location: La Serena, Chile

Re: Clases y Prgs

Postby servicomver » Tue Nov 16, 2010 10:29 pm

ya enlace twbrw32
ahora me sale este error:
ERROR BASE/1081 Argument Error: + from errorsys, line= 0

me puedes mandar la libreria correcta y la clase por favor ???
servicomver@hotmail.com
uso fwh 6.12 bc 5.55 harbour 1,0 (tambien intente xon xharbour 0.99.71)
Saludos
servicomver
 
Posts: 192
Joined: Fri Nov 18, 2005 7:34 pm


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 89 guests