home *** CD-ROM | disk | FTP | other *** search
- *******************************************************************************
- * PROGRAM: Cal.wfm
- *
- * WRITTEN BY: Borland Samples Group
- *
- * DATE: 5/93
- *
- * UPDATED: 6/94
- *
- * REVISION: $Revision: 2.77 $
- *
- * VERSION: dBASE FOR WINDOWS 5.0
- *
- * DESCRIPTION: This file contains a calculator form. This calculator
- * contains pushbuttons for numeric input and operations. It also
- * contains 2 entryfields -- the main display, showing the current
- * calculation, and a memory display, showing current memory
- * contents. Calculations can be performed in either decimal
- * or hexadecimal systems.
- *
- * PARAMETERS: None
- *
- * CALLS: None
- *
- * USAGE: DO Cal.wfm
- *
- *******************************************************************************
- #define MAX_DEC_DIGITS 18
- #define MAX_HEX_DIGITS 8
- #define OVERFLOW 2^32
-
- create session && there are no tables in this program, but
- && this line ensures that the variable names used
- && here don't refer to any tables opened previously
- set talk off
- set ldCheck off
-
- ** END HEADER -- do not remove this line*
- * Generated on 06/03/94
- *
- LOCAL f
- f = NEW CALFORM()
- f.Open()
-
- CLASS CALFORM OF FORM
- this.MousePointer = 1
- this.Width = 41.57
- this.Top = 0.76
- this.Left = 13.53
- this.Height = 17.34
- this.Text = "Calculator"
- this.Minimize = .F.
- this.Maximize = .F.
- this.HelpFile = ""
- this.HelpId = ""
- this.OnOpen = CLASS::ONOPEN
- this.OnGotFocus = CLASS::ONGOTFOCUS
- this.OnLostFocus = CLASS::ONLOSTFOCUS
-
- DEFINE RECTANGLE RECTANGLE2 OF THIS;
- PROPERTY;
- Width 40.26,;
- Top 12.38,;
- Left 0.66,;
- Height 2.76,;
- Text "",;
- ColorNormal "N/W",;
- Border .T.,;
- BorderStyle 1
-
- DEFINE RECTANGLE RECTANGLE1 OF THIS;
- PROPERTY;
- Width 40.26,;
- Top 2.20,;
- Left 0.66,;
- Height 10.18,;
- Text "",;
- ColorNormal "N/W",;
- Border .T.,;
- BorderStyle 1
-
- DEFINE ENTRYFIELD DISPLAY OF THIS;
- PROPERTY;
- Value " 0",;
- FontSize 15.00,;
- Width 40.26,;
- FontName "Courier New",;
- Top 0.27,;
- Left 0.66,;
- Height 1.66,;
- Function "J",;
- ColorNormal "N/BG*",;
- Border .T.,;
- Enabled .F.
-
- DEFINE PUSHBUTTON B7 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 2.47,;
- Left 1.98,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "7",;
- Default .F.,;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B8 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 2.47,;
- Left 7.92,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "8",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B9 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 2.47,;
- Left 13.86,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "9",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B4 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 4.96,;
- Left 1.98,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "4",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B5 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 4.96,;
- Left 7.92,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "5",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B6 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 4.96,;
- Left 13.86,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "6",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B1 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 7.43,;
- Left 1.98,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "1",;
- Default .F.,;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B2 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 7.43,;
- Left 7.92,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "2",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON B3 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 7.43,;
- Left 13.86,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "3",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON OPPLUSMINUS OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 9.91,;
- Left 1.98,;
- OnClick CLASS::PLUSMINUS_CLICK,;
- Height 2.20,;
- Text "+/-",;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON B0 OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 9.91,;
- Left 7.92,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "0",;
- ColorNormal "B/W"
-
- DEFINE PUSHBUTTON PERIOD OF THIS;
- PROPERTY;
- Text " ",;
- Width 5.28,;
- Top 9.91,;
- Left 13.86,;
- OnClick CLASS::PERIOD_CLICK,;
- Height 2.20,;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON OPPOWER OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 2.47,;
- Left 21.12,;
- OnClick CLASS::OP_CLICK,;
- Height 2.20,;
- Text "^",;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON OPTIMES OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 4.96,;
- Left 21.12,;
- OnClick CLASS::OP_CLICK,;
- Height 2.20,;
- Text "*",;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON OPDIV OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 7.43,;
- Left 21.12,;
- OnClick CLASS::OP_CLICK,;
- Height 2.20,;
- Text "/",;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON OPMINUS OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 9.91,;
- Left 21.12,;
- OnClick CLASS::OP_CLICK,;
- Height 2.20,;
- Text "-",;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON CLEAR OF THIS;
- PROPERTY;
- FontSize 7.00,;
- Width 5.28,;
- FontName "Small Fonts",;
- Top 2.47,;
- Left 27.06,;
- OnClick CLASS::CLEAR_CLICK,;
- Height 2.20,;
- Text "CE\C",;
- FontBold .F.,;
- ColorNormal "W*/R"
-
- DEFINE PUSHBUTTON OPEQUAL OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 4.96,;
- Left 27.06,;
- OnClick CLASS::OP_CLICK,;
- Height 2.20,;
- Text "=",;
- Default .T.,;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON OPPLUS OF THIS;
- PROPERTY;
- FontSize 9.00,;
- Width 5.28,;
- FontName "MS Serif",;
- Top 7.43,;
- Left 27.06,;
- OnClick CLASS::OP_CLICK,;
- Height 2.20,;
- Text "+",;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON HEXDEC OF THIS;
- PROPERTY;
- FontSize 7.00,;
- Width 5.28,;
- FontName "Small Fonts",;
- Top 9.91,;
- Left 27.06,;
- OnClick CLASS::CHANGEHEX,;
- Height 2.20,;
- Text "&Hex",;
- FontBold .F.,;
- ColorNormal "N/W"
-
- DEFINE PUSHBUTTON MADD OF THIS;
- PROPERTY;
- FontSize 7.00,;
- Width 5.94,;
- FontName "Small Fonts",;
- Top 2.47,;
- Left 33.66,;
- OnClick CLASS::MEM_CLICK,;
- Height 2.20,;
- Text "&MAdd",;
- FontBold .F.,;
- ColorNormal "W+/B"
-
- DEFINE PUSHBUTTON MSUB OF THIS;
- PROPERTY;
- FontSize 7.00,;
- Width 5.94,;
- FontName "Small Fonts",;
- Top 4.96,;
- Left 33.66,;
- OnClick CLASS::MEM_CLICK,;
- Height 2.20,;
- Text "M&Sub",;
- FontBold .F.,;
- ColorNormal "W+/B"
-
- DEFINE PUSHBUTTON MRCL OF THIS;
- PROPERTY;
- FontSize 7.00,;
- Width 5.94,;
- FontName "Small Fonts",;
- Top 7.43,;
- Left 33.66,;
- OnClick CLASS::MRCL_PROC,;
- Height 2.20,;
- Text "M&Rcl",;
- FontBold .F.,;
- ColorNormal "W+/B"
-
- DEFINE PUSHBUTTON MCLR OF THIS;
- PROPERTY;
- FontSize 7.00,;
- Width 5.94,;
- FontName "Small Fonts",;
- Top 9.91,;
- Left 33.66,;
- OnClick CLASS::MCLR_PROC,;
- Height 2.20,;
- Text "MClr",;
- FontBold .F.,;
- ColorNormal "W+/B"
-
- DEFINE PUSHBUTTON B_A OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 12.67,;
- Left 3.30,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "&A",;
- ColorNormal "B+/W",;
- Enabled .F.
-
- DEFINE PUSHBUTTON B_B OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 12.67,;
- Left 9.24,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "&B",;
- ColorNormal "B+/W",;
- Enabled .F.
-
- DEFINE PUSHBUTTON B_C OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 12.67,;
- Left 15.18,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "&C",;
- ColorNormal "B+/W",;
- Enabled .F.
-
- DEFINE PUSHBUTTON B_D OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 12.67,;
- Left 21.12,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "&D",;
- ColorNormal "B+/W",;
- Enabled .F.
-
- DEFINE PUSHBUTTON B_E OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 12.67,;
- Left 27.06,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "&E",;
- ColorNormal "B+/W",;
- Enabled .F.
-
- DEFINE PUSHBUTTON B_F OF THIS;
- PROPERTY;
- Width 5.28,;
- Top 12.67,;
- Left 32.99,;
- OnClick CLASS::NUMERIC_CLICK,;
- Height 2.20,;
- Text "&F",;
- ColorNormal "B+/W",;
- Enabled .F.
-
- DEFINE ENTRYFIELD MEMORY OF THIS;
- PROPERTY;
- Value " ",;
- FontSize 15.00,;
- Width 40.26,;
- FontName "Courier New",;
- Top 15.41,;
- Left 0.66,;
- Height 1.66,;
- Function "J",;
- ColorNormal "W+/W",;
- Border .T.,;
- Enabled .F.
-
- ****************************************************************************
- procedure OnOpen
- ****************************************************************************
-
-
- this.periodChar = setto("point") && this is necessary for international
- this.period.text = form.periodChar && applications
-
- this.OpPlus.Doit = {|a,b|a+b}
- this.OpMinus.Doit = {|a,b|a-b}
- this.OpTimes.Doit = {|a,b|a*b}
- this.OpDiv.Doit = {|a,b|a/b}
- this.OpPower.Doit = {|a,b|a^b}
- this.OpEqual.Doit = .f.
- this.MAdd.Doit = {|a,b|a+b}
- this.MSub.Doit = {|a,b|a-b}
-
- this.hex = .f. && in hex or decimal mode
- this.decPlaces = 0 && how many decimal places to use in calculation
- this.mostDecPlaces = 0 && most decimal places in an operand for operation
- this.beforePeriod = .t. && add numbers before or after decimal pt.
- this.lastKeyOperator = .f.
- this.DefineBackgroundTexts()
-
- this.Clear.OnClick()
- this.MClr.OnClick()
-
- ****************************************************************************
- procedure OnGotFocus
- ****************************************************************************
- set decimals to form.decPlaces
-
- ****************************************************************************
- procedure OnLostFocus
- * Unset Enter key, so other forms can use it for their own purposes
- ****************************************************************************
- set decimals to
-
-
- ****************************************************************************
- procedure DefineBackgroundTexts
-
- * Define texts behind non-alphabetic characters, so the picks for the text
- * will execute the onclick for these buttons, and button text doesn't
- * look cluttered and strange.
- ****************************************************************************
- CLASS::DefineText(this.b1)
- CLASS::DefineText(this.b2)
- CLASS::DefineText(this.b3)
- CLASS::DefineText(this.b4)
- CLASS::DefineText(this.b5)
- CLASS::DefineText(this.b6)
- CLASS::DefineText(this.b7)
- CLASS::DefineText(this.b8)
- CLASS::DefineText(this.b9)
- CLASS::DefineText(this.b0)
- CLASS::DefineText(this.period)
- CLASS::DefineText(this.opPower)
- CLASS::DefineText(this.opTimes)
- CLASS::DefineText(this.opDiv)
- CLASS::DefineText(this.opMinus)
- CLASS::DefineText(this.opPlus)
- CLASS::DefineText(this.opEqual)
-
-
- ****************************************************************************
- procedure DefineText(button)
-
- * Define text to appear behind button. This text will be before the button
- * in the tabbing order
- ****************************************************************************
- private tName
- tName = button.name + "Text"
- define text &tName of this;
- property;
- top button.top,;
- left button.left,;
- text "&" + button.text,;
- before button
-
- ****************************************************************************
- procedure ChangeHex
- ****************************************************************************
- local value,memValue,dispFraction,memFraction
-
- * Get values in display and memory before changing hex indicator
- value = NumVal(form.display.value, form.hex)
- memValue = NumVal(form.memory.value, form.hex)
- form.beforePeriod = .t.
- set decimals to form.decPlaces
- dispFraction = val(substr(form.display.value,;
- at(form.periodChar, form.display.value)))
- memFraction = val(substr(form.memory.value,;
- at(form.periodChar, form.memory.value)))
-
- form.hex = .not. form.hex
- this.text = iif(form.hex, "Dec", "&Hex")
-
- * Enable/disable hex letter digits
- store form.hex to ;
- form.B_A.enabled, form.B_B.enabled, form.B_C.enabled,;
- form.B_D.enabled, form.B_E.enabled, form.B_F.enabled
-
- * Enable/disable keys not applicable to hex calculations
- store .not. form.hex to ;
- form.opPlusMinus.enabled, form.period.enabled
-
- if abs(value) > OVERFLOW
- form.display.value = replicate("*",MAX_HEX_DIGITS)
- else
- form.display.value = CharVal(value + dispFraction, form.hex,;
- form.decPlaces)
- endif
- if abs(memValue) > OVERFLOW
- form.memory.value = replicate("*",MAX_HEX_DIGITS)
- else
- form.memory.value = CharVal(memValue + memFraction, form.hex,;
- form.decPlaces)
- endif
-
- ****************************************************************************
- procedure Numeric_Click
- ****************************************************************************
- local num
- if form.lastKeyOperator
- form.LastKeyOperator = .f.
- form.beforePeriod = .t.
- form.display.value = space(MAX_DEC_DIGITS - 1) + DisplayValue(this.text)
- else
- do case
- case displayFull(form)
- ??chr(7)
- case form.beforePeriod
- form.display.value = DisplayValue(form.display.value) +;
- DisplayValue(this.text)
- otherwise
- form.display.value = AddAfterPeriod(form,DisplayValue(this.text))
- endcase
- endif
- form.opEqual.SetFocus()
-
- ****************************************************************************
- procedure Period_Click
- ****************************************************************************
- if form.beforePeriod .and. .not. form.hex
- form.beforePeriod = .f.
- form.decPlaces = 0
- set decimals to 0
- if form.lastKeyOperator
- form.LastKeyOperator = .f.
- form.display.value = space(MAX_DEC_DIGITS - 1) + form.periodChar
- else
- form.display.value = AddAfterPeriod(form,form.periodChar)
- endif
- endif
-
- ****************************************************************************
- procedure Op_Click
- ****************************************************************************
- if form.LastKeyOperator .or. empty(form.lastOp)
- form.lastValue = NumVal(form.display.value,form.hex)
- else
- set decimals to form.mostDecPlaces
- form.lastValue = form.LastOp(form.lastValue, NumVal(form.display.value,;
- form.hex))
- form.display.value = CharVal(form.lastValue, form.hex, form.mostDecPlaces)
- form.decPlaces = 0
- set decimals to 0
- endif
- form.beforePeriod = .t.
- form.lastKeyOperator = .t.
- form.LastOp = this.Doit
-
- ****************************************************************************
- procedure Mem_Click
- ****************************************************************************
- local result
-
- result = this.Doit(NumVal(form.memory.value, form.hex),;
- NumVal(form.display.value, form.hex))
- form.memory.value = CharVal(result, form.hex, form.mostDecPlaces)
-
- ****************************************************************************
- procedure MClr_Proc
- ****************************************************************************
- form.lastKeyOperator = .t.
- form.memory.value = space(MAX_DEC_DIGITS - 1) + "0"
-
- ****************************************************************************
- procedure MRcl_Proc
- ****************************************************************************
- if form.lastKeyOperator
- form.LastKeyOperator = .f.
- form.beforePeriod = .t.
- form.lastValue = NumVal(form.display.value, form.hex)
- form.display.value = form.memory.value
- else
- form.lastValue = NumVal(form.display.value, form.hex)
- form.display.value = form.memory.value
- endif
-
- ****************************************************************************
- procedure Clear_Click
- ****************************************************************************
- form.lastOp = .f.
- form.lastValue = 0
- form.lastKeyOperator = .f.
- form.decPlaces = 0
- set decimals to 0
- form.mostDecPlaces = 0
- form.display.value = space(MAX_DEC_DIGITS - 1) + "0"
- form.beforePeriod = .t.
-
- ****************************************************************************
- procedure PlusMinus_Click
- ****************************************************************************
- local num
- if .not. form.hex
- num = NumVal(form.display.value, form.hex)
- form.display.value = CharVal(num * -1, form.hex, form.mostDecPlaces)
- form.LastKeyOperator = .t.
- endif
-
- ENDCLASS
-
-
-
- *******************************************************************************
- function DisplayFull
- * Check if display already has MAX_DEC_DIGITS digits in it
- *******************************************************************************
- param calform
- local isFull,maxValueLen
- maxValueLen = iif(calform.hex, MAX_HEX_DIGITS,MAX_DEC_DIGITS)
- return substr(right(calform.display.value, maxValueLen), 1, 1) <> " "
-
- *******************************************************************************
- function AddAfterPeriod(form, text)
- *******************************************************************************
- form.decPlaces = form.decPlaces + 1
- set decimals to form.decPlaces
- form.mostDecPlaces = max(form.decPlaces, form.mostDecPlaces)
- return DisplayValue(form.display.value) + text
-
-
- *******************************************************************************
- function DisplayValue(value)
- * Display value without the pick character
- *******************************************************************************
- private num,pickLoc
- num = value
- pickLoc = at("&",num)
- do case
- case pickLoc <> 0
- num = stuff(num,pickLoc,1,"")
- case right(num,2) = " 0"
- num = space(MAX_DEC_DIGITS)
- case left(num,1) = " "
- num = substr(num,2)
- endcase
- return num
-
-
- *******************************************************************************
- function CharVal(num, hex, decPlaces)
- *******************************************************************************
- private string
- if hex
- string = itoh(num)
- string = space(MAX_DEC_DIGITS - len(string)) + string
- else
- string = str(num, MAX_DEC_DIGITS, decPlaces)
- endif
- return string
-
-
- *******************************************************************************
- function NumVal(string,hex)
- *******************************************************************************
- private h,num,periodLoc,s
-
- s = string
- if hex
- h = htoi(string)
- num = iif(h >= 2^31, bitxor(h,2^32), h)
- else
- periodLoc = at(setto("point"),s)
- if periodLoc <> 0
- num = val(stuff(s,periodLoc,1,"."))
- else
- num = val(string)
- endif
- endif
- return num
-
-
-
-
-
-
-
-
-
-
-
-
-