Hola,
Yo uso esta calculadora, que encontré en el foro, modificada.
La activo al pulsar una tecla de función y lo primero que hace es buscar si el puntero estaba en un get activo.
Si es así, al terminar, me devuelve el resultado a ese get.
Code: Select all
#Include "FiveWin.ch"
static nMemo, mCar, cLastKey, cLastOpe
Func Ghe_MsgCalc( nKey )
local lEscAnt, bSetKey, oCtrl, cPict, nResult := 0
local oDlg, oSay, cSay := '', oCar, lRet := .F.
local oMemo, cMemo := '', oOk, oOk2, oIgual, cAux, oBrowse
local nType, i, j, nDec, nDec2, cText, cRes
bSetKey := SetKey( nKey )
SetKey( nKey, NIL )
oCtrl := oWndFromhWnd( GetFocus() )
cLastOpe := '='
cLastKey := ''
mCar := if( mCar=NIL, '', mCar )
cPict := '@KE 9,999,999,999.99'
nMemo := if( nMemo=NIL, 0, nMemo )
if !Empty(mCar)
i := AtNum( '=', mCar )
if i<>0
cAux := SubStr( mCar, i+1, len(mCar) )
nResult := GetText( Alltrim(cAux) )
endif
endif
cRes := "GheCalc"
if Valtype(oCtrl)='O' .and. 'GET'$oCtrl:ClassName()
nType := oCtrl:VarGet()
if ('XBROWSE' in oCtrl:oWnd:ClassName())
oBrowse := oCtrl:oWnd
endif
endif
lEscAnt := SetDialogEsc()
SetDialogEsc( .T. )
Define Dialog oDlg Resource cRes
oDlg:bKeyDown := { | nKey | VerKey( nKey, oSay, oDlg ) }
Redefine get oCar Var mCar Id 102 Of oDlg Memo Color CLR_BLUE, CLR_WHITE
oCar:Disable()
Redefine ButtonBmp Bitmap IMG1_SEEK Id 309 Of oDlg Action ShowHist( oCar:GetText(), oDlg, oIgual)
Redefine gSay oSay Var cSay Id 103 Of oDlg
Redefine Button Id 122 Of oDlg Action ( nMemo := 0, oMemo:SetText(''), oIgual:SetFocus() )
Redefine Button Id 123 Of oDlg Action ( oSay:SetText(Transform(nMemo, cPict)), cLastKey := '=', oIgual:SetFocus() )
Redefine Button Id 125 Of oDlg Action ( nMemo := nMemo+GetText(oSay:cCaption), oMemo:SetText(if(nMemo=0, '', 'M')), cLastKey := '=', oIgual:SetFocus() )
Redefine Button Id 126 Of oDlg Action ( nMemo := nMemo-GetText(oSay:cCaption), oMemo:SetText(if(nMemo=0, '', 'M')), cLastKey := '=', oIgual:SetFocus() )
Redefine gSay oMemo Var cMemo Id 104 Of oDlg COLOR CLR_BLUE, CLR_WHITE
Redefine Button Id 80 Of oDlg Prompt '±' Action SayNum(oSay, oIgual, "±")
Redefine Button Id 84 Of oDlg Prompt '&,' Action SayNum(oSay, oIgual, ",")
Redefine Button Id 85 Of oDlg Prompt '&.' Action SayNum(oSay, oIgual, ",")
Redefine Button Id 131 Of oDlg Prompt '&1' Action SayNum(oSay, oIgual, "1")
Redefine Button Id 132 Of oDlg Prompt '&2' Action SayNum(oSay, oIgual, "2")
Redefine Button Id 133 Of oDlg Prompt '&3' Action SayNum(oSay, oIgual, "3")
Redefine Button Id 134 Of oDlg Prompt '&4' Action SayNum(oSay, oIgual, "4")
Redefine Button Id 135 Of oDlg Prompt '&5' Action SayNum(oSay, oIgual, "5")
Redefine Button Id 136 Of oDlg Prompt '&6' Action SayNum(oSay, oIgual, "6")
Redefine Button Id 137 Of oDlg Prompt '&7' Action SayNum(oSay, oIgual, "7")
Redefine Button Id 138 Of oDlg Prompt '&8' Action SayNum(oSay, oIgual, "8")
Redefine Button Id 139 Of oDlg Prompt '&9' Action SayNum(oSay, oIgual, "9")
Redefine Button Id 130 Of oDlg Prompt '&0' Action SayNum(oSay, oIgual, "0")
Redefine Button Id 83 Of oDlg Prompt '&'+Chr(8)+'<--' Action SayNum(oSay, oIgual, "<-")
Redefine Button oIgual Id 121 Of oDlg Prompt '=' Action CalcRes( '=', @nResult, @cPict, oSay, oCar, oOk, oIgual, oCtrl )
Redefine Button Id 91 Of oDlg Prompt '&/' Action CalcRes( '/', @nResult, @cPict, oSay, oCar, oOk, oIgual, oCtrl )
Redefine Button Id 92 Of oDlg Prompt '&*' Action CalcRes( '*', @nResult, @cPict, oSay, oCar, oOk, oIgual, oCtrl )
Redefine Button Id 93 Of oDlg Prompt '&+' Action CalcRes( '+', @nResult, @cPict, oSay, oCar, oOk, oIgual, oCtrl )
Redefine Button Id 94 Of oDlg Prompt '&-' Action CalcRes( '-', @nResult, @cPict, oSay, oCar, oOk, oIgual, oCtrl )
Redefine Button Id 118 Of oDlg Prompt '&%' Action CalcRes( '%', @nResult, @cPict, oSay, oCar, oOk, oIgual, oCtrl )
Redefine Button Id 81 Of oDlg Prompt 'C' Action ( cLastOpe := '+', cLastKey := "", nResult := 0, cPict := PcTotal(), oCar:cText( "" ), oSay:SetText( '' ) )
Redefine ButtonBmp oOk Bitmap IMG1_OK TextRight Id 5 Of oDlg Action ( lRet:=.T., oDlg:End() )
Redefine ButtonBmp Bitmap IMG1_CANCEL TextRight Id 2 Of oDlg Action ( lRet:=.F., oDlg:End() )
oDlg:bStart := {|| oMemo:SetText(if(nMemo=0, '', 'M')), oCar:GoBottom() }
Activate Dialog oDlg Center
if lRet .and. nResult=0
nResult := GetText( oSay:cCaption )
endif
if lRet .and. nResult<>0 .and. Valtype(oCtrl)='O' .and. 'GET'$oCtrl:ClassName()
if oBrowse<>NIL .and. oBrowse:SelectedCol():Edit()
oCtrl := oBrowse:SelectedCol():oEditGet
endif
nType := oCtrl:VarGet()
if valtype(nType)="N"
i := at( '.', oCtrl:cPicture )
nDec := if( i<>0, len( SubStr(oCtrl:cPicture, i+1) ), 0 )
j := at( '.', cPict )
nDec2 := if( j<>0, len( SubStr(cPict, j+1) ), 0 )
/*
if nDec2<=nDec
nResult := fxRound( nResult, nDec )
else
for i := nDec2-1 to nDec step -1
nResult := fxRound(nResult, i )
next
endif
*/
oCtrl:VarPut( nResult )
elseif ValType(nType)="C" .and. 'MGET'$oCtrl:ClassName()
cText := Alltrim(oCtrl:cText())
cText += if( !Empty(cText), " ", "")
oCtrl:VarPut( cText+Alltrim(str(nResult, 10, 2)) )
elseif ValType(nType)="C"
i := len( oCtrl:cText() )
cText := Alltrim(oCtrl:cText())
cText += if( !Empty(cText), " ", "")
j := len( cText )
oCtrl:VarPut( cText+left(Alltrim(str(nResult, 10, 2)), i-j) )
endif
oCtrl:Refresh()
endif
if Valtype(oCtrl)='O'
oCtrl:SetFocus()
endif
SetKey( nKey, bSetKey )
SetDialogEsc( lEscAnt )
Return .T.
*-------------------------------*
FUNCTION SayNum( oSay, oIgual, cNum )
local cGet := Alltrim(oSay:cCaption)
if cNum==','
if ',' $ cGet
return NIL
elseif Empty(cGet)
cNum := '0,'
endif
endif
do case
case cNum=='±'
if left(cGet, 1)='-'
cGet := SubStr(cGet, 2)
else
cGet := '-'+cGet
endif
case cNum=='<-'
cGet := left( cGet, len(cGet)-1 )
othe
if cLastKey $ '+-*/%='
cGet := cNum
else
cGet := cGet + cNum
endif
endcase
oSay:SetText( cGet )
cLastKey := cNum
oIgual:SetFocus()
RETURN NIL
*-------------------------------------------------------*
Static Function CalcRes( cnOpe, nResult, cPict, oSay, oCar, oOk, oIgual, oCtrl )
local nVal, nVal2, nLine:= 0, mVal1:="", X
local i, j, nDec, nDecPic, cMemo, cSalto, nChange, cAux
if cLastOpe='=' .and. cnOpe='='
oOk:Click()
return nil
endif
nVal := GetText( oSay:cCaption )
if nVal <> 0 .or. cLastOpe $ '+-*/'
if cnOpe == '%'
nVal2 := nVal / 100
if cLastOpe $ "+-"
nVal2 := nResult * nVal2
endif
else
nVal2 := nVal
endif
do case
case cLastOpe == "="
nResult := nVal2
case cLastOpe == "+"
nResult += nVal2
case cLastOpe == "-"
nResult -= nVal2
case cLastOpe == "*"
nResult *= nVal2
case cLastOpe == "/"
nResult /= nVal2
endcase
else
nResult := nVal2 := 0
endif
if ('CHANGE' in cnOpe)
if cnOpe=='CHANGEEUR'
nVal2 := nResult := Eval( oCtrl:bChangeMnd, nResult,, .F. )
else
nVal2 := nResult := Eval( oCtrl:bChangeMnd, nResult )
endif
nChange := Eval( oCtrl:bChangeMnd, 1 )
endif
cMemo := nTrim2( nVal2, .T. )
i := at( '.', cMemo )
nDec := if( i<>0, len( SubStr(cMemo, i+1) ), 0 )
j := at( '.', cPict )
nDecPic := if( j<>0, len( SubStr(cPict, j+1) ), 0 )
if nDec<>nDecPic
cPict := if( j=0, cPict, left(cPict, j-1) ) + if( nDec>0, '.' + Replicate('9', nDec), '' )
endif
do case
case Empty(oCar:cText)
cSalto := ''
case cLastOpe='='
cSalto := CRLF
othe
cSalto := ' '
endcase
if cnOpe $ '=%' .or. ('CHANGE' in cnOpe)
if nVal<>0
cAux := Alltrim(oCar:cText()) + cSalto + Alltrim(Transform( nVal , cPict ))
if cnOpe=='%'
cAux += "% ="
elseif cnOpe=='CHANGEEUR'
cAux += ' * '+Alltrim(Transform( nChange, PcPrecio() ))
elseif cnOpe=='CHANGEMND'
cAux += ' / '+Alltrim(Transform( nChange, PcPrecio() ))
endif
cAux += " ="
oCar:cText( cAux )
cSalto := ' '
endif
cMemo := nTrim2( nResult, .T. )
i := at( '.', cMemo )
nDec := if( i<>0, len( SubStr(cMemo, i+1) ), 0 )
j := at( '.', cPict )
nDecPic := if( j<>0, len( SubStr(cPict, j+1) ), 0 )
if nDec<>nDecPic
cPict := if( j=0, cPict, left(cPict, j-1) ) + if( nDec>0, '.' + Replicate('9', nDec), '' )
endif
oCar:cText( Alltrim(oCar:cText()) + cSalto + Alltrim(Transform( nResult, cPict )) )
else
if nVal<>0
oCar:cText( Alltrim(oCar:cText()) + cSalto + Alltrim(Transform( nVal , cPict )) + ' ' + iif(!empty(cnOpe), cnOpe, cLastOpe))
endif
endif
oSay:SetText( Transform(nResult, cPict) )
oCar:GoBottom()
cLastOpe := if( cnOpe $ '=%' .or. ('CHANGE' in cnOpe), '=', cnOpe )
cLastKey := if( cnOpe $ '=%' .or. ('CHANGE' in cnOpe), '=', cnOpe )
oIgual:SetFocus()
Return Nil
//-----------------------------------------------------------------------------------//
Static Func GetText( cVal )
local nVal
cVal := IfNil(cVal, '0', '')
cVal := StrTran( cVal, '.', '' )
cVal := StrTran( cVal, ',', '.' )
nVal := Val( cVal )
return nVal
*--------------------------------------------------------------------------------------*
Static Func VerKey( nKey, oSay, oDlg )
local nVal, cKey, oCtrl
if nKey=27
return nil
endif
cKey := Chr( nKey )
if GetKeyState( VK_SHIFT )
do case
case nKey=187
cKey := '*'
case nKey == 55
cKey := '/'
case nKey == 53
cKey := '%'
case nKey=67
cKey := 'C'
case nKey == 48
cKey := '='
Endcase
else
do case
case nKey == 107 .or. nKey=187
cKey := '+'
case nKey == 109 .or. nKey=189
if Empty(GetText(oSay:cCaption))
cKey := '±'
else
cKey := '-'
endif
case nKey == 106
cKey := '*'
case nKey == 111
cKey := '/'
case nKey=67 .or. nKey=46
cKey := 'C'
case nKey=8
cKey := '<--'
case nKey=188 .or. nKey=190 .or. nKey=110
cKey := ','
case nKey == 13
cKey := '='
case nKey>=96 .and. nKey<=105 //Bloque númerico
cKey := Chr( nKey-48 )
endcase
endif
for each oCtrl in oDlg:aControls
if 'BUTTON' $ oCtrl:ClassName() .and. oCtrl:cCaption==cKey
oCtrl:Click()
exit
endif
next
Return 0
Proc ShowHist( cCar, oWnd, oIgual )
local oDlg
DEFINE DIALOG oDlg RESOURCE "GheCalcHist" Of oWnd
REDEFINE gGet cCar ID 102 MEMO OF oDlg Color CLR_BLUE, CLR_WHITE
Redefine ButtonBmp Bitmap IMG1_OK TextRight Id 1 Of oDlg Action oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
oIgual:SetFocus()
return
Rc:
Code: Select all
GHECALC DIALOGEX FIXED IMPURE 0, 0, 123, 192
STYLE DS_SHELLFONT|WS_POPUP|DS_MODALFRAME|DS_CENTER|WS_CAPTION|WS_SYSMENU
CAPTION "Calculadora"
FONT 9, "MS Shell Dlg", 400, 0, 0
{
CONTROL "", 103, "Static", SS_RIGHT|SS_SUNKEN|WS_BORDER|WS_DISABLED|WS_GROUP, 1, 20, 121, 14
CONTROL "MC", 122, "Button", BS_CENTER|BS_VCENTER, 5, 35, 20, 20
CONTROL "<--", 83, "Button", BS_CENTER|BS_VCENTER, 5, 57, 20, 20
CONTROL "7", 137, "Button", BS_CENTER|BS_VCENTER, 5, 79, 20, 20
CONTROL "4", 134, "Button", BS_CENTER|BS_VCENTER, 5, 101, 20, 20
CONTROL "1", 131, "Button", BS_CENTER|BS_VCENTER, 5, 123, 20, 20
CONTROL "0", 130, "Button", 0x00000000, 5, 145, 43, 20
CONTROL "MR", 123, "Button", BS_CENTER|BS_VCENTER, 28, 35, 20, 20
CONTROL "8", 138, "Button", BS_CENTER|BS_VCENTER, 28, 79, 20, 20
CONTROL "5", 135, "Button", BS_CENTER|BS_VCENTER, 28, 101, 20, 20
CONTROL "2", 132, "Button", BS_CENTER|BS_VCENTER, 28, 123, 20, 20
CONTROL "C", 81, "Button", BS_CENTER|BS_VCENTER, 28, 57, 20, 20
CONTROL "9", 139, "Button", BS_CENTER|BS_VCENTER, 51, 79, 20, 20
CONTROL "6", 136, "Button", BS_CENTER|BS_VCENTER, 51, 101, 20, 20
CONTROL "3", 133, "Button", BS_CENTER|BS_VCENTER, 51, 123, 20, 20
CONTROL ",", 84, "Button", BS_CENTER|BS_VCENTER, 51, 145, 20, 20
CONTROL "M+", 125, "Button", BS_CENTER|BS_VCENTER, 51, 35, 20, 20
CONTROL "±", 80, "Button", BS_CENTER|BS_VCENTER, 51, 57, 20, 20
CONTROL "/", 91, "Button", BS_CENTER|BS_VCENTER, 74, 57, 20, 20
CONTROL "*", 92, "Button", BS_CENTER|BS_VCENTER, 74, 79, 20, 20
CONTROL "-", 94, "Button", BS_CENTER|BS_VCENTER, 74, 101, 20, 20
CONTROL "+", 93, "Button", BS_CENTER|BS_VCENTER, 74, 123, 20, 20
CONTROL "M-", 126, "Button", BS_CENTER|BS_VCENTER, 74, 35, 20, 20
CONTROL "%", 118, "Button", BS_CENTER|BS_VCENTER, 74, 145, 20, 20
CONTROL "=", 121, "Button", BS_DEFPUSHBUTTON|WS_TABSTOP, 97, 57, 21, 107
CONTROL "Aceptar ", 5, "Button", BS_RIGHT|BS_VCENTER, 3, 167, 55, 24
CONTROL "Cancelar ", IDCANCEL, "Button", BS_RIGHT|BS_VCENTER, 63, 167, 57, 24
CONTROL "M", 104, "Static", SS_CENTER|SS_CENTERIMAGE|SS_SUNKEN|WS_BORDER|WS_GROUP, 97, 35, 20, 20
CONTROL "", 102, "Edit", ES_RIGHT|ES_MULTILINE|ES_AUTOVSCROLL|ES_READONLY|WS_VSCROLL|WS_BORDER, 1, 2, 109, 17, WS_EX_LEFTSCROLLBAR
CONTROL "", 309, "Button", BS_CENTER|BS_VCENTER, 110, 5, 12, 12
CONTROL ".", 85, "Button", BS_CENTER|BS_VCENTER, 51, 145, 20, 20
}
GHECALCHIST DIALOGEX PRELOAD DISCARDABLE 6, 18, 123, 173
STYLE WS_POPUP|DS_MODALFRAME|DS_CONTEXTHELP|DS_CENTER|WS_CAPTION|WS_SYSMENU
CAPTION "Histórico"
FONT 8, "MS Sans Serif", 0, 0, 1
{
CONTROL "", 102, "Edit", ES_RIGHT|ES_MULTILINE|ES_AUTOVSCROLL|ES_WANTRETURN|ES_READONLY|WS_VSCROLL|WS_BORDER, 0, 1, 123, 145
CONTROL "Aceptar ", IDOK, "Button", BS_DEFPUSHBUTTON|BS_RIGHT|BS_VCENTER|WS_TABSTOP, 33, 148, 56, 24
}