/*
TCALC.PRG
CLASE QUE PERMITE PONER UNA CALCULADORA CON ROLLO DE PAPEL VIRTUAL.
Necesita el fichero de recursos: calculadora.RC
Primera Versión: Junio del 2007 DC
Ultima Revisión: 25/03/2015
Adaptación a XBROWSE: 25/03/2015
Autor: Verhoven. ¡ Seguro les resultará de utilidad !
1.- Queda autorizado su libre distribucion y uso, incluso con fines comerciales .
2.- El autor declina cualquier responsabilidad en caso de funcionamiento anómalo.
Ejemplo: Hacemos una calculadora que se active pulsando F12:
Para incluirla en un programa basta con poner después de la función main() del mismo.
#include 'TCALC.PRG'
public oCalc:=tCalc():new()
setkey(VK_F12, {|| oCalc:calculadora(oWnd,'@E 9,999,999.9999 ')})
Vea el significado de las variables de instancia y de las que se les pasan a los métodos para
aprovechar algunas posibilidades de configuración.
*/
#include "fivewin.ch"
#include "XBrowse.Ch"
CLASS TCalc
DATA nResult //Resultado de las operaciones en curso.
DATA aRolloCalc //Operaciones realizadas desde la última vez que se borró todo.
DATA cUltima, cUltimaop
DATA cPatronSalida // cPatronSalida -> Formato en que se pinta el resultado.
METHOD New() CONSTRUCTOR
METHOD End()
METHOD nCalculadigual(nGet)
METHOD calculadora(oPadre,cPatronSalida,lBorraAlInicio)
// lBorraAlInicio -> Al llamar al método si está en .t. borra lo que hubiera.
// Si está en .f. ó NIL conserva las operaciones anteriores.
METHOD TCalc_Teclas(nKey, oDlg)
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New() CLASS TCalc
::aRolloCalc:={{'C',' '}}
::nResult :=0
::cUltima :=''
::cUltimaop :=''
return SELF
//----------------------------------------------------------------------------//
METHOD End() CLASS TCalc
::aRolloCalc:={{'C',' '}}
::nResult :=0
::cUltima :=''
::cUltimaop :=''
return NIL
//----------------------------------------------------------------------------//
METHOD calculadora(oPadre,cPatronSalida,lBorraAlInicio) CLASS TCalc
local oDlg
local oBtnSalir
local oBtnmenos, oBtnmas, oBtnpor, oBtndividir, oBtnigual, oBtnBorra
local oBtn0, oBtn1, oBtn2, oBtn3, oBtn4, oBtn5, oBtn6, oBtn7, oBtn8, oBtn9, oBtnP, oBtnSigno
local oBtnConv, oBtnConv2
local oBtnDel
local oSay
local oBrw, n:=1
local oGet, nGet:=0 ,cGet:='', nGetAnt:=0
local oFont1
local oFontLst
if cPatronSalida=NIL .AND. ::cPatronSalida=NIL
cPatronSalida:='@E 9,999,999,999.99 ' //Formato en que se pinta el resultado.
endif
//default cPatronSalida:='@E 9,999,999,999.99 ' //Formato en que se pinta el resultado.
default lBorraAlInicio :=.f. // Al llamar al método si está en .t. borra lo que hubiera.
// Si está en .f. entonces conserva las operaciones anteriores.
::cPatronSalida:=cPatronSalida
DEFINE FONT oFont1 NAME "Arial" SIZE 0,-20
DEFINE FONT oFontLst NAME "MS Sans Serif" SIZE 0,-14
DEFINE DIALOG oDlg RESOURCE 'Calculadora' OF oPadre TITLE 'CALCULADORA' FONT oFont
REDEFINE BUTTON oBtnSalir ID 500 OF oDlg MESSAGE 'SALIR';
ACTION oDlg:end() default CANCEL UPDATE
oBtnSalir:cargo:='S'
REDEFINE BUTTON oBtnmenos ID 401 OF oDlg MESSAGE 'Resta';
ACTION (iif(nGet<>0,(nGetAnt:=nGet,aadd(::aRolloCalc,{transform(nGet,::cPatronSalida),'-'})),(::nResult:=::nResult-nGetAnt,aadd(::aRolloCalc,{transform(iif(::cUltimaOp='=',::nResult,nGetAnt),::cPatronSalida),'-'}))) ,;
oBrw:gobottom(),;
oBrw:refresh(),;
iif(::nResult=0,::nResult:=nGet,::nResult:=::nResult-nGet),;
::cUltimaOp:='-' ,;
oSay:SetText(transform(::nResult,::cPatronSalida)),;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnmenos:cargo:='-'
REDEFINE BUTTON oBtnmas ID 402 OF oDlg MESSAGE 'Suma';
ACTION (iif(nGet<>0,(nGetAnt:=nGet,aadd(::aRolloCalc,{transform(nGet,::cPatronSalida),'+'})),(::nResult:=::nResult+nGetAnt,aadd(::aRolloCalc,{transform(iif(::cUltimaOp='=',::nResult,nGetAnt),::cPatronSalida),'+'}))) ,;
oBrw:gobottom(),;
oBrw:refresh(),;
iif(::nResult=0,::nResult:=nGet,::nResult:=::nResult+nGet),;
::cUltimaOp:='+' ,;
oSay:SetText(transform(::nResult,::cPatronSalida)),;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnmas:cargo:='+'
REDEFINE BUTTON oBtnpor ID 403 OF oDlg MESSAGE 'Multiplica';
ACTION (aadd( ::aRolloCalc, iif(nGet=0 .AND. ::nResult<>0,{transform(::nResult,::cPatronSalida),'x'},{transform(nGet,::cPatronSalida),'x'}) ),;
oBrw:gobottom(),;
oBrw:refresh(),;
iif(::nResult=0,::nResult:=nGet,iif(nGet<>0,::nResult:=::nResult*nGet,NIL)),;
::cUltimaOp:='*' ,;
oSay:SetText(transform(::nResult,::cPatronSalida)),;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnpor:cargo:='*'
REDEFINE BUTTON oBtndividir ID 404 OF oDlg MESSAGE 'Divide';
ACTION (aadd( ::aRolloCalc, iif(nGet=0 .AND. ::nResult<>0,{transform(::nResult,::cPatronSalida),'/'},{transform(nGet,::cPatronSalida),'/'}) ),;
oBrw:gobottom(),;
oBrw:refresh(),;
iif(::nResult=0,::nResult:=nGet,iif(nGet<>0,::nResult:=::nResult/nGet,NIL)),;
::cUltimaOp:='/' ,;
oSay:SetText(transform(::nResult,::cPatronSalida)),;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtndividir:cargo:='/'
REDEFINE BUTTON oBtnigual ID 405 OF oDlg MESSAGE 'Calcula resultado';
ACTION (iif(nGet=0,,aadd( ::aRolloCalc, {transform(nGet,::cPatronSalida),iif(::cUltimaOp='+' .OR. ::cUltimaOp='-' .OR. ::cUltimaOp='*' .OR. ::cUltimaOp='/',' ',::cUltimaOp)} )),;
::nCalculadIgual(nGet),;
aadd( ::aRolloCalc, {transform(::nResult,::cPatronSalida),'='} ),;
oBrw:gobottom(),oBrw:gobottom(),;
oBrw:refresh(),;
::cUltimaOp:='=' ,;
oSay:SetText(transform(::nResult,::cPatronSalida)),;
nGet:=0 ,;
nGetAnt:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnigual:cargo:='='
REDEFINE BUTTON oBtnBorra ID 425 OF oDlg MESSAGE 'Borra todos los cálculos';
ACTION (iif( len( ::aRolloCalc ) > 0,;
( aSize( ::aRolloCalc, 0 ), oBrw:Refresh() ),NIL ),;
aadd( ::aRolloCalc, {' ','C'} ),;
oBrw:gotop() ,;
oBrw:refresh() ,;
::nResult:=0 ,;
::cUltimaOp:='R' ,;
oSay:SetText('0') ,;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnBorra:cargo:='R'
/*
REDEFINE BUTTON oBtnDel ID 426 OF oDlg MESSAGE 'Borra último dígito';
ACTION (::cUltima:='CE' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
iif(nGet<>0,( ,;
cGet:=LEFT(cGet,len(cget)-1),;
nGet:=val(cGet)),NIL) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnDel:cargo:=chr(8)
*/
REDEFINE BUTTON oBtnDel ID 426 OF oDlg MESSAGE 'Borra último dígito';
ACTION (::cUltima:='CE' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
iif(nGet<>0,(cGet:=LEFT(cGet,len(cget)-1),nGet:=val(cGet)),NIL),;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnDel:cargo:=chr(8)
REDEFINE BUTTON oBtnConv ID 407 OF oDlg MESSAGE 'Convierte de euros a PTS';
ACTION ( iif(nGet<>0,::nResult:=round(nGet*166.386,0),::nResult:=round(::nResult*166.386,0)),;
aadd( ::aRolloCalc, {transform(::nResult,'@E 9,999,999,999 '),'pts'} ),;
oBrw:gobottom(),;
oBrw:refresh(),;
::cUltimaOp:='AP' ,; // AP = a Pesetas
oSay:SetText(transform(::nResult,'@E 9,999,999,999 pts')),;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnConv:cargo:='E'
REDEFINE BUTTON oBtnConv2 ID 408 OF oDlg MESSAGE 'Convierte de PTS a Euro';
ACTION ( iif(nGet<>0,::nResult:=round(nGet/166.386,2),::nResult:=round(::nResult/166.386,2)),;
aadd( ::aRolloCalc, {transform(::nResult,'@E 9,999,999,999.99 '),' €'} ),;
oBrw:gobottom(),;
oBrw:refresh(),;
::cUltimaOp:='AE' ,; // AE = a Euros
oSay:SetText(transform(::nResult,'@E 9,999,999,999.99 €')),;
nGet:=0 ,;
cGet:='' ,;
oGet:SetText('') ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnConv:cargo:='P'
REDEFINE BUTTON oBtn0 ID 100 OF oDlg ;
ACTION (::cUltima:='0' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
iif(nGet<>0 .OR. at(".",cGet)>0,(;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet)),NIL) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn0:cargo:='0'
REDEFINE BUTTON oBtn1 ID 101 OF oDlg;
ACTION (::cUltima:='1' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn1:cargo:='1'
REDEFINE BUTTON oBtn2 ID 102 OF oDlg;
ACTION (::cUltima:='2' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn2:cargo:='2'
REDEFINE BUTTON oBtn3 ID 103 OF oDlg;
ACTION (::cUltima:='3' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn3:cargo:='3'
REDEFINE BUTTON oBtn4 ID 104 OF oDlg;
ACTION (::cUltima:='4' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn4:cargo:='4'
REDEFINE BUTTON oBtn5 ID 105 OF oDlg;
ACTION (::cUltima:='5' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn5:cargo:='5'
REDEFINE BUTTON oBtn6 ID 106 OF oDlg;
ACTION (::cUltima:='6' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn6:cargo:='6'
REDEFINE BUTTON oBtn7 ID 107 OF oDlg;
ACTION (::cUltima:='7' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn7:cargo:='7'
REDEFINE BUTTON oBtn8 ID 108 OF oDlg;
ACTION (::cUltima:='8' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn8:cargo:='8'
REDEFINE BUTTON oBtn9 ID 109 OF oDlg;
ACTION (::cUltima:='9' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtn9:cargo:='9'
REDEFINE BUTTON oBtnP ID 110 OF oDlg;
ACTION (::cUltima:='.' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
cGet:=cGet+::cUltima ,;
nGet:=val(cGet) ,;
oGet:SetText(cGet) ,;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE WHEN int(nGet)==nGet
oBtnP:cargo:='.'
REDEFINE BUTTON oBtnSigno ID 111 OF oDlg;
ACTION (::cUltima:='signo' ,;
iif(::cUltimaOp='=' .OR. ::cUltimaOp='AP' .OR. ::cUltimaOp='AE',(::cUltimaOp:='',::nResult:=0,aadd( ::aRolloCalc, {' ',' '} ), oBrw:gobottom(),oBrw:refresh()),NIL),;
nGet:=(-1)*nGet ,;
oGet:SetText(nGet) ,;
cGet:=alltrim(str(nGet)),;
oBtnIgual:Setfocus() ,;
sysrefresh() ) UPDATE
oBtnSigno:cargo:=' '
REDEFINE SAY oGet VAR nGet ID 211 OF oDlg FONT oFont1 ;
COLOR nrgb( 0, 0, 0),nrgb(255,255,200) UPDATE
REDEFINE SAY oSay VAR ::nResult ID 200 OF oDlg FONT oFont1 ;
COLOR nrgb(50,250,50),nrgb(0,0,0) UPDATE
/* // TIENE QUE PONER TWBrowse en el .RC en vez de TXBrowse
REDEFINE LISTBOX oBrw FIELDS ;
::aRolloCalc[n][1],;
::aRolloCalc[n][2];
HEAD 'valor',' ';
ID 212 OF oDlg FONT oFontLst COLOR nrgb(0,0,0),nrgb(255,255,200) ;
UPDATE
oBrw:aJustify :={.t.,.f.}
oBrw:aColSizes :={GetFontInfo(oFontLst)[2] * 1.25 * 17, GetFontInfo(oFontLst)[2] * 1.25 * 3} //Empírico
oBrw:bGotop := { || n := 1 }
oBrw:bGoBottom := { || n := eval( oBrw:bLogicLen ) }
oBrw:bSkip := { | nwant, nold | nold := n , n += nwant,;
n := max( 1, min( n, eval( oBrw:bLogicLen ))),;
n - nOld }
oBrw:bLogicLen := { || len( ::aRolloCalc ) }
oBrw:nClrPane:={|| iif(::aRolloCalc[n][2]=='=',nrgb(200,255,125),nrgb(255,255,200)) }
oDlg:bKeyDown:={|nKey| ::TCalc_Teclas(nKey,oDlg)}
*/
REDEFINE XBROWSE oBrw DATASOURCE ::aRolloCalc ;
COLUMNS 1,2 ;
HEADERS 'valor',' ';
ID 212 OF oDlg FONT oFontLst COLOR nrgb(0,0,0),nrgb(255,255,200) ;
COLSIZES {GetFontInfo(oFontLst)[2] * 1.25 * 14, GetFontInfo(oFontLst)[2] * 1.25 * 3} ;//Empírico
UPDATE
WITH OBJECT oBrw
:nRowDividerStyle:= LINESTYLE_NOLINES
:nColDividerStyle:= LINESTYLE_NOLINES
:nStretchCol:=STRETCHCOL_LAST
:aJustify :={.t.,2}
//:lHScroll:= .F.
//:lVScroll:= .T.
end
oBrw:bClrStd := {|| {CLR_BLACK,iif(oBrw:aCols[2]:Value=='=',nrgb(200,255,125),nrgb(255,255,200)) } }
oDlg:bKeyDown:={|nKey| ::TCalc_Teclas(nKey,oDlg)}
ACTIVATE DIALOG oDlg CENTERED ON INIT (if(lBorraAlInicio,oBtnBorra:CLICK(),.f.),oBrw:gobottom(),oBrw:refresh())
//oFont1:end()
//oFontLst:end()
return ::nResult
METHOD nCalculadigual(nGet) CLASS TCalc
do CASE
CASE ::cUltimaOp = '-'
::nResult := ::nResult - nGet
CASE ::cUltimaOp = '+'
::nResult := ::nResult + nGet
CASE ::cUltimaOp = '*'
::nResult := ::nResult * nGet
CASE ::cUltimaOp = '/'
::nResult := ::nResult / nGet
endcase
return NIL
METHOD TCalc_Teclas(nKey, oDlg) class TCalc
local ny
for ny:=1 TO len(oDlg:aControls)
if oDlg:aControls[ny]:cargo==upper(chr(nKey))
oDlg:aControls[ny]:CLICK()
endif
next ny
return nil
oBrw:gobottom(),oBrw:refresh()),),;
