CalcPB

Lubos · Post by **Lubos** » Mon Apr 25, 2011 11:22 pm

A few days ago I asked after a source code for a simple calculator. The answers did not solve my problem completely, but the binary calculator created by Rook Zimbabwe stimulated me to further work.
I know, there is calc.exe in system32 directory and usefulness of DIY calculator is therefore questionable. However I think that possibility built calculator directly into another own exe file is handy. Here is it.

Code: Select all


;*************************************************************
;*************************************************************
;*************************************************************
;
; CalcPB by Lubos Svoboda 2011
; double precision version
; more colored
; added a last digit deleting button
; removed memory button (now useless)
; adjust to a procedure called as CalcPB()
; created by rewriting of BinCalc by Ralph Dunn 2009
; (Nickname of R. Dunn in PureBasic Forum: Rook Zimbabwe)
; Thanks Rook !
; enriched by kernadec  - numeric keyboard on
; Thanks kernadec !
;
Enumeration
#Window_CALCPB
EndEnumeration

Enumeration
#Button_CLEAR=2334
#Button_EQUAL=2335
#Button_DIVIDE=2336
#Button_MULTIPLY=2337
#Button_MINUS=2338
#Button_PLUS=2339
#Button_1=2340
#Button_0=2341
#String_OUT=2342
#Font=2343
#Button_2=2344
#Button_4=2345
#Button_6=2346
#Button_8=2347
#Button_3=2348
#Button_5=2349
#Button_7=2350
#Button_9=2351
#Button_POINT=2352
#Button_SQR=2353
#Button_Enter=2354
#Button_Back=2355
EndEnumeration

