FiveTech Software tech support forums

#include "fivewin.ch"

function Main()

   local oDlg, oFont
   local nVal  := 123.46

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
   DEFINE DIALOG oDlg

   @ 10,10 GET nVal PICTURE "999,999,999.99" SIZE 80,12 PIXEL OF oDlg ;
      RIGHT ACTION ( ::cText := MsgCalc( nVal ) ) ;
      BITMAP "c:\fwh\bitmaps\16x16\calc.bmp"

   @ 50,10 BUTTON "OK" SIZE 40,14 PIXEL OF oDlg ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED

   ? nVal

return nil
 

#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

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
}
 

oCtrl    := oWndFromhWnd( GetFocus() )
if Valtype(oCtrl)='O' .and. 'GET'$oCtrl:ClassName()
  nType := oCtrl:VarGet()
  if ('XBROWSE' in oCtrl:oWnd:ClassName())
    oBrowse := oCtrl:oWnd
  endif
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 )
    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