LoadFont(#Font, "Courier Bold", 14)

Structure VisualDesignerGadgets
  Gadget.l
  EventFunction.l
EndStructure

Global NewList EventProcedures.VisualDesignerGadgets()

Global oldvalue$ ; last value entered
Global value$ ; new value
Global value.d
Global oldvalue.d
Global DOFLAG
Global ANSWERFLAG
Global answer.d
Global Rou.b ; number of decimal places
Global Okrou.b ; mumber of digits
Global Oper.b ; flag
Global Result$
Global memvalue.d
Define Target.d

If Rou=0
  Rou=5
EndIf
;==========================================================

Procedure Button_Enter_Event(Window, Event, Gadget, Type)
  If Oper<2
    ProcedureReturn
  EndIf
  SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $FFFFFF)
  value$ =  Result$
  SetGadgetText(#String_OUT, value$)

  Oper=0
EndProcedure

;-
Procedure Equalize(DOFLAG)
  If $0000FF = GetGadgetColor(#String_OUT, #PB_Gadget_FrontColor)
    SetGadgetText(#String_OUT, Result$)     
  EndIf
   
   
  SetGadgetText(#String_OUT, "")

  value = ValD(value$)
  oldvalue = ValD(oldvalue$)
  
  
  Select DOFLAG

    Case 1 ; ADD
    
      
    SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $CCFFFF)
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $FF0000)
    Oper=1
    answer = oldvalue + value
    If memvalue>0
      answer=memvalue
      memvalue=0
    EndIf
    value = answer

  Case 2 ; SUBTRACT
    SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $CCFFFF)
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $FF0000)
    Oper=1
    answer = (oldvalue - value)

    If answer < 0 And  ANSWERFLAG =0
      answer = -answer
    EndIf

    If memvalue>0
      answer=memvalue
      memvalue=0
    EndIf
    value = answer

  Case 3 ; divide
    SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $CCFFFF)
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $FF0000)
    Oper=1
    If value=0
      value=1
      Result$="??????????????????????"
    EndIf

    answer = oldvalue / value

    If answer =0
      answer = value
    EndIf
    If memvalue>0
      answer=memvalue
      memvalue=0
    EndIf
    value = answer

  Case 4 ; multiply
    SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $CCFFFF)
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $FF0000)
    Oper=1
    If oldvalue=0 And ANSWERFLAG=0
      oldvalue=1
    EndIf

    answer = oldvalue * value
    If memvalue>0
      answer=memvalue
      memvalue=0
    EndIf
    value = answer

  Case 5 ; sqr

    Sqrflag.b=1
    Oper=2

    If value > 0
      If $FF0000 = GetGadgetColor(#String_OUT, #PB_Gadget_FrontColor)
        answer=value 
        SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $FF0000)
     
      Else
        answer = Sqr(value)
     
       SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $0000FF)     
       Result$=StrD(answer,Rou)
     EndIf
       
    Else
      Result$="??????????????????????"
    EndIf
    value =answer
    memvalue=answer
   

  EndSelect

  If Result$<>"??????????????????????"
    Result$ = StrD(Value,Rou)
  EndIf

  oldvalue$ = Result$

  SetGadgetText(#String_OUT, Result$)
  value$ = ""
  DOFLAG = 0
  ANSWERFLAG = 1
  If Sqrflag=1
    Sqrflag=0
    Button_Enter_Event(Window, Event, Gadget, Type)
  EndIf

EndProcedure

Procedure Button_EQUAL_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If $0000FF = GetGadgetColor(#String_OUT, #PB_Gadget_FrontColor)
    ProcedureReturn
  EndIf
 
   
  Equalize(DOFLAG)
  value = 0

  oldvalue = answer
  value$ = ""
  oldvalue$ = ""
  ANSWERFLAG = 0
  Oper=2
  SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $0000FF)
  Button_Enter_Event(Window, Event, Gadget, Type)
EndProcedure

Procedure Button_CLEAR_Event(Window, Event, Gadget, Type)
  
  SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $000000)
  SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $FFFFFF)
  value = 0
  oldvalue = 0
  answer=0 
  memvalue=0 
  If  Result$="??????????????????????"
    Result$=""
  EndIf
  value$ = ""
  oldvalue$ = ""
  ANSWERFLAG = 0
  Oper=0

  SetGadgetText(#String_OUT, value$)
  
EndProcedure
;-
Procedure Button_PLUS_Event(Window, Event, Gadget, Type)
  If Oper>0
    ProcedureReturn
  EndIf

  ANSWERFLAG = 0
  DOFLAG = 1
  SetGadgetText(#String_OUT, "")
  Equalize(DOFLAG)
EndProcedure

Procedure Button_MINUS_Event(Window, Event, Gadget, Type)
  If Oper>0
    ProcedureReturn
  EndIf

  ANSWERFLAG = 0
  DOFLAG = 2
  SetGadgetText(#String_OUT, "")
  Equalize(DOFLAG)
EndProcedure

Procedure Button_DIVIDE_Event(Window, Event, Gadget, Type)
  If Oper>0
    ProcedureReturn
  EndIf

  DOFLAG = 3
  SetGadgetText(#String_OUT, "")
  Equalize(DOFLAG)
EndProcedure

Procedure Button_MULTIPLY_Event(Window, Event, Gadget, Type)
  If Oper>0
    ProcedureReturn
  EndIf

  DOFLAG = 4
  SetGadgetText(#String_OUT, "")
  Equalize(DOFLAG)
EndProcedure

Procedure Button_SQR_Event(Window, Event, Gadget, Type)
  If Oper>0
    ProcedureReturn
  EndIf

  DOFLAG = 5
  SetGadgetText(#String_OUT, "")
  Equalize(DOFLAG)
EndProcedure

;================================================================
;-
Procedure Button_1_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "1"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "1"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_3_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "3"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "3"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_5_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "5"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "5"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_7_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "7"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "7"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_9_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "9"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "9"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

;-
Procedure Button_2_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "2"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "2"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_4_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "4"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "4"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_6_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "6"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "6"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_8_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0 And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "8"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "8"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_0_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If Len(value$)-FindString(value$,".",1)>(Rou-1) And  FindString(value$,".",1)>0 And  FindString(value$,".",1)>0
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = value$ + "0"
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    value$ = value$ + "0"
    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure

Procedure Button_POINT_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    If FindString(value$,".",1)>0
      ProcedureReturn
    EndIf
    value$ = GetGadgetText(#String_OUT)
    If Len(value$)=0
      value$="0."
    Else
      value$ = value$ + "."
    EndIf

    SetGadgetText(#String_OUT, value$)
  EndIf

  If answerflag = 1
    If FindString(value$,".",1)>0
      ProcedureReturn
    EndIf
    SetGadgetColor(#String_OUT, #PB_Gadget_FrontColor, $339900)
    SetGadgetText(#String_OUT, "")
    If Len(value$)=0
      value$="0."
    Else
      value$ = value$ + "."
    EndIf

    SetGadgetText(#String_OUT, value$)
  EndIf
EndProcedure
;-
;========================================================

Procedure Button_BACK_Event(Window, Event, Gadget, Type)
  If Oper=2
    ProcedureReturn
  EndIf
  If $0000FF = GetGadgetColor(#String_OUT, #PB_Gadget_FrontColor)
    ProcedureReturn
  EndIf

  If ANSWERFLAG = 0
    value$ = GetGadgetText(#String_OUT)
    value$ = Left(value$,Len(value$)-1)
    SetGadgetText(#String_OUT, value$)
  EndIf
  If answerflag = 1   
    If $FF0000 = GetGadgetColor(#String_OUT, #PB_Gadget_FrontColor)
      ProcedureReturn
    EndIf

    SetGadgetText(#String_OUT, "")
    value$ = Left(value$,Len(value$)-1)
    SetGadgetText(#String_OUT, value$)

  EndIf
EndProcedure
;-

Procedure String_OUT_Event(Window, Event, Gadget, Type)
  ;*
EndProcedure
;-
Procedure RegisterGadgetEvent(Gadget, *Function)

  If IsGadget(Gadget)
    AddElement(EventProcedures())
    EventProcedures()\Gadget        = Gadget
    EventProcedures()\EventFunction = *Function
  EndIf

EndProcedure

Procedure CallEventFunction(Window, Event, Gadget, Type)

  ForEach EventProcedures()
  If EventProcedures()\Gadget = Gadget
    CallFunctionFast(EventProcedures()\EventFunction, Window, Event, Gadget, Type)
    LastElement(EventProcedures())
  EndIf
Next

EndProcedure

;==================================================================
;-
Procedure Open_Window_CALCPB()

  
  
    Sova=45
 
  If Result$= "??????????????????????"
    Result$=""
  EndIf

  If OpenWindow(#Window_CALCPB, 0, 0, 265, 340, "  CalcPB"+  Space(Sova)+"LS 2011",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    LoadFont(#Font, "Courier Bold", 14)

    StringGadget(#String_OUT, 5, 10, 255, 25, "", #PB_Text_Center |#PB_String_ReadOnly   )
    SetGadgetFont(#String_OUT, FontID(#Font))
    SetGadgetColor(#String_OUT, #PB_Gadget_BackColor, $FFFFFF)
    RegisterGadgetEvent(#String_OUT, @String_OUT_Event())

    ButtonGadget(#Button_0, 5, 100, 80, 30, "0")
    ButtonGadget(#Button_2, 5, 136, 80, 30, "2")
    ButtonGadget(#Button_4, 5, 172, 80, 30, "4")
    ButtonGadget(#Button_6, 5, 208, 80, 30, "6")
    ButtonGadget(#Button_8, 5, 244, 80, 30, "8")
    ButtonGadget(#Button_POINT, 5, 280, 80, 54, Chr(149))

    RegisterGadgetEvent(#Button_0, @Button_0_Event())
    RegisterGadgetEvent(#Button_2, @Button_2_Event())
    RegisterGadgetEvent(#Button_4, @Button_4_Event())
    RegisterGadgetEvent(#Button_6, @Button_6_Event())
    RegisterGadgetEvent(#Button_8, @Button_8_Event())
    RegisterGadgetEvent(#Button_POINT, @Button_POINT_Event())

    ButtonGadget(#Button_1, 92, 100, 80, 30, "1")
    ButtonGadget(#Button_3, 92, 136, 80, 30, "3")
    ButtonGadget(#Button_5, 92, 172, 80, 30, "5")
    ButtonGadget(#Button_7, 92, 208, 80, 30, "7")
    ButtonGadget(#Button_9, 92, 244, 80, 30, "9")

    RegisterGadgetEvent(#Button_1, @Button_1_Event())
    RegisterGadgetEvent(#Button_3, @Button_3_Event())
    RegisterGadgetEvent(#Button_5, @Button_5_Event())
    RegisterGadgetEvent(#Button_7, @Button_7_Event())
    RegisterGadgetEvent(#Button_9, @Button_9_Event())

    ButtonGadget(#Button_PLUS, 180, 40, 80, 54, "+")
    RegisterGadgetEvent(#Button_PLUS, @Button_PLUS_Event())

    ButtonGadget(#Button_MINUS, 180, 100, 80, 54, Chr(151))
    RegisterGadgetEvent(#Button_MINUS, @Button_MINUS_Event())

    ButtonGadget(#Button_MULTIPLY, 180, 160, 80, 54, "x")
    RegisterGadgetEvent(#Button_MULTIPLY, @Button_MULTIPLY_Event())

    ButtonGadget(#Button_DIVIDE, 180, 220, 80, 54, "/")
    RegisterGadgetEvent(#Button_DIVIDE, @Button_DIVIDE_Event())

    ButtonGadget(#Button_EQUAL, 180, 280, 80, 54, " = ")
    RegisterGadgetEvent(#Button_EQUAL, @Button_EQUAL_Event())

    ButtonGadget(#Button_CLEAR, 5, 40, 80, 54, " C ")
    
   
    RegisterGadgetEvent(#Button_CLEAR, @Button_CLEAR_Event())

    ButtonGadget(#Button_BACK, 92, 40, 80, 54, "< "+Chr(151))
    RegisterGadgetEvent(#Button_BACK, @Button_BACK_Event())

    If LoadImage(5, Podadr1$+"sqr.ico")
      ButtonImageGadget(#Button_SQR, 92, 280, 80, 54, ImageID(5))
    Else
      ButtonGadget(#Button_SQR, 92, 280, 80, 54, "sqr")
    EndIf

    RegisterGadgetEvent(#Button_SQR, @Button_SQR_Event())
  EndIf
EndProcedure

SetGadgetFont(#PB_Default, FontID(#Font))

Procedure CalcPB()

  Open_Window_CALCPB()

  oldvalue$ = ""

  Repeat

    Event  = WaitWindowEvent(22)
    Gadget = EventGadget()
    Type   = EventType()
    Window = EventWindow()

    Select Event
    Case #PB_Event_Gadget
      CallEventFunction(Window, Event, Gadget, Type)
    EndSelect

    ;=====================================================
    ;   Option for activation of NumPad - BEGIN
    ;     >>> = Insert      sqr = End
    ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

    If event = #WM_KEYDOWN  ;  Command key
      key = EventwParam()
    EndIf
    Select key
    Case #VK_0 , #VK_NUMPAD0
      Button_0_Event(Window, Event, Gadget, Type)
    Case #VK_1 , #VK_NUMPAD1
      Button_1_Event(Window, Event, Gadget, Type)
    Case #VK_2 , #VK_NUMPAD2
      Button_2_Event(Window, Event, Gadget, Type)
    Case #VK_3 , #VK_NUMPAD3
      Button_3_Event(Window, Event, Gadget, Type)
    Case #VK_4 , #VK_NUMPAD4
      Button_4_Event(Window, Event, Gadget, Type)
    Case #VK_5 , #VK_NUMPAD5
      Button_5_Event(Window, Event, Gadget, Type)
    Case #VK_6 , #VK_NUMPAD6
      Button_6_Event(Window, Event, Gadget, Type)
    Case #VK_7 , #VK_NUMPAD7
      Button_7_Event(Window, Event, Gadget, Type)
    Case #VK_8 , #VK_NUMPAD8
      Button_8_Event(Window, Event, Gadget, Type)
    Case #VK_9 , #VK_NUMPAD9
      Button_9_Event(Window, Event, Gadget, Type)
    Case #VK_ADD
      Button_PLUS_Event(Window, Event, Gadget, Type)
    Case #VK_DIVIDE
      Button_DIVIDE_Event(Window, Event, Gadget, Type)
    Case #VK_MULTIPLY
      Button_MULTIPLY_Event(Window, Event, Gadget, Type)
    Case #VK_SUBTRACT
      Button_MINUS_Event(Window, Event, Gadget, Type)
    Case #VK_DECIMAL
      Button_POINT_Event(Window, Event, Gadget, Type)
    Case #VK_DELETE
      Button_CLEAR_Event(Window, Event, Gadget, Type)
    Case #VK_RETURN
      Button_EQUAL_Event(Window, Event, Gadget, Type)
    Case #VK_END
      Button_SQR_Event(Window, Event, Gadget, Type)
    Case #VK_BACK
      Button_BACK_Event(Window, Event, Gadget, Type)
      Button_Enter_Event(Window, Event, Gadget, Type)

    EndSelect
    key=0

    ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    ;   Option for activation of NumPad - END
    ;====================================================

  Until Event = #PB_Event_CloseWindow

  value = 0
  oldvalue = 0

  value$ = ""
  oldvalue$ = ""
  ANSWERFLAG = 0
  Oper=0
  ; End
  ;§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§

  
  If $0000FF = GetGadgetColor(#String_OUT, #PB_Gadget_FrontColor)
    ; visible red number is put into global variable Result$
  Else
    Result$=""
  EndIf

  ;§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§

EndProcedure

;*************************************************************
;*************************************************************
;*************************************************************

 CalcPB()

;***********************************************************
;***********************************************************
;***********************************************************

Trond · Post by **Trond** » Tue Apr 26, 2011 8:16 am

It doesn't work.

Press 1 + 2 + 3 =. The result is 24!

Lubos · Post by **Lubos** » Tue Apr 26, 2011 9:08 am

Trond wrote:It doesn't work. Press 1 + 2 + 3 =. The result is 24!

Second press of the + button is blocked. It is not an error but a property! Your example is therefore 1+23=24. The result is right.

Rook Zimbabwe · Post by **Rook Zimbabwe** » Tue Apr 26, 2011 3:58 pm

I made mine do HEX and BIN math and translations... nice looking program though!!!

to get around the block I had a procedure in the program to total the value whenever the + / - / * / / was pressed and a flag that I set as true if that happened so that it would ignore the = button if it was pressed after...

yes braindead simple programming but it worked!

skywalk · Post by **skywalk** » Tue Apr 26, 2011 4:06 pm

Lubos wrote:
Trond wrote:It doesn't work. Press 1 + 2 + 3 =. The result is 24!
Second press of the + button is blocked. It is not an error but a property! Your example is therefore 1+23=24. The result is right.

This is the exact reason I mentioned parsing the user's input into RPN.
1 + 2 + 3 is normal behavior for a calculator

Suppressing keystrokes is not.

Lubos · Post by **Lubos** » Tue Apr 26, 2011 6:56 pm

1 + 2 + 3 is normal behavior for a calculator
Suppressing keystrokes is not.

Characterization of suppressing keystrokes:

How primitive! But how effective!

(Above pair of sentencies is originally dialog between a dectective and a criminal in Czech comedy "Adele Has Not Had Her Dinner Yet". The climbing detective is hanging at height and the criminal is cutting detective's rope.)

Lubos · Post by **Lubos** » Wed Apr 27, 2011 11:30 am

And now seriously:

Possibility of returning results in a game is important. I try solve it by button >>>. The new version is replaced instead an old one.

Lubos · Post by **Lubos** » Wed Apr 27, 2011 4:39 pm

Last revision (I hope.)

A last digit deleting button added. (My colleague insist on it.)

kernadec · Post by **kernadec** » Wed Apr 27, 2011 6:58 pm

hi Lubos
thank for the sharing
option using the numpad
memory " insert"
sqr " end"
goodbye

Code: Select all

	Select Event
	Case #PB_Event_Gadget
		CallEventFunction(Window, Event, Gadget, Type)
	EndSelect
	If event = #WM_KEYDOWN  ;  Command key
	  key = EventwParam()
	EndIf
	Select key
	  Case #VK_0 , #VK_NUMPAD0
	  Button_0_Event(Window, Event, Gadget, Type)
	  Case #VK_1 , #VK_NUMPAD1
	  Button_1_Event(Window, Event, Gadget, Type)  
	  Case #VK_2 , #VK_NUMPAD2
	  Button_2_Event(Window, Event, Gadget, Type)
	  Case #VK_3 , #VK_NUMPAD3
	  Button_3_Event(Window, Event, Gadget, Type)
	  Case #VK_4 , #VK_NUMPAD4
	  Button_4_Event(Window, Event, Gadget, Type)
	  Case #VK_5 , #VK_NUMPAD5
	  Button_5_Event(Window, Event, Gadget, Type)
	  Case #VK_6 , #VK_NUMPAD6
	  Button_6_Event(Window, Event, Gadget, Type)
	  Case #VK_7 , #VK_NUMPAD7
	  Button_7_Event(Window, Event, Gadget, Type)
	  Case #VK_8 , #VK_NUMPAD8
	  Button_8_Event(Window, Event, Gadget, Type)
  	Case #VK_9 , #VK_NUMPAD9
	  Button_9_Event(Window, Event, Gadget, Type)
	  Case #VK_ADD
	  Button_PLUS_Event(Window, Event, Gadget, Type) 
	  Case #VK_DIVIDE
	  Button_DIVIDE_Event(Window, Event, Gadget, Type)
	  Case #VK_MULTIPLY
	  Button_MULTIPLY_Event(Window, Event, Gadget, Type)
	  Case #VK_SUBTRACT  
	  Button_MINUS_Event(Window, Event, Gadget, Type)
	  Case #VK_DECIMAL  
	  Button_POINT_Event(Window, Event, Gadget, Type)
	  Case #VK_DELETE
	  Button_CLEAR_Event(Window, Event, Gadget, Type) 
	  Case #VK_RETURN 
	  Button_EQUAL_Event(Window, Event, Gadget, Type) 
	  Button_Enter_Event(Window, Event, Gadget, Type)
	  Case #VK_INSERT
	  Button_Enter_Event(Window, Event, Gadget, Type)
	  Case #VK_END
	  Button_SQR_Event(Window, Event, Gadget, Type)
   EndSelect
    key=0
Until Event = #PB_Event_CloseWindow
End

Lubos · Post by **Lubos** » Wed Apr 27, 2011 8:55 pm

kernadec wrote: option using the numpad
memory " insert"
sqr " end"

Hi kernadec,
I built your enrichment into presented code. For PureBasic Forum only the best.

Thanks and nice day

kernadec · Post by **kernadec** » Wed Apr 27, 2011 9:33 pm

yes thank
We Must add backspace key

Code: Select all

    Case #VK_BACK  
	  Button_BACK_Event(Window, Event, Gadget, Type) 
	  Button_Enter_Event(Window, Event, Gadget, Type)

goodbye

Lubos · Post by **Lubos** » Thu Apr 28, 2011 6:12 am

kernadec wrote:We Must add backspace key

Done.
Nice day

TerryHough · Post by **TerryHough** » Thu Apr 28, 2011 4:29 pm

Here is a look at my version written originally in PB Vs 3.94 and updated through the current release. Virtually a copy of the Texas Instrument 1250 handheld calculator.

A screenshot

Enter data by clicking buttons or pressing numeric keypad or regular key equivalents

Emulation of a adding machine tape that scrolls.

Memory addition, subtraction, recall, and clear for additional use.

4 decimal digit precision on calculations

When called with a program parameter that is the handle of a gadget in the calling program and it can get and put data to that field. Get/Put buttons only activated when that handle is present.

Hover your mouse over the buttons for tooltip explanations

[/list]

Get the executable here CalcIt a 37.9Kb download.

Here is an example of getting and putting data with a calling program.

Code: Select all

Enumeration
  #Window
  #TextGadget
  #StrGadget
EndEnumeration


OpenWindow(#Window,0,0,400,400,"Test the Calculator",#PB_Window_SystemMenu)
TextGadget(#TextGadget,  10, 10, 290, 20, "A numeric value", #PB_Text_Right) 
StringGadget(#StrGadget,310, 10,  80, 20, "1200")
SetActiveGadget(#StrGadget)  ; a gadget must have focus

focused = GetFocus_()
If focused <> WindowID(#Window)
  GadgetToLink.s=Str(GetDlgCtrlID_(focused))
  F$ = Str(focused)
Else
  F$ = ""
EndIf
CalcPgm = RunProgram("CalcIt.exe",F$,"",#PB_Program_Open)

Repeat
  iEvent = WaitWindowEvent()
Until iEvent = #PB_Event_CloseWindow
End

See some of my other PureBasic examples at My PureBasic Page

Lubos · Post by **Lubos** » Thu Apr 28, 2011 7:03 pm

TerryHough wrote:Here is a look at my version written originally in PB Vs 3.94 and updated through the current release.
Get the executable here CalcIt a 20.5Kb download.
See some of my other PureBasic examples at My PureBasic Page

Thank you for your post.
My answer will a little broader so I’ll divide it to four points.

1. Download of Calcit was without any problems.

2. Your Calculator is nice. Memory management, % function, charming bubble tips, virtual paper tape and so on. As you can see, I did a certain improvements in my CalcPB today (input from regular keyboard, rich color style, better treatment of output) but your application is more rich.

3. Of course, your Calcit.exe can please different users in PBforum, but I need a calculator in source code form mainly. CalcPB is intended as a integrated part of program help in a bigger application. I suppose that my code will sufficient for me so I don’t ask you for your code.

4. I tried a look at your pages, but URL does not work. (Download worked. It's strange.)

Have a nice day

Lubos · Post by **Lubos** » Thu Apr 28, 2011 7:14 pm

Lubos wrote: 4. I tried a look at your pages, but URL does not work. (Download worked. It's strange.)

To TerryHough:
I solve it! You have an error in URL (elfec instead elfecc).

PureBasic Forums - English

CalcPB

CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB

Re: CalcPB