home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.alaska-software.com
/
2014.06.ftp.alaska-software.com.tar
/
ftp.alaska-software.com
/
acsn
/
BusiCalc_v1-40.Zip
/
BusiCalc.prg
< prev
next >
Wrap
Text File
|
2002-10-06
|
133KB
|
3,480 lines
********************************************************************************
*
* Module: BusiCalc.prg
* Category: Calculator
* Used By: Stand Alone and Multiple Apps.
* Purpose: To provide a calculator facility for general business
* applications that is keyboard and mouse aware and capable
* of Euro, Pound and Dollar exchange convertions.
*
* Author: Greg Doran, Dublin Ireland e-mail: GDO@eircom.net
* Version: 1.40
* Date: 6.Oct.2002 - Released to Public Domain
*
* Language: Xbase++ 1.8 (Should be ok with 1.7,1.6 and ?)
*
* Compile: Standard.
* Link: Standard.
* (PBuild BusiCalc)
*
* Requires: Project : BusiCalc.xpj v1.40
* Class : BusCalcCls.prg v1.40
* Main : BusiCalc.prg v1.40 (This File)
* Include : BusiCalc.ch v1.40
* Rates(*) : BusiCalc.xch
* Resource : BusiCalc.arc v1.40
* files : Resource.zip (All Icons,Bitmaps,Pointers + Blank_PB-BM.zip)
*
* Creates: (*) If not exist: BusiCalc.xch
*
*
* RunTime: ASRDBC10.DLL
* (not SOM.DLL
* included XPPNAT.DLL
* in Zip) XPPRT1.DLL
* XPPUI1.DLL
*
*****************************************************************************
*
* Revision History:
* =================
* Rev 1.10 12th.Jul.2001
* Initial release.
*
* Rev 1.20 15th.Nov.2001
* Changed: To a Text File replacing the exchange rate
* Dbf thus obviating the need for a DBE and DBF in
* 'Stand Alone' situations.
*
* Rev 1.30 30th.Sep.2002
* Added: Additional commenting for release to the Public Domain.
*
* Rev 1.40 6th.Oct.2002
* Added: TrapCursor() to prevent loosing 'grip' when moving
* calculator and the cursor is near the edge of Titlebar.
* Changed: Minor text changes.
*
*****************************************************************************
*
*****************************************************************************
*
* Copyright (c) Greg J Doran. 2001-2002 GDO@eircom.net
*
* This code is released under the GNU General Public Licence
* and is governed by the conditions and protocols setout therein.
*
* The code is provided "as is", without warranty of any kind,
* either expressed, or implied, including, but not limited to,
* the implied warranties of merchantability and fitness for a
* particular purpose. The entire risk as to the quality of this
* software, its use or misuse, modified or otherwise, lies with
* you, the recipient.
*
* For details regarding the GNU General Public Licence visit
* Phil Ide's Xbase++ FAQ.s at:
*
* http://www.idep.org.uk/xbase/xbfaq/xbfaq.htm
*
*****************************************************************************
*
#include "Gra.ch"
#include "Xbp.ch"
#include "Appevent.ch"
#include "Error.ch"
#include "dll.ch"
#include "busicalc.ch"
#include "Fileio.ch"
*
*****************************************************************************
* FUNCTIONS appsys() DbeSys()
*****************************************************************************
FUNCTION AppSys()
RETURN .T.
*
FUNCTION DbeSys()
RETURN .T.
* End of FUNCTIONS appsys() DbeSys()
*****************************************************************************
*
*****************************************************************************
*
* DLLFUNCTIONS(...) DO NOT WRAP LINES
DLLFUNCTION FindWindowA(lpClassName,lpWindowName) USING STDCALL FROM USER32.DLL
DLLFUNCTION BringWindowToTop(hwnd) USING STDCALL FROM USER32.DLL
DLLFUNCTION SetForegroundWindow(hwnd) USING STDCALL FROM USER32.DLL
DLLFUNCTION ShowWindow(hwnd,SW_SHOWMAXIMIZED) USING STDCALL FROM USER32.DLL
DLLFUNCTION UpdateWindow(hwnd) USING STDCALL FROM USER32.DLL
DLLFUNCTION SetCursorPos( nX, nY ) USING STDCALL FROM USER32.DLL
DLLFUNCTION MoveWindow(nhwnd,nx,ny,nWidth,nHeight,nbRepaint) USING STDCALL FROM USER32.DLL
*
* Also, Used directly...
*
* DllCall("User32.DLL", DLL_STDCALL,"GetWindowRect", hwnd, a4LTRB_lpRect)
* DllCall("User32.DLL", DLL_STDCALL, "ClipCursor", a4LTRB_lpRect)
*
* End of DLLFUNCTIONS(...)
*****************************************************************************
*
*****************************************************************************
* FUNCTION main()
*****************************************************************************
*
FUNCTION Main()
LOCAL aLBDownAtPos := {nil,nil}
LOCAL aPos := {nil,nil}
LOCAL aPP := {}
LOCAL aSize := {nil,nil}
LOCAL cTitle := "BusiCalc v1.40"
LOCAL hwnd := 0
LOCAL lLBDown := .F.
LOCAL mp1 := 0
LOCAL mp2 := 0
LOCAL nEvent := 0
LOCAL oDlg
LOCAL oXbp
LOCAL aRates := {}
LOCAL nStatus := 0
************************************
****** Is this a duplicate process?
************************************
hwnd := FindWindowA( 0, cTitle )
IF !(hwnd == 0)
ShowItsOpen(hwnd) // 'Tracers' to Top Titlebar
CANCEL // Duplicate, just cancel this one
ENDIF
*****************************************************************************
****************** CREATE DIALOG ***************************
*****************************************************************************
*
*** Get size of the desktop to display the application window centered
*
aSize := {318, 348} // Dialog MaxSize
aPos[1] := (SetAppWindow():currentSize()[1]-aSize[1])/2
aPos[2] := (SetAppWindow():currentSize()[2]-aSize[2])/2
***** Presentation Parameters
*
AAdd ( aPP, { XBP_PP_BGCLR, GRA_CLR_DARKBLUE } )
AAdd ( aPP, { XBP_PP_FGCLR, GRA_CLR_PALEGRAY } )
AAdd ( aPP, { XBP_PP_COMPOUNDNAME, "8.Arial" } )
***** Dialog from BusiCalc Class
*
oDlg:= BusiCalc():New( AppDesktop(),, aPos,aSize,aPP, .F.)
oDlg:border := XBPDLG_NO_BORDER
oDlg:titleBar := .F.
oDlg:sysmenu := .F.
oDlg:alwaysontop := .T.
oDlg:title := cTitle
oDlg:maxsize := aSize
oDlg:drawingArea:bitmap := BUSICALC
oDlg:setDisplayFocus := {|| setAppFocus(oDlg:oKeyTrap)}
oDlg:oKeyTrap:keyBoard := {|nKey| Calckeys(nKey,oDlg,@aRates)}
***** Move Window
oDlg:drawingArea:motion := {| MP1, uNIL, obj | ;
iif(lLBDown ,;
MoveWin(MP1,aLBDownAtPos,oDlg), nil) }
oDlg:drawingArea:lbDown := {| MP1, uNIL, obj | ;
lLBDown:= .T. ,;
aLBDownAtPos:= MP1 ,;
obj:setPointer( ,;
100 ,; // Hand
XBPWINDOW_POINTERTYPE_POINTER ),;
TrapCursor(oDlg:drawingArea,.T.) }
oDlg:drawingArea:lbUp := {| MP1, uNIL, obj | ;
lLBDown:= .F. ,;
setAppFocus(oDlg) ,;
setAppFocus(oDlg:oKeyTrap) ,;
obj:setPointer( , ;
XBPSTATIC_SYSICON_ARROW, ;
XBPWINDOW_POINTERTYPE_SYSPOINTER ),;
TrapCursor(oDlg:drawingArea,.F.) }
oDlg:Create()
oDlg:show()
oDlg:aCalcSize := aSize
SetAppWindow(oDlg)
setAppFocus(oDlg)
setAppFocus(oDlg:oKeyTrap)
*
*****************************************************************************
****************** END CREATE DIALOG **************************
*****************************************************************************
*
***** Programwide Static
*
bSaveErrorBlock := ErrorBlock( {|oError| MyErrorHandler(oError,oDlg) })
***** Get the Help Text and Bitmaps into an array.
*
MakeHelp(oDlg)
***** Get the Exchange rates and the last conversion mode used. (cXRate)
*
aRates:={StrZero(1.0,10),StrZero(1.0,10),StrZero(1.0,10),"DE"+Space(8)}
nStatus:= GetData("BusiCalc.xch",@aRates, 10)
IF nStatus%4 == 0 // Ignore closing error (4) and pray when saving....
oDlg:nPE := Val(aRates[1])
oDlg:nDE := Val(aRates[2])
oDlg:nDP := Val(aRates[3]) // == (1/oDlg:nPE)/(1/oDlg:nDE)
oDlg:cXRate := Alltrim(aRates[4])// DE, PE or DP
Else
***** Oppps! First time instal or file missing....
***** Instal Default exchange values and advise of need to check....
*
MyErrorMsg(-247,oDlg,nStatus)
***** Rates at 30.Sep.2002
oDlg:nPE := 0.627131 // p
oDlg:nDE := 0.978700 // b
oDlg:nDP := 1.560598 // u
***** Default: Conversion mode as Dollars to Euro
***** Alt: PE, Pounds to Euro and DP, Dollars to Pounds)
oDlg:cXRate := "DE"
***** Clear the decks lest we have a corrupt Array
ARemove(aRates,1,Len(aRates))
***** All Records must be length 10
aAdd(aRates,Str(0.627131,10,6))
aAdd(aRates,Str(0.978700,10,6))
aAdd(aRates,Str(1.560598,10,6))
aAdd(aRates,oDlg:cXRate+Space(8))
***** Save the rates
*
nStatus:= PutData("BusiCalc.xch", @aRates, 10)
IF !(nStatus == 0)
MyErrorMsg(-246,oDlg,nStatus)
ENDIF
ENDIF
***** Reset Variables
*
ClearAll(oDlg)
***** Initialise Variables not in ClearAll()
*
SET DECIMALS TO 14
oDlg:nDecs := 4 // Default no. of decimals display
oDlg:oDecSet2:setCaption( Alltrim(Str(oDlg:nDecs))+" Places") // Display
oDlg:nMemVal := 0
oDlg:oMemStore:setCaption("Memory Store"+Space(7)+"0.")
oDlg:nStoredOpNbr := 0
oDlg:nAccumStore := 0
oDlg:nStoredValue := 0
oDlg:nImmediateValue := 0
oDlg:lKillKeys := .F.
oDlg:nOpCount := 0
***** Setup the currency Conversion Mode
postAppEvent(xbeP_Keyboard,;
IIF(oDlg:cXRate == "PE",Asc('P'),;
IIF(oDlg:cXRate == "DP",Asc('B'),;
Asc('U'))),,;
oDlg:oKeyTrap)
nEvent := 0
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent(@mp1,@mp2,@oXbp)
oXbp:handleEvent(nEvent,mp1,mp2)
ENDDO
ErrorBlock(bSaveErrorBlock)
oDlg:Destroy()
RETURN nil
*
********************************************************************************
********************* END MAIN **************************
********************************************************************************
********************************************************************************
* STATIC FUNCTION CalcKeys()
* (Key Handler)
********************************************************************************
*
STATIC FUNCTION CalcKeys(nKey,oDlg,aRates)
LOCAL i := 0
LOCAL j := 0
LOCAL nStatus := 0
Do While .T.
***************************************************************
* Keystroke checks prior to Key handling.
***************************************************************
*
***** Only process functional keystrikes
IF !(UPPER(Chr(nKey))$" !#%()*+-./0123456789=ABCDEFGIKLNPQRSTUWX^" .OR.;
StrZero(nKey,3)$"003/008/013/022/027/028/255" .OR. nKey == 524320)
nKey := 0
EXIT // ^C/ BS/ CR/ ^V/Esc/ F1/Special Ctrl+Space
ENDIF
***** Ignore second click on Enter Key if % operation has
***** just been executed.
*
IF oDlg:oOperText:Caption == BM_PERCENT .AND.;
oDlg:oSymbol:Caption == BM_PERCENT .AND.;
(nKey == 13 .OR. nKey == 61) // (Enter or '=' keys)
nKey := 0
EXIT
ENDIF
***** If the Right bracket is open...
***** and the keypress is 'Enter' or '=', discard the keystroke.
***** Only a Right Bracket close can evaluate the "(content)"
*
IF !(oDlg:lRBracketClosed) .AND. (nKey == 13 .OR. nKey == 61)
nKey := 0
EXIT
ENDIF
***** Establish operator status for bracketed operation commencement.
***** Cannot commence bracketed operation without one of these
***** operators preceding it, check the key _preceding_ the current
***** key being evaluated.
*
IF Chr(oDlg:nLastKey)$"+*%-/^#"
oDlg:lOperator:= .T.
ELSE
oDlg:lOperator:= .F.
ENDIF
oDlg:nLastKey:= nKey
****************************************************************
* Disable BackSpace for anything other than these keystrokes
****************************************************************
*
IF !(oDlg:lKillKeys)
IF oDlg:lKeysEnabled
IF (Chr(nKey)$".0123456789()"+chr(13) )
oDlg:oPBbspace:setCaption( PB_BSPACE_ENA )
oDlg:lBS_Enabled:= .T.
Else
If !(UPPER(Chr(nKey))$" ABEPQTUWX" .OR.;
StrZero(nKey,3)$"003/008/022/027/028/") // (^C/BS/^V/Esc/F1)
oDlg:oPBbspace:setCaption( PB_BSPACE_DIS )
oDlg:lBS_Enabled:= .F.
Endif
Endif
ENDIF
ENDIF
***************************************************************
* END OF Keystroke checks prior to Key handling.
***************************************************************
*
****************************************************************
* *************** Now Handle the Keystroke *****************
****************************************************************
*
Do While .T.
****************************************************************
* MINIMISED ON TOP TITLEBAR - EXPAND THE WINDOW
****************************************************************
*
IF nKey == 524320 // Ctrl+SpaceBar
***** Ctrl+SpaceBar only works when BusiCalc still has focus
***** Otherwise a mouse-click is required
*
***** Hide the 'open up' button ( Top of screen: [ BusiCalc ][x] )
***** Resize as normal window at last recorded position
***** Direct all keystrokes to the Keytrap
***** And allow other Key interpretations
oDlg:oOpenUp:Hide()
oDlg:oPBExit:Hide()
oDlg:configure( , , {oDlg:aPos[1],oDlg:aPos[2]} , oDlg:aCalcSize)
setAppFocus(oDlg:oKeyTrap)
oDlg:lKillKeys:= .F.
ELSEIF oDlg:lKillKeys
***** BusiCalc is 'minimised' and may have focus, only nKey=524320
***** is valid, ignore any other keystrokes received for processing.
***** The Close button [X] is a 'system' button and will be actioned
***** by the event handler.
EXIT
*************************************************************
* Help File
*************************************************************
*
ELSEIF nKey==xbeK_F1 // HELP
***** Opening a Modal with own Key Handler
Info( "Help", oDlg:aCalcSize, oDlg)
*************************************************************
* About File
*************************************************************
*
ELSEIF nKey == 81 .OR. nKey == 113 //... 'Q' Query About
***** Opening a Modal with own Key Handler
Info( "About", oDlg:aCalcSize, oDlg)
****************************************************************
* COLLAPSE THE WINDOW - MINIMISE ON TOP TITLEBAR
****************************************************************
*
ELSEIF nKey == 32 // SpaceBar
***** Save the current dialog position
***** Show the 'open up' button ( [ BusiCalc ][x] )
***** Resize as 'collapsed' window at Top Titlebar
***** Prevent all Key interpretations except Ctrl+Space,
***** BusiCalc still has focus
oDlg:aPos:= oDlg:currentPos()
oDlg:oOpenUp:Show()
oDlg:oPBExit:Show()
oDlg:configure( , ,{AppDesktop():CurrentSize()[1]-200,;
AppDesktop():CurrentSize()[2]-18} , {121,16})
oDlg:lKillKeys:= .T.
***** Will now only respond to Ctrl+SpaceBar (as long as BusiCalc
***** has focus) or a Mouse Click on the 'Open-up' button
****************************************************************
* NUMERIC KEYSTROKE
****************************************************************
*
ELSEIF Chr(nKey)$".0123456789" .AND. oDlg:lKeysEnabled
***** Let other program sections know that an input has been entered
*
oDlg:lNewInput := .T.
****** Is this the first numeric keystroke input?
*
If oDlg:lNewCalculation
oDlg:cDisplay := "0." // Set start condition
oDlg:lHaveDecimal := .F. // We have not got a decimal
oDlg:lNewCalculation := .F. // Reset
oDlg:oPBbspace:setCaption(PB_BSPACE_ENA) // Enable the backspace key
oDlg:lBS_Enabled := .T.
Endif
oDlg:oDisplay:setCaption( oDlg:cDisplay ) // Display it
oDlg:nDisplay:= Val(oDlg:cDisplay) // Get the value of the input
***** What, if anything, do we display....
*
Do While .T.
****** If the display is '0.' and the key is '0' or '.' ignore
****** it, but record it as a decimal point if the key is '.'
****** provided that we do not already have one.
*
IF oDlg:cDisplay == "0." .AND.;
(Chr(nKey) == "." .OR. (Chr(nKey) == '0' .AND. !(oDlg:lHaveDecimal)))
IF Chr(nKey) == "."
oDlg:lHaveDecimal := .T. // We got a decimal point
Endif
EXIT
ELSE
****** If we have a decimal point and key is '.', ignore it
IF oDlg:lHaveDecimal .AND. Chr(nKey) == "."
EXIT // Duplicate '.'
ENDIF
****** If we have a decimal point just concatenate the input
*
If oDlg:lHaveDecimal
oDlg:cDisplay += Chr(nKey)
Else
****** If we have not got a decimal point and the display
****** is zero, then show only the input in the display
*
If oDlg:cDisplay == "0."
oDlg:cDisplay := Chr(nKey)
Else
****** Otherwise just concatenate it
*
oDlg:cDisplay += Chr(nKey)
IF Chr(nKey) == "."
oDlg:lHaveDecimal := .T. // We got a decimal point
Endif
Endif
Endif
****** Display and convert
*
oDlg:oDisplay:setCaption( oDlg:cDisplay ) // Show it
oDlg:nDisplay:= Val(oDlg:cDisplay) // Get the value of the input
ENDIF
EXIT
ENDDO .T.
****** Special case to feed back to nKey ='D'
****** on pressing the Enter Key (Set Decimals)
*
IF oDlg:lGettingDecsInput
oDlg:nValueStore := oDlg:nDisplay
Endif
****************************************************************
* INLINE OPERATOR KEYSTROKE - DOUBLE ENTRY
****************************************************************
*
ELSEIF Chr(nKey)$"+*%-/^#" // '^' is nth. Power, '#' is nth Root
***** Enable the number keys
oDlg:lKeysEnabled:= .T.
Dis_EnableKeys(oDlg)
oDlg:lLastOpWasImmediate := .F. // Sqr(), 1/x, +/- etc.
***** Could be an operator change only.
***** oDlg:lNewInput is set in the Numerics "ElseIf" section
*
If !(oDlg:lNewInput)
***** What is the operator?
oDlg:nOperation := At(Chr(nKey),"+*%-/^#")
***** Get the operator bitmap and display it
Do Case
Case oDlg:nOperation == 1
oDlg:nBMP := BM_PLUS
Case oDlg:nOperation == 2
oDlg:nBMP := BM_MULTIPLY
Case oDlg:nOperation == 3
oDlg:nBMP := BM_PERCENT
Case oDlg:nOperation == 4
oDlg:nBMP := BM_MINUS
Case oDlg:nOperation == 5
oDlg:nBMP := BM_DIVIDE
Case oDlg:nOperation == 6
oDlg:nBMP := BM_NTH_POWER
Case oDlg:nOperation == 7
oDlg:nBMP := BM_NTH_ROOT
EndCase
***** Show Operator before Main Display
oDlg:oSymbol:setCaption( oDlg:nBMP )
***** This was an operator change... Goodbye
EXIT
Endif
***** Reset the NewInput flag
oDlg:lNewInput := .F.
Do While .T.
***** Keep a record of the number of operators used
oDlg:nOpCount++
***** NOTE: For the purpose of explaning the Operation of this
***** code section the 'Add' Operation is assumed.
***** All other operators are treated in a similar manner.
***** On the input of the first number the Operation number
***** will be at level '0' so we just store the number input and
***** set the Operation number to 1 (add), indicating an addition is
***** in progress and then indicate that this is a new calculation.
***** Following the display of the number entered, we exit the DO
***** to get the next input.
If oDlg:nOperation == 0
***** Put the displayed value in the accumulator.
oDlg:nAccumulator := oDlg:nDisplay
***** Extract the Operation Number
oDlg:nOperation := At(Chr(nKey),"+*%-/^#") // In the example, add = 1
***** We are now processing a new calculation
oDlg:lNewCalculation:= .T.
***** We have indicated that this is a new calculation
***** We have stored what was in the display (a first input),
***** and have an operator to execute. (1) Add
***** Get the bitmap for the operator
Do Case
Case oDlg:nOperation == 1
oDlg:nBMP := BM_PLUS
Case oDlg:nOperation == 2
oDlg:nBMP := BM_MULTIPLY
Case oDlg:nOperation == 3
oDlg:nBMP := BM_PERCENT
Case oDlg:nOperation == 4
oDlg:nBMP := BM_MINUS
Case oDlg:nOperation == 5
oDlg:nBMP := BM_DIVIDE
Case oDlg:nOperation == 6
oDlg:nBMP := BM_NTH_POWER
Case oDlg:nOperation == 7
oDlg:nBMP := BM_NTH_ROOT
EndCase
***** Show Operator before Main Display
oDlg:oSymbol:setCaption( oDlg:nBMP )
***** Update the Audit trail (three statics above the main display)
oDlg:oValInput:setCaption( AllTrim(Str(Round(oDlg:nIntermediate, oDlg:nDecs))))
oDlg:oValInter:setCaption( AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))))
oDlg:oValAccum:setCaption( AllTrim(Str(Round(oDlg:nAccumulator, oDlg:nDecs))))
***** We exit here to get the 'next' number input
***** so that we can apply the operator to the two values.
****** Go get second input...
* Slan Leat.... Goodbye....
EXIT
Endif
***** Blank out the Operator before Main Display
oDlg:oSymbol:setCaption( BM_NIL_BLANK )
***** If the Operation number is not 1 (Add) (remember this is an example!)
***** we must be executing a string of calculations and this is the next
***** Operator (unless of course it is Add again) Therefore, we must execute
***** the previous operator instruction now ( 1 = Add ), and then set the
***** Operation number to the new operator instruction and Exit.
****************************************************************************
* ACTION THE OPERATOR KEYS --- USED IN MORE THAN ONE PLACE
****************************************************************************
*
***** This performs the calculation and handles errors..
KeysProcess(oDlg)
*
****************************************************************************
***** Now reset for a new Operation
*
oDlg:lNewCalculation:= .T.
***** But check if it was an attempted 'Divide by Zero'
***** The Xbase++ erorrhandler was disabled during these operations and
***** replaced by a 'local handler' in KeysProcess(), otherwise recovery
***** would have been made difficult by the Xbase++ Handler returning
***** a '0' on an error condition. This way we can let the user correct
***** the error or abort the calculation.
*
If (( oDlg:nOperation == 3 .OR. oDlg:nOperation == 5) .AND. oDlg:nDisplay == 0)
IF oDlg:nOperation == 3
oDlg:oSymbol:setCaption( BM_PERCENT ) // Show symbol before Main Display
ELSE
oDlg:oSymbol:setCaption( BM_DIVIDE )
ENDIF
oDlg:nDisplay := 0 // The display prior to X/0
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:oDisplay:setCaption( oDlg:cDisplay ) // Display it
EXIT // Exit DO now to correct error.
Endif
****** All ok, get the new Operation number
*
oDlg:nOperation := At(Chr(nKey),"+*%-/^#")
Do Case
Case oDlg:nOperation == 1
oDlg:nBMP := BM_PLUS
Case oDlg:nOperation == 2
oDlg:nBMP := BM_MULTIPLY
Case oDlg:nOperation == 3
oDlg:nBMP := BM_PERCENT
Case oDlg:nOperation == 4
oDlg:nBMP := BM_MINUS
Case oDlg:nOperation == 5
oDlg:nBMP := BM_DIVIDE
Case oDlg:nOperation == 6
oDlg:nBMP := BM_NTH_POWER
Case oDlg:nOperation == 7
oDlg:nBMP := BM_NTH_ROOT
EndCase
****** Show Operator before Main Display
oDlg:oSymbol:setCaption( oDlg:nBMP )
EXIT
ENDDO
****************************************************************
* EQUALS (ENTER) KEYSTROKE
****************************************************************
*
***** A valid '=' request is determined by checking what symbol is
***** displayed in front of the Main Display. The way the BMP symbols
***** are numbered it must always be a number equal to or higher than
***** the BM_PLUS BMP ID. +-*/ etc.
*
***** If the key is the Enter or Equals key and we have a valid request,
***** or, we are setting the number of decimals, or, a Left bracket is
***** 'closed' and a Right bracket 'open', we can evaluate the expression.
*
***** (The latter occurs when a bracketed operation is being processed.
*
***** Following a keypress on the right bracket, the 'ElseIf' transfers
***** control here for expression evaluation and Right Bracket closure.)
ELSEIF( Chr(nKey) == '=' .OR. nKey == 13 ).AND.;
(oDlg:oSymbol:caption >= BM_PLUS .OR.;
oDlg:lGettingDecsInput .OR.(;
!(oDlg:lLBracketOpen) .AND.;
!(oDlg:lRBracketClosed)))
***** This symbol can only be the currency - Either a Symbol or Blank
oDlg:oSymbol:setCaption( oDlg:nSymbol)
***** nOpCount=0 Means that no operations were actioned
***** inside the brackets e.g. 5* (9) so we need to force one.
*
IF oDlg:nOpCount== 0 .AND.;
!(oDlg:lLBracketOpen) .AND.;
!(oDlg:lRBracketClosed)
***** Force a multiply by 1 to satisfy the program algorithm
oDlg:nAccumulator := 1
oDlg:nOperation := 2 //(Multiply)
ENDIF
Do While .T.
***** Reset the NewInput flag to prevent an operator keystroke
***** adding the display to the accumulator. Percent needs additional
***** handling and is placed at the start of the CalcKey() function.
*
oDlg:lNewInput := .F.
Do While .T.
***** We must execute the previous operator instruction now.
*
** NOTE:
*
***** When a bracketed operation is closed, the oDlg:nStoredValue is passed
***** into oDlg:nAccumulator. This was the result of any operations carried
***** out prior to the bracketed operation.
*
***** The result from the bracketed operation is currently in oDlg:nDisplay.
****************************************************************************
* ACTION THE OPERATOR KEYS --- USED IN MORE THAN ONE PLACE
****************************************************************************
*
***** This performs the calculation and handles errors..
KeysProcess(oDlg)
*
****************************************************************************
***** Now reset for a new Operation
oDlg:lNewCalculation:= .T.
oDlg:lNewInput:= .F.
oDlg:lKeysEnabled:= .T.
Dis_EnableKeys(oDlg) // Enable the number keys
****** Check if there was an attempted 'Divide by Zero'
*
If (( oDlg:nOperation == 3 .OR. oDlg:nOperation == 5) .AND.;
oDlg:nDisplay == 0)
IF oDlg:nOperation == 3
oDlg:oSymbol:setCaption( BM_PERCENT ) // Show symbol before Main Display
ELSE
oDlg:oSymbol:setCaption( BM_DIVIDE )
ENDIF
oDlg:nDisplay := 0 // The display prior to X/0
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:oDisplay:setCaption( oDlg:cDisplay ) // Display it
EXIT // Exit DO now to correct error.
Endif
****** OtherWise, all ok, reset to get the new Operation number
*
oDlg:nOperation:= 0
EXIT
ENDDO
******Special Case.... See Set Decimals, ElseIf Chr(nKey) == 'D'
*
IF oDlg:lGettingDecsInput
***** Reset flag
oDlg:lGettingDecsInput := .F.
***** Re-establish the standard message.
oDlg:oSetDecMsg:setPresParam({ ;
{ XBP_PP_BGCLR, GRA_CLR_DARKBLUE }, ;
{ XBP_PP_FGCLR, GRA_CLR_DARKGRAY }, ;
{ XBP_PP_COMPOUNDNAME, "8.Arial"} } )
oDlg:oSetDecMsg:setcaption("Press SpaceBar to minimize")
***** Get the new number of Decimals held in oDlg:nValueStore.
***** Was transferred from oDlg:nDisplay.
*
oDlg:nDecs := Abs(Int(oDlg:nValueStore))
***** Limit it to 14 places (This is NOT a Set Decimals)
oDlg:nDecs := IIF( oDlg:nDecs > 14, 14, oDlg:nDecs)
****** ReStore the Vars
*
PopVars(oDlg)
Endif
***** Just finished a bracketed session ?
***** If so then we may need to repeat the operation to
***** evaluate the chained calculation.
*
IF !(oDlg:lLBracketOpen) .AND. !(oDlg:lRBracketClosed)
***** That is, the ')' was pressed and the final operation inside
***** the brackets has just been executed. We now need to reinstate
***** the operation initiated prior to opening the brackets.
IF oDlg:lLastOpWasImmediate // Sqr(), Sqroot() etc.
IF oDlg:nOpCount == 1 // Only one op in brackets eg. Sqr()
oDlg:nDisplay := oDlg:nImmediateValue // The result of the bracketed calc
ENDIF // was held in oDlg:nImmediateValue
ENDIF
***** reset
oDlg:lLastOpWasImmediate := .F.
oDlg:nOpCount:= 0
***** Retrieve the pending Operation, e.g. 2 (multiply). Len() because we
***** could have more than one bracketed session active, we want the last.
oDlg:nOperation := oDlg:aPreBracket[Len(oDlg:aPreBracket)][1]
***** Get the associated bitmap
Do Case
Case oDlg:nOperation == 1
oDlg:nBMP := BM_PLUS
Case oDlg:nOperation == 2
oDlg:nBMP := BM_MULTIPLY
Case oDlg:nOperation == 3
oDlg:nBMP := BM_PERCENT
Case oDlg:nOperation == 4
oDlg:nBMP := BM_MINUS
Case oDlg:nOperation == 5
oDlg:nBMP := BM_DIVIDE
Case oDlg:nOperation == 6
oDlg:nBMP := BM_NTH_POWER
Case oDlg:nOperation == 7
oDlg:nBMP := BM_NTH_ROOT
EndCase
oDlg:oSymbol:setCaption( oDlg:nBMP ) // before display.
oDlg:oOperText:setCaption( BM_NIL_BLANK ) // Between Input and Inter
***** Retrieve the stored value
oDlg:nIntermediate := oDlg:aPreBracket[Len(oDlg:aPreBracket)][2]
***** Retrieve the stored value
oDlg:nAccumulator := oDlg:nIntermediate
**** Update the displays
oDlg:oValInput:SetCaption( "" )
oDlg:oValInter:SetCaption( AllTrim(Str(Round(oDlg:nIntermediate, oDlg:nDecs))))
oDlg:oValAccum:SetCaption( AllTrim(Str(Round(oDlg:nAccumulator, oDlg:nDecs))))
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:oDisplay:SetCaption( oDlg:cDisplay )
**** Reset: Reset the NewInput flag, Operation process in progress
oDlg:lNewInput := .T.
oDlg:lNewCalculation := .F.
***** Remove the last operation and value
ARemove(oDlg:aPreBracket)
***** If we have more bracketed operations pending we need to re-establish
***** the 'lockout' conditions and execute the current operation pending.
*
IF Len(oDlg:aPreBracket)>=1
oDlg:lRBracketClosed := .F.
oDlg:lLBracketOpen := .T.
oDlg:oPBLbracket:setCaption( PB_L_BRACKET_DIS ) // Blue '('
oDlg:oPBRbracket:setCaption( PB_R_BRACKET_ENA ) // Red ')'
oDlg:oBrackets:setCaption(" ( ... "+Alltrim(Str(Len(oDlg:aPreBracket))))
****** Execute the pending operation.
LOOP
Else
***** Do not execute the pending operation, let the User press the
***** Enter key or continue with the calculation.
***** Close the Right Bracket.
oDlg:lRBracketClosed := .T.
***** Hide the 'number of open brackets indicator display'
oDlg:oBrackets:hide()
ENDIF
Endif
EXIT
ENDDO
****************************************************************
* LEFT BRACKET KEYSTROKE
****************************************************************
*
***** If the Left bracket is pressed and an operator preceded it.
ELSEIF nKey == 40 .AND. oDlg:lOperator
***** Store current Operation number and the calculation value so far.
aAdd(oDlg:aPreBracket,{oDlg:nOperation,oDlg:nAccumulator})
***** Clear All to start a new background session
***** False prevents ARemove(aPreBracket,1,ALL)
*
ClearAll(oDlg,.F.)
****** This establishes it as a background session
oDlg:lLBracketOpen := .T.
oDlg:lRBracketClosed := .F.
oDlg:oPBLbracket:setCaption( PB_L_BRACKET_DIS ) // Blue '('
oDlg:oPBRbracket:setCaption( PB_R_BRACKET_ENA ) // Red ')'
oDlg:nOpCount:=0
***** 'number of open brackets indicator display'
oDlg:oBrackets:setCaption(" ( ... "+Alltrim(Str(Len(oDlg:aPreBracket))))
oDlg:oBrackets:show()
****************************************************************
* RIGHT BRACKET KEYSTROKE
****************************************************************
*
***** If the Right bracket is pressed and oDlg:lLBracketOpen is True
***** and oDlg:lRBracketClosed is False
*
ELSEIF nKey == 41 .AND. ; // 41 = ')'
oDlg:lLBracketOpen .AND. !(oDlg:lRBracketClosed)
***** Is it the final Bracketed operation?
IF Len(oDlg:aPreBracket) == 1
oDlg:oPBLbracket:setCaption( PB_L_BRACKET )
oDlg:oPBRbracket:setCaption( PB_R_BRACKET )
***** The Equals, '=', ElseIf will close this bracket
***** when the content has been evaluated.
oDlg:lRBracketClosed := .F.
ENDIF
oDlg:lLBracketOpen := .F.
oDlg:lKeysEnabled := .F.
Dis_EnableKeys(oDlg)
***** Enable the 'Enter' key
oDlg:oPBequals:setCaption( PB_EQUALS_ENA )
***** Execute the Enter Key (or '=')
***** DO NOT use Postappevent! need to stay in 'Local' loop
nKey := Asc("=")
LOOP
****************************************************************
* IMMEDIATE OPERATOR KEYSTROKE
****************************************************************
*
ELSEIF Upper(Chr(nKey)) $ "NILFSR!K"
// N = Negate
// I = Invert (reciprocal)
// L = LocalTo (Pound to Euro) (Dollar to Euro or Pound)
// F = ForeignTo (Euro to Pound) (Euro or Pound to Dollar)
// S = Square
// R = SqRoot
// ! = Factoral Limited to n== 21. (Max. display capability)
// K = Pi to 14 decimals
***** Indicate that the result of this operation was immediate.
***** The result will be stored in oDlg:nImmediateValue
oDlg:lLastOpWasImmediate:= .T.
oDlg:nOpCount++
Do While .T.
oDlg:nAction := At( Upper(Chr(nKey)), "NILFSR!K")
****** Store original value for display
oDlg:nValueStore :=oDlg:nDisplay
Do Case
Case 1 == oDlg:nAction
oDlg:nDisplay:= oDlg:nDisplay * -1 // Negate (switch sign)
oDlg:oOperText:setCaption( BM_NEGATE )
Case 2 == oDlg:nAction
***** May not be necessary, but....
BEGIN SEQUENCE
oDlg:nDisplay := 1 / oDlg:nDisplay // Reciprocal (1/x)
oDlg:oOperText:setCaption( BM_RECIP )
ENDSEQUENCE
Case 3 == oDlg:nAction
***** To satisfy purests..... 10^38 Pounds to Euro <g>
BEGIN SEQUENCE
****** Pound to Euro, Dollar to Euro, Dollar to Pound
Do Case
******* If the currency is Pound/Euro and
******* the symbol is already Euro its illegal
******* If the currency is Pound/Euro and
******* the symbol is Dollar its illegal etc.
*
Case oDlg:cXRate == "PE" .AND.;
!(oDlg:nSymbol == BM_EUR .OR.;
oDlg:nSymbol == BM_DLR ) // Euro/Dollar
oDlg:nDisplay:= oDlg:nDisplay / oDlg:nConvertRate
oDlg:oOperText:setCaption( BM_PND_TO_EUR )
oDlg:nSymbol:= BM_EUR
oDlg:oSymbol:setCaption( oDlg:nSymbol )
Case oDlg:cXRate == "DE" .AND.;
!(oDlg:nSymbol == BM_EUR .OR.;
oDlg:nSymbol == BM_PND ) // Euro/Pound
oDlg:nDisplay:= oDlg:nDisplay / oDlg:nConvertRate
oDlg:oOperText:setCaption( BM_DLR_TO_EUR )
oDlg:nSymbol:= BM_EUR
oDlg:oSymbol:setCaption( oDlg:nSymbol )
Case oDlg:cXRate == "DP" .AND.;
!(oDlg:nSymbol == BM_PND .OR.;
oDlg:nSymbol == BM_EUR ) // Pound/Euro
oDlg:nDisplay:= oDlg:nDisplay / oDlg:nConvertRate
oDlg:oOperText:setCaption( BM_DLR_TO_PND )
oDlg:nSymbol:= BM_PND
oDlg:oSymbol:setCaption( oDlg:nSymbol )
Otherwise
// Do Nowt
Endcase
ENDSEQUENCE
Case 4 == oDlg:nAction
BEGIN SEQUENCE
****** Euro to Pound, Euro to Dollar, Pound to Dollar
Do Case
***** If the currency is Pound/Euro and
***** the symbol is already Pound its illegal
***** If the currency is Pound/Euro and
***** the symbol is Dollar its illegal etc.
*
Case oDlg:cXRate == "PE" .AND. ;
!(oDlg:nSymbol == BM_PND .OR.;
oDlg:nSymbol == BM_DLR ) // Pound/Dollar
oDlg:nDisplay:= oDlg:nDisplay * oDlg:nConvertRate
oDlg:oOperText:setCaption( BM_EUR_TO_PND )
oDlg:nSymbol:= BM_PND //
oDlg:oSymbol:setCaption( oDlg:nSymbol )
Case oDlg:cXRate == "DE" .AND.;
!(oDlg:nSymbol == BM_DLR .OR.;
oDlg:nSymbol == BM_PND ) // Dollar/Pound
oDlg:nDisplay:= oDlg:nDisplay * oDlg:nConvertRate
oDlg:oOperText:setCaption( BM_EUR_TO_DLR )
oDlg:nSymbol:= BM_DLR //
oDlg:oSymbol:setCaption( oDlg:nSymbol )
Case oDlg:cXRate == "DP" .AND.;
!(oDlg:nSymbol == BM_DLR .OR.;
oDlg:nSymbol == BM_EUR ) // Dollar/Euro
oDlg:nDisplay:= oDlg:nDisplay * oDlg:nConvertRate
oDlg:oOperText:setCaption( BM_PND_TO_DLR )
oDlg:nSymbol:= BM_DLR //
oDlg:oSymbol:setCaption( oDlg:nSymbol )
Otherwise
// Do Nowt
Endcase
ENDSEQUENCE
Case 5 == oDlg:nAction // Square
BEGIN SEQUENCE
oDlg:nDisplay:= oDlg:nDisplay * oDlg:nDisplay
oDlg:oOperText:setCaption( BM_SQUARED )
ENDSEQUENCE
Case 6 == oDlg:nAction // Square Root
If oDlg:nDisplay < 0
oDlg:cDisplay := AllTrim(Str(oDlg:nDisplay))
MyErrorMsg(-254,oDlg)
EXIT
Else
oDlg:nDisplay:= Sqrt(oDlg:nDisplay)
oDlg:oOperText:setCaption( BM_SQR_ROOT )
Endif
Case 7 == oDlg:nAction // Factorial
oDlg:nValueStore:= ;
IIF(At(".",oDlg:cDisplay)>0,;
Int(Val(Left(oDlg:cDisplay,At(".",oDlg:cDisplay)-1))),;
Val(oDlg:cDisplay))
If oDlg:nValueStore <= 0 .OR. oDlg:nValueStore >21
oDlg:cDisplay := AllTrim(Str(oDlg:nDisplay))
MyErrorMsg(-253,oDlg)
EXIT
Else
j:= 1
For i := 1 to oDlg:nValueStore
j *= i
Next i
oDlg:nDisplay := j
oDlg:oOperText:setCaption( BM_N_FACTORIAL )
Endif
****** Temporary change to Zero Decimal Places
i := oDlg:nDecs
oDlg:nDecs:= 0
Case 8 == oDlg:nAction // PI
****** Pi to 14 places (From 58 Billion places)
oDlg:nDisplay:= 3.14159265358979
***** Clear the inter display symbol not relevant
oDlg:oOperText:setCaption( BM_NIL_BLANK )
OtherWise
// do Nowt
EndCase
If oDlg:lKeysEnabled
***** If numbers are enabled then use input value
oDlg:oValAccum:SetCaption( AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))))
oDlg:oValInput:SetCaption( AllTrim(Str(Round(oDlg:nValueStore, oDlg:nDecs))))
oDlg:oValInter:SetCaption( "" )
oDlg:oDisplay:SetCaption( AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))) )
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
Else
***** Otherwise use Accumulator value
oDlg:nAccumulator:=oDlg:nDisplay
oDlg:nIntermediate:=oDlg:nAccumulator
oDlg:oValInter:SetCaption( "" )
oDlg:oValInput:SetCaption( AllTrim(Str(Round(oDlg:nValueStore, oDlg:nDecs))))
oDlg:oValAccum:SetCaption( AllTrim(Str(Round(oDlg:nAccumulator, oDlg:nDecs))))
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nAccumulator, oDlg:nDecs)))
oDlg:oDisplay:SetCaption( oDlg:cDisplay )
Endif
***** Re-establish decimal Places following n!
If oDlg:nAction == 7
oDlg:nDecs := i
Endif
***** Disable the number keys
oDlg:lKeysEnabled:= .F.
Dis_EnableKeys(oDlg)
oDlg:lNewInput := .T.
***** Now get the immediate value and store it.
***** This may be used later. e.g. in a bracketed operation.
oDlg:nImmediateValue := oDlg:nDisplay
EXIT
ENDDO
****************************************************************
* CLEAR ALL
****************************************************************
*
ELSEIF Upper(Chr(nKey)) == 'C'
ClearAll(oDlg)
****************************************************************
* CLEAR ENTRY
****************************************************************
*
ELSEIF UPPER(Chr(nKey)) == "E" .OR. nKey == 27 //Esc
oDlg:cDisplay := "0."
oDlg:oDisplay:setCaption( oDlg:cDisplay ) // Clear the Display
oDlg:nDisplay := Val( oDlg:cDisplay)
***** Enable the number keys
oDlg:lKeysEnabled := .T.
Dis_EnableKeys(oDlg)
****************************************************************
* BACKSPACE KEYSTROKE
****************************************************************
*
ELSEIF nKey == 8
***** Allow backspacing if flag is enabled
IF oDlg:lBS_Enabled
IF Len(oDlg:cDisplay) > 1 .AND. ;
!(Len(oDlg:cDisplay) == 2 .AND. oDlg:cDisplay =='0.')
oDlg:cDisplay := SubStr(oDlg:cDisplay,1,Len(oDlg:cDisplay)-1)
Else
oDlg:cDisplay := "0."
Endif
oDlg:oDisplay:setCaption( oDlg:cDisplay )
oDlg:nDisplay := Val(oDlg:cDisplay)
ENDIF
****************************************************************
* ADD TO MEMORY KEYSTROKE
****************************************************************
*
ELSEIF UPPER(Chr(nKey)) == 'A' //....Add to Memory
***** Need to check for Round( oDlg:nDisplay ) = oDlg:cDisplay
***** in case this was the result of a calculation and not just
***** an input. If calculation then oDlg:nDisplay should be used.
*
IF AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))) == oDlg:cDisplay
***** It resulted from a calculation
oDlg:nMemVal := oDlg:nMemVal +oDlg:nDisplay
ELSE
***** It is an input
oDlg:nMemVal := oDlg:nMemVal + Val(oDlg:cDisplay)
ENDIF
oDlg:oMemStore:setCaption( AllTrim(Str(Round(oDlg:nMemVal, oDlg:nDecs))))
****************************************************************
* TAKE FROM MEMORY KEYSTROKE
****************************************************************
*
ELSEIF UPPER(Chr(nKey)) == 'T' //....Take from Memory
IF AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))) == oDlg:cDisplay
***** It resulted from a calculation
oDlg:nMemVal := oDlg:nMemVal - oDlg:nDisplay
ELSE
***** It is an input
oDlg:nMemVal := oDlg:nMemVal - Val(oDlg:cDisplay)
ENDIF
oDlg:oMemStore:setCaption( AllTrim(Str(Round(oDlg:nMemVal, oDlg:nDecs))))
****************************************************************
* WIPE MEMORY KEYSTROKE
****************************************************************
*
ELSEIF UPPER(Chr(nKey)) == 'W' //....Wipe Memory
oDlg:nMemVal:=0
oDlg:oMemStore:setCaption( "Memory Store"+Space(7)+"0.")
****************************************************************
* GET MEMORY KEYSTROKE
****************************************************************
*
ELSEIF UPPER(Chr(nKey)) == 'G' //....Get Memory
***** Input Operation in progress
oDlg:lNewCalculation := .F.
oDlg:lNewInput := .T.
***** Just get it into the Main Display var.
oDlg:nDisplay := oDlg:nMemVal
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:oDisplay:setCaption( oDlg:cDisplay )
oDlg:oValInput:SetCaption( "" )
oDlg:oValInter:setCaption( AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))))
oDlg:oValAccum:setCaption( "" )
oDlg:lKeysEnabled:= .F.
Dis_EnableKeys(oDlg)
****************************************************************
* SET NUMBER OF DECIMALS KEYSTROKE
****************************************************************
*
ELSEIF Upper(Chr(nKey)) == "D"
****** Don't allow change during bracketed operation
If !(oDlg:lRBracketClosed)
MyErrorMsg(-250,oDlg)
EXIT
Endif
******* Sets the maximum number of decimals displayed.
******* The Display is limited but the calculations
******* are not affected. Any inprocess calculations
******* are performed to as many decimal places as
******* the system allows, the result is then rounded
******* for display purposes. Hence, with nDec == 0
******* 2.4 + 2.2 will display 5, Duh!
******* Save Where we are at.
*
oDlg:lGettingDecsInput := .T.
PushVars(oDlg,.T.)
****** Clear the decks
*
ClearAll(oDlg)
oDlg:oSetDecMsg:setPresParam({ ;
{ XBP_PP_BGCLR, GRA_CLR_BLACK }, ;
{ XBP_PP_FGCLR, GRA_CLR_GREEN }, ;
{ XBP_PP_COMPOUNDNAME, "8.Arial"} } )
oDlg:oSetDecMsg:setCaption(;
"Input a number from 0-14 in the display and Press 'Enter'")
****** Go get the input now.
*
****** The task is completed in the ElseIf code Chr(nKey) == '='
****** when the equals / enter key is pressed.
****** oDlg:lGettingDecsInput being True completes the action.
oDlg:lGettingDecsInput := .T.
****** First time this was set .T. was for 'save' above
****** and was subsequently cleared by Clear All.
****************************************************************
* SET EXCHANGE RATE KEYSTROKE
****************************************************************
*
ELSEIF Upper(Chr(nKey)) == "X"
****** Don't allow change during bracketed operation
If !(oDlg:lRBracketClosed)
MyErrorMsg(-248,oDlg)
EXIT
Endif
***** Get the rates Update.
*
aRates:= Info( "Rates", oDlg:aCalcSize, oDlg)
***** Get the new rates into the Vars
oDlg:nPE := Val(aRates[1])
oDlg:nDE := Val(aRates[2])
oDlg:nDP := Val(aRates[3])
oDlg:cXRate := Alltrim(aRates[4])
***** Save the rates
*
nStatus:= PutData("BusiCalc.xch", @aRates, 10)
IF !(nStatus == 0)
MyErrorMsg(-246,oDlg,nStatus)
ENDIF
***** Setup the currency Conversion Mode
postAppEvent(xbeP_Keyboard,;
IIF(oDlg:cXRate == "PE",Asc('P'),;
IIF(oDlg:cXRate == "DP",Asc('B'),;
Asc('U'))),,;
oDlg:oKeyTrap)
***** Perform a crosscheck
//ValidateRates(oDlg)
****************************************************************
* SELECT POUNDS TO EUROS KEYSTROKE
****************************************************************
*
ELSEIF Upper(Chr(nKey)) == "P"
IF oDlg:oSymbol:Caption == BM_DLR
EXIT
ENDIF
oDlg:oPBLocalTo:setCaption( PB_PND_TO_EUR )
oDlg:oPBForeignTo:setCaption( PB_EUR_TO_PND )
oDlg:nConvertRate := oDlg:nPE
oDlg:cXRate := "PE"
oDlg:oXchgRate:setCaption( Alltrim(Str(Abs(oDlg:nConvertRate))))
***** Update the Array
aRates[4]:= oDlg:cXRate+Space(8)
***** Syntax: PutData( cFile, @aArray, nRec_Len, nRecNo)
***** Update record 4 in the file.
nStatus:= PutData("BusiCalc.xch", @aRates, 10, 4)
IF !(nStatus == 0)
MyErrorMsg(-246,oDlg,nStatus)
ENDIF
***** Perform a crosscheck
ValidateRates(oDlg)
****************************************************************
* SELECT DOLLARS TO POUNDS KEYSTROKE
****************************************************************
*
ELSEIF Upper(Chr(nKey)) == "B"
IF oDlg:oSymbol:Caption == BM_EUR
EXIT
ENDIF
oDlg:oPBLocalTo:setCaption( PB_PND_TO_DLR )
oDlg:oPBForeignTo:setCaption( PB_DLR_TO_PND )
oDlg:nConvertRate := oDlg:nDP
oDlg:cXRate := "DP"
oDlg:oXchgRate:setCaption( Alltrim(Str(Abs(oDlg:nConvertRate))))
***** Update the Array
aRates[4]:= oDlg:cXRate+Space(8)
***** Syntax: PutData( cFile, @aArray, nRec_Len, nRecNo)
***** Update record 4 in the file.
nStatus:= PutData("BusiCalc.xch", @aRates, 10, 4)
IF !(nStatus == 0)
MyErrorMsg(-246,oDlg,nStatus)
ENDIF
***** Perform a crosscheck
ValidateRates(oDlg)
****************************************************************
* SELECT DOLLARS TO EUROS KEYSTROKE
****************************************************************
*
ELSEIF Upper(Chr(nKey)) == "U"
IF oDlg:oSymbol:Caption == BM_PND
EXIT
ENDIF
oDlg:oPBLocalTo:setCaption( PB_DLR_TO_EUR )
oDlg:oPBForeignTo:setCaption( PB_EUR_TO_DLR )
oDlg:nConvertRate := oDlg:nDE
oDlg:cXRate := "DE"
oDlg:oXchgRate:setCaption( Alltrim(Str(Abs(oDlg:nConvertRate))))
***** Update the Array
aRates[4]:= oDlg:cXRate+Space(8)
***** Syntax: PutData( cFile, @aArray, nRec_Len, nRecNo)
***** Update record 4 in the file.
nStatus:= PutData("BusiCalc.xch", @aRates, 10, 4)
IF !(nStatus == 0)
MyErrorMsg(-246,oDlg,nStatus)
ENDIF
***** Perform a crosscheck
ValidateRates(oDlg)
****************************************************************
* IMPORT FROM CLIPBOARD KEYSTROKE
****************************************************************
*
ELSEIF nKey == xbeK_CTRL_V // Ctrl-V Insert/Paste
***** Data, and any errors handled in PollClipBoard()
oDlg:cClipText:= PollClipBoard( oDlg )
If !(Empty( oDlg:cClipText ))
***** Push the value
oDlg:nDisplay := Val(oDlg:cClipText)
***** Set Input Operation in progress
oDlg:lNewCalculation := .F.
***** Set the NewInput flag
oDlg:lNewInput := .T.
***** Show the clipboard data in the display
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:oDisplay:setCaption( oDlg:cDisplay )
oDlg:oValInter:setCaption( AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))))
oDlg:oValInput:setCaption( AllTrim(Str(Round(oDlg:nIntermediate, oDlg:nDecs))))
oDlg:oValAccum:setCaption( AllTrim(Str(Round(oDlg:nAccumulator, oDlg:nDecs))))
oDlg:lKeysEnabled:= .F.
Dis_EnableKeys(oDlg) // Disable the number keys
Endif
****************************************************************
* EXPORT TO CLIPBOARD KEYSTROKE
****************************************************************
*
ELSEIF nKey == xbeK_CTRL_C // Ctrl-C Copy to Clipboard
oDlg:oClipBoard:open()
oDlg:oClipBoard:clear()
oDlg:oClipBoard:setBuffer( oDlg:cDisplay )
oDlg:oClipBoard:close()
*****************************************************************
******** END OF IFs in KEYSTROKE HANDLER SECTION ***************
*****************************************************************
ENDIF //nKeys
EXIT
ENDDO
EXIT
ENDDO
***** Always Set the focus back to the keytrap
setAppFocus(oDlg:oKeyTrap)
Return nil
*
* END of STATIC FUNCTION CalcKeys()
*****************************************************************************
*
*****************************************************************************
* FUNCTION KeysProcess()
*****************************************************************************
*
FUNCTION KeysProcess(oDlg)
Do While .T.
****** Intermediate is a temporary store used for manipulation
oDlg:nIntermediate:= oDlg:nAccumulator
****** Execute the instruction
Do Case
Case 1 == oDlg:nOperation
BEGIN SEQUENCE
oDlg:nAccumulator := oDlg:nIntermediate + oDlg:nDisplay
oDlg:oOperText:setCaption( BM_PLUS ) // + between audit boxes
ENDSEQUENCE
Case 2 == oDlg:nOperation
BEGIN SEQUENCE
oDlg:nAccumulator := oDlg:nIntermediate * oDlg:nDisplay
oDlg:oOperText:setCaption( BM_MULTIPLY )
ENDSEQUENCE
Case 3 == oDlg:nOperation
If !oDlg:nDisplay== 0 // Zero Divide trap.
oDlg:nAccumulator := oDlg:nIntermediate * 100 / oDlg:nDisplay
oDlg:oOperText:setCaption( BM_PERCENT ) // % between audit boxes
oDlg:oSymbol:setCaption( BM_PERCENT ) // % before display.
***** If it was currency, it is no longer a currency
oDlg:nSymbol:= BM_NIL_BLANK
Else
MyErrorMsg(XPP_ERR_NUMERR,oDlg)
EXIT
Endif
Case 4 == oDlg:nOperation
oDlg:nAccumulator := oDlg:nIntermediate - oDlg:nDisplay
oDlg:oOperText:setCaption( BM_MINUS )
Case 5 == oDlg:nOperation
If !oDlg:nDisplay== 0 // Zero Divide trap.
oDlg:nAccumulator := oDlg:nIntermediate / oDlg:nDisplay
oDlg:oOperText:setCaption( BM_DIVIDE )
***** If it was, it is no longer a currency
oDlg:nSymbol:= BM_NIL_BLANK
ELSE
MyErrorMsg(XPP_ERR_ZERODIV,oDlg)
EXIT
ENDIF
Case 6 == oDlg:nOperation
BEGIN SEQUENCE
oDlg:nAccumulator := oDlg:nIntermediate ** oDlg:nDisplay
oDlg:oOperText:setCaption( BM_NTH_POWER )
ENDSEQUENCE
Case 7 == oDlg:nOperation // nth root
If oDlg:nIntermediate < 0
oDlg:cDisplay := AllTrim(Str(oDlg:nDisplay))
MyErrorMsg(-255,oDlg)
EXIT
Else
oDlg:nAccumulator := oDlg:nIntermediate**(1/oDlg:nDisplay)
oDlg:oOperText:setCaption( BM_NTH_ROOT )
Endif
OtherWise
// do Nowt
EndCase
oDlg:oValInter:setCaption( AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs))))
****** Retain full decimal integrity so that any calculations
****** using an unmodified display value have maximum accuracy
****** eg. 1/x or x^2.
oDlg:nDisplay := oDlg:nAccumulator
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:oDisplay:setCaption( oDlg:cDisplay )
oDlg:oValInput:setCaption( AllTrim(Str(Round(oDlg:nIntermediate, oDlg:nDecs))))
oDlg:oValAccum:setCaption( AllTrim(Str(Round(oDlg:nAccumulator, oDlg:nDecs))))
EXIT
ENDDO
RETURN nil
* END FUNCTION KeysProcess()
*****************************************************************************
*
*****************************************************************************
*
* FUNCTION ValidateRates()
*
* Uses the exchange rates to cross check for disparity
*
* PE = Pound to Euro, DE = Dollar to Euro, DP = Dollar to Pound
*
* Using two rates calculate the third and derive the percent error.
*
*****************************************************************************
*
FUNCTION ValidateRates(oDlg)
LOCAL nDPcalculated := (1/oDlg:nPE)/(1/oDlg:nDE)
LOCAL nError := Abs(nDPcalculated - oDlg:nDP) * 100/oDlg:nDP
nError := Round(nError,6)
If nError > 0.01 // 0.01% error
MyErrorMsg(-249,oDlg,nError)
Endif
Return nil
*
* END FUNCTION ValidateRates()
*****************************************************************************
*
*****************************************************************************
* FUNCTION ClearAll()
*****************************************************************************
*
FUNCTION ClearAll(oDlg,lSetPreBracket)
IF Valtype(lSetPreBracket)=="U"
lSetPreBracket:= .T.
ENDIF
***** Discard the data from the calculations prior to opening brackets
IF lSetPreBracket
ARemove(oDlg:aPreBracket,1,Len(oDlg:aPreBracket))
ENDIF
***** Hide the 'number of brackets open' display
oDlg:oBrackets:hide()
***** Set the Display to zero
oDlg:cDisplay := "0."
***** Enable BackSpace Key
oDlg:lBS_Enabled := .T.
***** Set Getting number of decimals to false
oDlg:lGettingDecsInput := .F.
***** Reset to not got a decimal point
oDlg:lHaveDecimal := .F.
***** Set the number key flag
oDlg:lKeysEnabled := .T.
***** Status of inline Operations
oDlg:lLastOpWasImmediate := .F.
***** Set New Calculation
oDlg:lNewCalculation := .F.
***** Set New input
oDlg:lNewInput := .F.
***** The main store
oDlg:nAccumulator := 0
***** The 'real' value used in calculations
oDlg:nDisplay := 0
***** A WIP Value
oDlg:nIntermediate := 0
***** Operation number e.g. for +,-,x,/
oDlg:nOperation := 0
***** Set the Symbol to 'Blank'
oDlg:nSymbol := BM_NIL_BLANK
***** Temporary value store
oDlg:nValueStore := 0
***** Left Bracket InActive
oDlg:lLBracketOpen := .F.
***** Right Bracket InActive
oDlg:lRBracketClosed := .T.
***** Show decimals
oDlg:oDecSet2:setCaption(Alltrim(Str(oDlg:nDecs))+" Places")
***** Clear the Main Display
oDlg:oDisplay:setCaption("0.")
***** Kill the symbol input / intermediate
oDlg:oOperText:setCaption( BM_NIL_BLANK )
***** Show the enabled BS key
oDlg:oPBbspace:setCaption( PB_BSPACE_ENA )
***** Kill the symbol before the Display
oDlg:oSymbol:setCaption( BM_NIL_BLANK )
***** Kill the accum value text
oDlg:oValAccum:setCaption("Result")
***** Kill the inter value text
oDlg:oValInput:setCaption("Value X")
***** Kill the input value text
oDlg:oValInter:setCaption("Value n")
***** Show Exchange Rate
oDlg:oXchgRate:setCaption(AllTrim(Str(oDlg:nConvertRate)))
***** Enable the number keys
Dis_EnableKeys(oDlg)
***** Standard L Bracket Button
oDlg:oPBLbracket:setCaption( PB_L_BRACKET )
***** Standard R Bracket Button
oDlg:oPBRbracket:setCaption( PB_R_BRACKET )
***** Enable the Enter Key
oDlg:oPBequals:setCaption( PB_EQUALS_ENA )
RETURN nil
*
* END FUNCTION ClearAll()
*****************************************************************************
*
*****************************************************************************
*
* FUNCTION PushVars()
*
* Saves the variables to allow re-establishment of conditions prior
* to an action such as a change in the number of decimals displayed.
*
* Note: This is a 'sawn-off' Array, it is used for more than one
* calculator. Only [1][n] applies to BusiCalc so it has been
* modified to do the task.
*****************************************************************************
*
FUNCTION PushVars(oDlg,lAdd)
IF ValType(lAdd)=="U"
lAdd:= .F.
ENDIF
IF lAdd
ARemove(oDlg:aDataStore,1,1)
aAdd(oDlg:aDataStore,{;
oDlg:aPos ,;
oDlg:aSize ,;
oDlg:cClipText ,;
oDlg:cDisplay ,;
oDlg:cXRate ,;
oDlg:lBS_Enabled ,;
oDlg:lHaveDecimal ,;
oDlg:lGettingDecsInput ,;
oDlg:lKeysEnabled ,;
oDlg:lKillKeys ,;
oDlg:lLastOpWasImmediate ,;
oDlg:lLBracketOpen ,;
oDlg:lNewCalculation ,;
oDlg:lNewInput ,;
oDlg:lRBracketClosed ,;
oDlg:nAccumStore ,;
oDlg:nAccumulator ,;
oDlg:nAction ,;
oDlg:nBMP ,;
oDlg:nDecs ,;
oDlg:nDisplay ,;
oDlg:nIntermediate ,;
oDlg:nMemVal ,;
oDlg:nOpCount ,;
oDlg:nOperation ,;
oDlg:nStoredOpNbr ,;
oDlg:nStoredValue ,;
oDlg:nSymbol ,;
oDlg:nValueStore ,;
oDlg:oOperText:Caption ,;
oDlg:oSymbol:Caption ,;
oDlg:oValAccum:Caption ,;
oDlg:oValInput:Caption ,;
oDlg:oValInter:Caption },1)
ELSE
oDlg:aDataStore[1]:={;
oDlg:aPos ,;
oDlg:aSize ,;
oDlg:cClipText ,;
oDlg:cDisplay ,;
oDlg:cXRate ,;
oDlg:lBS_Enabled ,;
oDlg:lHaveDecimal ,;
oDlg:lGettingDecsInput ,;
oDlg:lKeysEnabled ,;
oDlg:lKillKeys ,;
oDlg:lLastOpWasImmediate ,;
oDlg:lLBracketOpen ,;
oDlg:lNewCalculation ,;
oDlg:lNewInput ,;
oDlg:lRBracketClosed ,;
oDlg:nAccumStore ,;
oDlg:nAccumulator ,;
oDlg:nAction ,;
oDlg:nBMP ,;
oDlg:nDecs ,;
oDlg:nDisplay ,;
oDlg:nIntermediate ,;
oDlg:nMemVal ,;
oDlg:nOpCount ,;
oDlg:nOperation ,;
oDlg:nStoredOpNbr ,;
oDlg:nStoredValue ,;
oDlg:nSymbol ,;
oDlg:nValueStore ,;
oDlg:oOperText:Caption ,;
oDlg:oSymbol:Caption ,;
oDlg:oValAccum:Caption ,;
oDlg:oValInput:Caption ,;
oDlg:oValInter:Caption }
ENDIF
Return nil
*
* END FUNCTION PushVars()
*****************************************************************************
*
*****************************************************************************
*
* FUNCTION PopVars()
*
* Re-establishes the conditions pertaining prior to decimals set.
*
* Note: This is a 'sawn-off' Array, it is used for more than one
* calculator, only [1][n] applies to BusiCalc.
*****************************************************************************
*
FUNCTION PopVars(oDlg)
oDlg:aPos := oDlg:aDataStore[1][ 1]
oDlg:aSize := oDlg:aDataStore[1][ 2]
oDlg:cClipText := oDlg:aDataStore[1][ 3]
oDlg:cDisplay := oDlg:aDataStore[1][ 4]
oDlg:cXRate := oDlg:aDataStore[1][ 5]
oDlg:lBS_Enabled := oDlg:aDataStore[1][ 6]
oDlg:lHaveDecimal := oDlg:aDataStore[1][ 7]
oDlg:lGettingDecsInput := oDlg:aDataStore[1][ 8]
oDlg:lKeysEnabled := oDlg:aDataStore[1][ 9]
oDlg:lKillKeys := oDlg:aDataStore[1][10]
oDlg:lLastOpWasImmediate:= oDlg:aDataStore[1][11]
oDlg:lLBracketOpen := oDlg:aDataStore[1][12]
oDlg:lNewCalculation := oDlg:aDataStore[1][13]
oDlg:lNewInput := oDlg:aDataStore[1][14]
oDlg:lRBracketClosed := oDlg:aDataStore[1][15]
oDlg:nAccumStore := oDlg:aDataStore[1][16]
oDlg:nAccumulator := oDlg:aDataStore[1][17]
oDlg:nAction := oDlg:aDataStore[1][18]
oDlg:nBMP := oDlg:aDataStore[1][19]
IF !oDlg:lGettingDecsInput
oDlg:nDecs := oDlg:aDataStore[1][20]
ENDIF
oDlg:lGettingDecsInput := .F.
oDlg:nDisplay := oDlg:aDataStore[1][21]
oDlg:nIntermediate := oDlg:aDataStore[1][22]
oDlg:nMemVal := oDlg:aDataStore[1][23]
oDlg:nOpCount := oDlg:aDataStore[1][24]
oDlg:nOperation := oDlg:aDataStore[1][25]
oDlg:nStoredOpNbr := oDlg:aDataStore[1][26]
oDlg:nStoredValue := oDlg:aDataStore[1][27]
oDlg:nSymbol := oDlg:aDataStore[1][28]
oDlg:nValueStore := oDlg:aDataStore[1][29]
oDlg:oOperText:setCaption( oDlg:aDataStore[1][30])
oDlg:oSymbol:setCaption( oDlg:aDataStore[1][31])
oDlg:oValAccum:setCaption( oDlg:aDataStore[1][32])
oDlg:oValInput:setCaption( oDlg:aDataStore[1][33])
oDlg:oValInter:setCaption( oDlg:aDataStore[1][34])
If oDlg:nDisplay == 0
oDlg:cDisplay:= "0."
Else
oDlg:cDisplay := AllTrim(Str(Round(oDlg:nDisplay, oDlg:nDecs)))
oDlg:lKeysEnabled := .F.
Dis_EnableKeys(oDlg)
Endif
oDlg:oDisplay:setCaption( oDlg:cDisplay )
oDlg:oMemStore:setCaption( AllTrim(Str(Round(oDlg:nMemVal, oDlg:nDecs))))
oDlg:oDecSet2:setCaption( Alltrim(Str(oDlg:nDecs))+" Places") // Display
oDlg:oPBbspace:setCaption( PB_BSPACE_DIS )
oDlg:lBS_Enabled:= .F.
RETURN nil
*
* END FUNCTION PopVars()
*****************************************************************************
*****************************************************************************
* FUNCTION PollClipBoard( )
*****************************************************************************
*
FUNCTION PollClipBoard(oDlg)
LOCAL aFormats, nTextLen, j
LOCAL cValidChars := "-.0123456789+"
LOCAL cNbrText := ""
LOCAL lGotDecimal := .F.
****** Open clipboard and determine the data formats
****** contained in it.
oDlg:oClipBoard:open()
Do While .T.
aFormats := oDlg:oClipBoard:queryFormats()
***** If text is available in the clipboard, import the text
***** into a variable assuming that it is valid numeric text
IF AScan( aFormats, XBPCLPBRD_TEXT ) > 0
****** Excel conveniently <g> adds a CRLF to the value!!! hence StrTran()
*
oDlg:cClipText := ;
Alltrim(StrTran(oDlg:oClipBoard:getBuffer( XBPCLPBRD_TEXT ),CRLF," "))
If Empty(oDlg:cClipText)
oDlg:oClipBoard:close()
MyErrorMsg(-251,oDlg)
EXIT
Endif
nTextLen:=Len(oDlg:cClipText)
FOR j := 1 TO nTextLen
IF Asc(SubStr(oDlg:cClipText,j,1)) < 33 // Space or Control Char
cNbrText := "" // Kill it
j := nTextLen // Slßn leat! (Goodbye)
Else
IF SubStr(oDlg:cClipText,j,1) $ cValidChars
IF !(lGotDecimal .AND. SubStr(oDlg:cClipText,j,1) == ".")
IF !(SubStr(oDlg:cClipText,j,1) $ "+-" .AND. j>1)
cNbrText += SubStr(oDlg:cClipText,j,1)
IF SubStr(oDlg:cClipText,j,1) == '.'
lGotDecimal := .T.
Endif
ELSE
cNbrText := "" // Kill it
j := nTextLen // Slßn leat!
ENDIF
ELSE
cNbrText := "" // Kill it
j := nTextLen // Slßn leat!
ENDIF
ELSE
cNbrText := "" // Kill it
j := nTextLen // Slßn leat!
ENDIF
ENDIF
Next j
If Empty( cNbrText )
MyErrorMsg(-252,oDlg)
EXIT
Endif
ENDIF
EXIT
ENDDO
oDlg:oClipBoard:close()
RETURN (cNbrText)
*
* END FUNCTION PollClipBoard( )
*****************************************************************************
*
*****************************************************************************
*
* FUNCTION Dis_EnableKeys()
*
* Pseudo Enables / Disables number keys
*
* Not a real disable/enable just flags to ignore a keypress
*****************************************************************************
*
FUNCTION Dis_EnableKeys(oDlg)
If !(oDlg:lKeysEnabled)
oDlg:oPB_0:setCaption( PB__0_DIS )
oDlg:oPB_1:setCaption( PB__1_DIS )
oDlg:oPB_2:setCaption( PB__2_DIS )
oDlg:oPB_3:setCaption( PB__3_DIS )
oDlg:oPB_4:setCaption( PB__4_DIS )
oDlg:oPB_5:setCaption( PB__5_DIS )
oDlg:oPB_6:setCaption( PB__6_DIS )
oDlg:oPB_7:setCaption( PB__7_DIS )
oDlg:oPB_8:setCaption( PB__8_DIS )
oDlg:oPB_9:setCaption( PB__9_DIS )
oDlg:oPBPoint:setCaption( PB_POINT_DIS )
ELSE
oDlg:oPB_0:setCaption( PB__0_ENA )
oDlg:oPB_1:setCaption( PB__1_ENA )
oDlg:oPB_2:setCaption( PB__2_ENA )
oDlg:oPB_3:setCaption( PB__3_ENA )
oDlg:oPB_4:setCaption( PB__4_ENA )
oDlg:oPB_5:setCaption( PB__5_ENA )
oDlg:oPB_6:setCaption( PB__6_ENA )
oDlg:oPB_7:setCaption( PB__7_ENA )
oDlg:oPB_8:setCaption( PB__8_ENA )
oDlg:oPB_9:setCaption( PB__9_ENA )
oDlg:oPBPoint:setCaption( PB_POINT_ENA )
ENDIF
RETURN nil
*
* END FUNCTION Dis_EnableKeys()
*****************************************************************************
*
*****************************************************************************
* FUNCTION Info()
*
* WARNING: This Modal window is used by multiple functions, Help, About,
* messages etc. I did it like that for convenience rather than
* duplicate code by having multiple Modals.
*
* DO NOT use Info() recursively. That is, if you have called
* Info() for anything, DO NOT call it again for a second task
* until it has returned from the first call.
*
* Why? You will have two instances of the Modal window open
* and only one will close on return....
*
* You could modify the code to make them all close but I just
* followed my own advice and didn't bother! <g>
*
*****************************************************************************
*
FUNCTION Info( cSubTitle, aSize, oDlg)
STATIC oInfoKeys
LOCAL nEvent, mp1, mp2, oXbp, lExit, oExit,oDa,aPos
LOCAL oMod, oFocus, oTitleStat, oNext, oPrev, aRates,oPE,oDE,oDP,oSave
oFocus:= setAppFocus()
aPos:= oDlg:currentPos()
aRates:= {}
***** Create Modal dialog window with different parent and owner windows
*
oMod := XbpDialog():new( AppDesktop(), SetAppWindow(), aPos, aSize )
oMod:drawingArea:ColorBG:= GRA_CLR_DARKBLUE
oMod:moveWithOwner := .T.
oMod:titleBar := .F.
oMod:sysmenu := .F.
oMod:alwaysontop := .T.
oMod:border := XBPDLG_NO_BORDER
oMod:minButton := .F.
oMod:maxButton := .F.
oMod:maxsize := aSize
oMod:drawingArea:bitmap := BUSICALC_HA //
oMod:Close := {|| lExit := .T. }
oMod:create()
oDa:= oMod:drawingArea
oDa:setFontCompoundName( "8.Arial" )
oDa:setColorBG( XBPSYSCLR_TRANSPARENT)
oMod:setModalState( XBP_DISP_APPMODAL)
oTitleStat:= ;
XbpStatic():new( oDa, ,{aSize[1]-65, aSize[2]-35}, { 50, 16}, { ;
{ XBP_PP_BGCLR, GRA_CLR_DARKBLUE }, ;
{ XBP_PP_FGCLR, GRA_CLR_YELLOW }, ;
{ XBP_PP_COMPOUNDNAME, "10.Arial Bold" } } )
oTitleStat:caption := cSubTitle
oTitleStat:clipSiblings := .T.
oTitleStat:options := XBPSTATIC_TEXT_VCENTER+XBPSTATIC_TEXT_CENTER
oTitleStat:Create()
oInfoKeys:= XbpStatic():new( oDa, ,{20,20}, {2,2}, { ;
{ XBP_PP_BGCLR, GRA_CLR_DARKBLUE }, ;
{ XBP_PP_FGCLR, GRA_CLR_PALEGRAY }, ;
{ XBP_PP_COMPOUNDNAME, "8.Arial" } } )
oInfoKeys:caption := ""
oInfoKeys:clipSiblings:= .T.
oInfoKeys:Create()
oInfoKeys:keyBoard := ;
{|nKey| MsgKeys(nKey,oDa,@lExit,oInfoKeys,oDlg,oPrev,oNext,@aRates,@oPE,@oDE,@oDP)}
***** Set focus to the Modal KeyHandler InfoKeys
oMod:setDisplayFocus := {|| setAppFocus(oInfoKeys)}
oExit := XbpPushbutton():new( oDa, , {140,14}, {40,18} )
oExit:caption := PB_CLOSE_1E // 1= ~C E= enabled
oExit:activate := {|| postAppEvent(xbeP_Keyboard,Asc("C"),,oInfoKeys) }
oExit:TabStop := .T.
oExit:create()
IF "ABOUT"$Upper(cSubTitle)
postAppEvent(xbeP_Keyboard,252,,oInfoKeys) // 252 don't want user key!
ELSEIF "ERROR"$Upper(cSubTitle)
postAppEvent(xbeP_Keyboard,253,,oInfoKeys) // 253 No user key!
ELSEIF "HELP"$Upper(cSubTitle)
oNext := XbpPushbutton():new( oDa, , {180,14}, {40,18} )
oNext:caption := PB_NEXT_0E
oNext:activate := {|| postAppEvent(xbeP_Keyboard,xbeK_UP,,oInfoKeys) }
oNext:TabStop := .T.
oNext:create()
oPrev := XbpPushbutton():new( oDa, , {100,14}, {40,18} )
oPrev:caption := PB_PREV_0E
oPrev:activate := {|| postAppEvent(xbeP_Keyboard,xbeK_DOWN ,,oInfoKeys) }
oPrev:TabStop := .T.
oPrev:create()
postAppEvent(xbeP_Keyboard,254,,oInfoKeys) // 254 No user key!
oPrev:hide()
oNext:hide()
ELSE
***** Rates
***** All Records are length 10
aAdd(aRates,Str(oDlg:nPE,10,6))
aAdd(aRates,Str(oDlg:nDE,10,6))
aAdd(aRates,Str(oDlg:nDP,10,6))
aAdd(aRates,oDlg:cXRate+Space(8))
oExit:hide()
oSave := XbpPushbutton():new( oDa, , {140,14}, {40,18} )
oSave:caption := PB_SAVE_1E
oSave:activate := {|| postAppEvent(xbeP_Keyboard,Asc("S"),,oInfoKeys) }
oSave:TabStop := .T. // Need to discard the 'S' unless it is Rate Change.
oSave:create()
postAppEvent(xbeP_Keyboard,251,,oInfoKeys) // 251 No user key! Get Rates
ENDIF
SetAppWindow(oMod)
oMod:show()
lExit := .F.
DO WHILE ! lExit
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
oMod:setModalState( XBP_DISP_MODELESS )
oMod:destroy()
SetAppFocus( oFocus )
RETURN aRates
* END FUNCTION Info()
*****************************************************************************
*
*****************************************************************************
* FUNCTION MsgKeys()
*****************************************************************************
*
***** Declare them once, use many times...
STATIC FUNCTION MsgKeys(nKey,oDa,lExit,oInfoKeys,oDlg,oPrev,oNext,aRates,oPE,oDE,oDP)
STATIC aBmps:={}
STATIC aData:={}
STATIC oBmp01,oBmp02,oBmp03,oBmp04,oBmp05,oBmp06,oBmp07,oBmp08
STATIC oBmp09,oBmp10,oBmp11,oBmp12,oBmp13,oBmp14,oBmp15,oBmp16
STATIC i
Do While .T.
IF nKey == 67 .OR. nKey == 99 .OR. nKey == xbeK_ESC //C... ~Close
lExit := .T.
EXIT
***** We don't want the user to be able to interfere with these three
***** keys used for routing purposes so they are 'safe' key values <g>.
*
ELSEIF nKey == 251 //.. Get Rates
RatesUpdate(oDa,oDlg,@aRates,@oPE,@oDE,@oDP)
ELSEIF nKey == 252 //.. About
ShowAbout(oDa,oDlg)
ELSEIF nKey == 253 //.. Error
ShowError(oDa,oDlg)
ELSEIF nKey == 254 //.. Help
***** Always page 1
oDlg:nPage := 1
***** Create three statics for Help - Top line, Text Body, Left Margin
***** oDlg:oTopLine, oDlg:oGenText, oDlg:oBmpBar
InfoStats(oDa,"H",oDlg)
***** oDlg:aHelp format: {{"top"},{"text;;"},{{nY,nBmp1},{nY,nBmp2},{...}}}
***** nY is the line number, nBmp is a Bitmap ID (Operator or Line No.)
***** Extract the Top Line
oDlg:oTopLine:setcaption(oDlg:aHelp[oDlg:nPage][1][1])
***** Extract the Text Body
oDlg:oGenText:setcaption(StrTran(oDlg:aHelp[oDlg:nPage][2][1],";",CRLF))
***** Create 16 statics oBmp01 thro oBmp16
***** and place them on the BmpBar (Left margin)
***** These will hold the line numbers or operator Bitmaps
***** They will always be referred to indirectly.
***** e.g. aBmp[9] = oBmp09, so they never see the light of day
***** and a compiler warning will say they are not used, not so.
***** Clear the decks...
ARemove(aBmps,1,Len(aBmps))
FOR i:= 1 to 16
aAdd(aBmps,{"oBmp"+StrZero(i,2)})
aBmps[i] := XbpStatic():new(oDlg:oBmpBar,,{5,238-(i*15)},{22,16})
aBmps[i]:type := XBPSTATIC_TYPE_BITMAP
aBmps[i]:caption := WHITE_BLANK
aBmps[i]:create()
NEXT i
**** Instead of using a function to 'paint' the bitmaps we use
**** an ElseIf in the keyhandler...
nKey:= 255
postAppEvent(xbeP_Keyboard,255,,oInfoKeys) // Dummy - paint Bitmaps
EXIT
ELSEIF nKey == 80 .OR. nKey == 112 .OR. ;
nKey == xbeK_DOWN .OR. nKey == xbeK_LEFT //P... Previous
If oDlg:nPage == 1
Exit
Endif
**** Clear the margin Bmps
FOR i:= 1 to 16
aBmps[i]:setCaption( WHITE_BLANK )
NEXT i
oDlg:nPage--
***** Extract the Top Line
oDlg:oTopLine:setcaption(oDlg:aHelp[oDlg:nPage][1][1])
***** Extract the Text Body
oDlg:oGenText:setcaption(StrTran(oDlg:aHelp[oDlg:nPage][2][1],";",CRLF))
nKey:= 255
postAppEvent(xbeP_Keyboard,255,,oInfoKeys) // Dummy - paint Bitmaps
EXIT
ELSEIF nKey == 78 .OR. nKey == 110 .OR. ;
nKey == xbeK_UP .OR. nKey == xbeK_RIGHT //N... Next
If oDlg:nPage == Len(oDlg:aHelp)
Exit
Endif
**** Clear the margin Bmps
FOR i:= 1 to 16
aBmps[i]:setCaption( WHITE_BLANK )
NEXT i
oDlg:nPage++
***** Extract the Top Line
oDlg:oTopLine:setcaption(oDlg:aHelp[oDlg:nPage][1][1])
***** Extract the Text Body
oDlg:oGenText:setcaption(StrTran(oDlg:aHelp[oDlg:nPage][2][1],";",CRLF))
nKey:= 255
postAppEvent(xbeP_Keyboard,255,,oInfoKeys) // Dummy - paint Bitmaps
EXIT
ELSEIF nKey == 255 // Dummy - paint Bitmaps
***** Get the bitmaps, if any, to be displayed
aData:= oDlg:aHelp[oDlg:nPage][3]
IF !(Empty(aData))
FOR i:= 1 to Len(aData)
***** {Line number , Bitmap}
aBmps[aData[i][1]]:setCaption(aData[i][2])
NEXT i
ENDIF
IIF(oDlg:nPage == 1, oPrev:hide(), oPrev:show())
IIF(oDlg:nPage == Len(oDlg:aHelp), oNext:hide(), oNext:show())
ELSEIF UPPER(Chr(nKey)) == "S" //.. Save rates
***** TRAP INVALID 'S' KEYSTRIKE (in Help,About etc)
IF !(oDlg:cTopText== "Exchange Rates Update")
EXIT
ENDIF
***** Str(Val()) used as quick reformat
aRates[1] := Str( Val( oPE:getData() ) ,10,6)
aRates[2] := Str( Val( oDE:getData() ) ,10,6)
aRates[3] := Str( Val( oDP:getData() ) ,10,6)
aRates[4] := oDlg:cXRate+Space(8)
lExit := .T. // Close
ENDIF
EXIT
ENDDO
***** Set focus to keyhandler
setAppFocus(oInfoKeys)
RETURN nil
* END FUNCTION MsgKeys()
*****************************************************************************
*
*****************************************************************************
* FUNCTION ShowAbout()
*****************************************************************************
*
FUNCTION ShowAbout(oDa,oDlg)
oDlg:cTopText:=;
"Greg J Doran;"+;
"MIS Software;"+;
"Raheny, Dublin 5, Ireland.;"+;
"gdo@eircom.net"
oDlg:cGenText:=;
"Copyright (c) Gregory J Doran 2001-2002;"+;
"BusiCalc is one of a series of calculators "+;
"written entirely in Alaska Xbase++ (c);"+;
";"+;
"The code used in the design of BusiCalc is released under "+;
"the GNU General Public Licence and is governed by the "+;
"conditions and protocols setout therein. See Phil Ide's Xbase++ FAQs ;"+;
"http://www.idep.org.uk/xbase/xbfaq/xbfaq.htm"
InfoStats(oDa,"A",oDlg)
oDlg:oTopLine:setcaption(StrTran(oDlg:cTopText,";",CRLF))
oDlg:oGenText:setcaption(StrTran(oDlg:cGenText,";",CRLF))
RETURN nil
* END FUNCTION ShowAbout()
*****************************************************************************
*
*****************************************************************************
* FUNCTION ShowError()
*****************************************************************************
FUNCTION ShowError(oDa,oDlg )
InfoStats(oDa,"M",oDlg)
oDlg:oTopLine:setcaption(StrTran(oDlg:cTopText,";",CRLF))
oDlg:oGenText:setcaption(StrTran(oDlg:cGenText,";",CRLF))
RETURN nil
* END FUNCTION ShowError()
*****************************************************************************
*
*****************************************************************************
* FUNCTION RatesUpdate()
*****************************************************************************
FUNCTION RatesUpdate(oDa,oDlg, aRates,oPE,oDE,oDP )
LOCAL oXbp
oDlg:cTopText:=;
"Exchange Rates Update"
oDlg:cGenText:=;
"Modify the Exchange Rates and press &Save when completed.;"+;
";"+;
"6 Decimal places of accuracy recommended."
***** Borrow Message Stats.
InfoStats(oDa,"M",oDlg)
oDlg:oTopLine:setcaption(StrTran(oDlg:cTopText,";",CRLF))
oDlg:oGenText:setcaption(StrTran(oDlg:cGenText,";",CRLF))
oXbp := XbpStatic():new( oDlg:oGenText, , {10,84}, {120,20} )
oXbp:caption := "Pounds = 1 Euro:"
oXbp:options := XBPSTATIC_TEXT_LEFT
oXbp:create()
oXbp := XbpStatic():new( oDlg:oGenText, , {10,52}, {120,20} )
oXbp:caption := "Dollars = 1 Euro:"
oXbp:options := XBPSTATIC_TEXT_LEFT
oXbp:create()
oXbp := XbpStatic():new( oDlg:oGenText, , {10,20}, {120,20} )
oXbp:caption := "Dollars = 1 Pound:"
oXbp:options := XBPSTATIC_TEXT_LEFT
oXbp:create()
oPE := XbpSLE():new( oDlg:oGenText, , {145,86}, {60,20} )
oPE:tabStop := .T.
oPE:bufferLength := 10
oPE:create()
oPE:Setdata(aRates[1])
oDE := XbpSLE():new( oDlg:oGenText, , {145,54}, {60,20} )
oDE:tabStop := .T.
oDE:bufferLength := 10
oDE:create()
oDE:Setdata(aRates[2])
oDP := XbpSLE():new( oDlg:oGenText, , {145,22}, {60,20} )
oDP:tabStop := .T.
oDP:bufferLength := 10
oDP:create()
oDP:Setdata(aRates[3])
RETURN nil
* END FUNCTION RatesUpdate()
*****************************************************************************
*
*****************************************************************************
* FUNCTION InfoStats()
*****************************************************************************
FUNCTION InfoStats(oDa,cMode,oDlg)
LOCAL aColor:= {GRA_CLR_BLACK,;
XBPSYSCLR_DIALOGBACKGROUND}
IF cMode== "H"
oDlg:oBmpBar := XbpStatic():new( oDa,, {40,40},{30,265},;
{{ XBP_PP_FGCLR, GRA_CLR_DARKRED} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} })
oDlg:oBmpBar:type := XBPSTATIC_TYPE_TEXT
oDlg:oBmpBar:caption := ""
oDlg:oTopLine := XbpStatic():new( oDa,, {40,281},{250,24},;
{{ XBP_PP_FGCLR, GRA_CLR_BLUE} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} ,;
{ XBP_PP_COMPOUNDNAME, "12.Times New Roman Bold"}} )
oDlg:oTopLine:options := XBPSTATIC_TEXT_CENTER+XBPSTATIC_TEXT_VCENTER
oDlg:oTopLine:caption := "TITLE"
oDlg:oTopLine:type := XBPSTATIC_TYPE_TEXT
oDlg:oGenText := XbpStatic():new( oDa,, {70,37},{220,243},;
{{ XBP_PP_FGCLR, GRA_CLR_BLACK} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} ,;
{ XBP_PP_COMPOUNDNAME, "10.Times New Roman"}} )
oDlg:oGenText:options := XBPSTATIC_TEXT_VCENTER+;
XBPSTATIC_TEXT_WORDBREAK+;
XBPSTATIC_TEXT_LEFT
oDlg:oGenText:caption := "Help Text"
oDlg:oGenText:type := XBPSTATIC_TYPE_TEXT
ELSEIF cMode== "A" // About
oDlg:oBmpBar := XbpStatic():new( oDa,, {133,252},{50,50},;
{{ XBP_PP_FGCLR, aColor[1]} ,;
{ XBP_PP_BGCLR, aColor[2]} })
oDlg:oBmpBar:type := XBPSTATIC_TYPE_BITMAP
oDlg:oBmpBar:caption := GJDLOGO
oDlg:oTopLine := XbpStatic():new( oDa,, {40,183},{235,65},;
{{ XBP_PP_FGCLR, GRA_CLR_BLUE} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} ,;
{ XBP_PP_COMPOUNDNAME, "10.Arial Bold"}} )
oDlg:oTopLine:options := XBPSTATIC_TEXT_VCENTER+;
XBPSTATIC_TEXT_WORDBREAK+;
XBPSTATIC_TEXT_CENTER
oDlg:oTopLine:caption := "TITLE"
oDlg:oTopLine:type := XBPSTATIC_TYPE_TEXT
oDlg:oGenText := XbpStatic():new( oDa,, {55,40},{235,137},;
{{ XBP_PP_FGCLR, GRA_CLR_BLACK} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} ,;
{ XBP_PP_COMPOUNDNAME, "10.Times New Roman"}} )
oDlg:oGenText:options := XBPSTATIC_TEXT_VCENTER+;
XBPSTATIC_TEXT_WORDBREAK+;
XBPSTATIC_TEXT_LEFT
oDlg:oGenText:caption := "About Blurp"
oDlg:oGenText:type := XBPSTATIC_TYPE_TEXT
ELSE // Message
oDlg:oBmpBar := XbpStatic():new( oDa,, {142,261},{32,32},;
{{ XBP_PP_FGCLR, GRA_CLR_BLACK} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} })
oDlg:oBmpBar:type := XBPSTATIC_TYPE_ICON
oDlg:oBmpBar:caption := ;
IIF(!(oDlg:cTopText=="Exchange Rates Update"),EXCLAIM,EURO)
oDlg:oTopLine := XbpStatic():new( oDa,, {40,183},{235,65},;
{{ XBP_PP_FGCLR, GRA_CLR_RED} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} ,;
{ XBP_PP_COMPOUNDNAME, "10.Times New Roman Bold"}} )
oDlg:oTopLine:options := XBPSTATIC_TEXT_VCENTER+;
XBPSTATIC_TEXT_WORDBREAK+;
XBPSTATIC_TEXT_CENTER
oDlg:oTopLine:caption := "TITLE"
oDlg:oTopLine:type := XBPSTATIC_TYPE_TEXT
oDlg:oGenText := XbpStatic():new( oDa,, {55,40},{235,170},;
{{ XBP_PP_FGCLR, GRA_CLR_BLACK} ,;
{ XBP_PP_BGCLR, GRA_CLR_WHITE} ,;
{ XBP_PP_COMPOUNDNAME, "9.Times New Roman"}} )
oDlg:oGenText:options := XBPSTATIC_TEXT_VCENTER+;
XBPSTATIC_TEXT_WORDBREAK+;
XBPSTATIC_TEXT_LEFT
oDlg:oGenText:caption := "Message"
oDlg:oGenText:type := XBPSTATIC_TYPE_TEXT
ENDIF
oDlg:oBmpBar:create()
oDlg:oTopLine:create()
oDlg:oGenText:create()
RETURN nil
* END FUNCTION InfoStats()
*****************************************************************************
*
*****************************************************************************
* FUNCTION MoveWin()
*****************************************************************************
*
FUNCTION MoveWin(aPMot,aLBDownAtPos, oDlg)
***** Get Mouse Movement differentials
*
LOCAL nPx := (aPMot[1]-aLBDownAtPos[1]) * 2 // magnify x2
LOCAL nPy := (aPMot[2]-aLBDownAtPos[2]) * (-2) // magnify x2 and
// Negate, this is WinAPI
// not upside-down pixels
***** AppDeskTop boundaries for window move, Bot,Rt
*
LOCAL nB := AppDeskTop():currentSize()[2]-oDlg:aSize[2]
LOCAL nR := AppDeskTop():currentSize()[1]-oDlg:aSize[1]
***** Only process if there is a difference
*
If Abs(nPx) > 0 .OR. Abs(nPy) > 0
***** Add cursor movement differentials
*
oDlg:aPos[1]+= nPx
oDlg:aPos[2]+= nPy
***** Check Boundaries - Nothing to go off-screen
*
oDlg:aPos[1]:=INT(IIF(oDlg:aPos[1]< 0, 0, oDlg:aPos[1])) // Left check
oDlg:aPos[1]:=INT(IIF(oDlg:aPos[1]>nR,nR, oDlg:aPos[1])) // Right check
oDlg:aPos[2]:=INT(IIF(oDlg:aPos[2]< 0, 0, oDlg:aPos[2])) // Top Check
oDlg:aPos[2]:=INT(IIF(oDlg:aPos[2]>nB,nB, oDlg:aPos[2])) // Bottom Check
setAppFocus(oDlg)
***** Free the cursor
*
TrapCursor(oDlg:drawingArea,.F.)
****** WinApi Move function
*
MoveWindow(oDlg:getHWND(),oDlg:aPos[1],oDlg:aPos[2],;
oDlg:aSize[1],oDlg:aSize[2],1)
****** Restore the cursor to the original location
*
SetCursorPos( oDlg:aPos[1]+aLBDownAtPos[1],;
oDlg:aSize[2]+oDlg:aPos[2]-aLBDownAtPos[2])
***** Entrap the cursor
*
TrapCursor(oDlg:drawingArea,.T.)
ENDIF
Return nil
* END FUNCTION MoveWin
*****************************************************************************
*****************************************************************************
*
* FUNCTION TrapCursor()
*
*****************************************************************************
*
FUNCTION TrapCursor(o,lTrap)
LOCAL cBuffer := Space(16) // cBuffer == a4LTRB_lpRect:= {nL,nT,nR,nB}
***** Entrap the cursor in the titlebar region?
IF lTrap
***** get the absolute position of oDlg:drawing area (relative to DeskTop)
*
DllCall("User32.DLL", DLL_STDCALL,"GetWindowRect", o:GetHwnd(), @cBuffer)
***** Remove the area covered by oDlg:Mask (adjusting bottom value)
*
cBuffer:= substr(cBuffer, 1, 12)+U2Bin(Bin2U(substr(cBuffer, 13, 4))-304)
***** Entrap the cursor in this rectangle.
*
DllCall("User32.DLL", DLL_STDCALL, "ClipCursor", cBuffer)
ELSE
***** Set the cursor free to roam.
*
DllCall("User32.DLL", DLL_STDCALL, "ClipCursor", 0)
ENDIF
RETURN nil
* FUNCTION TrapCursor()
*****************************************************************************
*
*****************************************************************************
* FUNCTION ShowItsOpen()
*****************************************************************************
*
FUNCTION ShowItsOpen(hwnd)
***** THE WINDOW IS 'MINIMISED'!!!
***** CREATE A GHOST WINDOW
***** MOVE IT AS AN INDICATOR THEN DESTROY IT
LOCAL oDlg, i
LOCAL aPP := {}
LOCAL aPos := {nil,nil}
LOCAL aSize := {318, 348} // Dialog
aPos[1] := (SetAppWindow():currentSize()[1] - aSize[1]) / 2
aPos[2] := (SetAppWindow():currentSize()[2] - aSize[2]) / 2
AAdd ( aPP, { XBP_PP_BGCLR, GRA_CLR_DARKBLUE } )
AAdd ( aPP, { XBP_PP_FGCLR, GRA_CLR_PALEGRAY } )
AAdd ( aPP, { XBP_PP_COMPOUNDNAME, "8.Arial" } )
oDlg:= BusiCalc():New( AppDesktop(),, aPos,aSize,aPP, .F.)
oDlg:border := XBPDLG_NO_BORDER
oDlg:titleBar := .F.
oDlg:sysmenu := .F.
oDlg:alwaysontop := .T.
oDlg:title := "BusiCalc Ghost"
oDlg:maxsize := aSize
oDlg:drawingArea:bitmap := BUSICALC
oDlg:Create()
SetAppWindow(oDlg)
SetAppFocus( oDlg)
oDlg:show()
***** Now move it towards the minimised App ( [ BusiCalc ][X] ) at
***** the top of the screen and reduce its size as we go.
For i:= 1 to 5
aPos[1]:= aPos[1]*(1/i)
aPos[2]:= aPos[2]*(1/i)
aSize[1]:= aSize[1]*0.5
aSize[2]:= aSize[2]*0.5
oDlg:configure( , ,{AppDesktop():CurrentSize()[1]-(200+aPos[1]),;
AppDesktop():CurrentSize()[2]-(18+aPos[2])} , {aSize[1],aSize[2]})
Sleep(5) // Flicker....
NEXT
oDlg:destroy()
Sleep(100*70)
***** This is not needed, unless a 'real' minimise is used.
***** If so, the above code would not be used, only this.
SetForegroundWindow( hwnd ) // Not needed unless there are
BringWindowToTop( hwnd ) // two windows in competition
ShowWindow(hwnd,SW_SHOW_NORMAL) // for the 'top' spot
UpdateWindow( hwnd ) // Or a 'real' minimise is used
Sleep(100*20)
PostAppevent(xbeM_Motion)
RETURN nil
* END FUNCTION ShowItsOpen()
*****************************************************************************
*
*****************************************************************************
* FUNCTION MyErrorHandler()
*****************************************************************************
*
FUNCTION MyErrorHandler(oError,oDlg)
***** Do not use Xbase++ handler for Divide errors, handle locally.
***** Zero is returned and recovery is difficult
***** Most errors are determined locally in code and error messages displayed.
*
IF oError:gencode == XPP_ERR_NUMOVERFLOW
***** Fatal Error, issue message and go straight down the stank!.
MyErrorMsg(XPP_ERR_NUMOVERFLOW,oDlg)
oDlg:Destroy()
ERRORLEVEL(1)
CANCEL
ELSE
MyErrorMsg(oError:gencode,oDlg,oError:oscode)
ENDIF
RETURN nil
* END FUNCTION MyErrorHandler()
*****************************************************************************
*
*****************************************************************************
* FUNCTION MyErrorMsg()
*****************************************************************************
*
FUNCTION MyErrorMsg(nError,oDlg,nAlt)
IF Valtype(nAlt)=="U"
nAlt:= -999 // Just in case there is none.
ENDIF
IF nError == XPP_ERR_ZERODIV
oDlg:cTopText := "ERROR: Divide by Zero"
oDlg:cGenText :=;
"You have attempted to divide by Zero!;" +;
";"+;
"The divide operation has been halted...;" +;
";"+;
"This is a recoverable error, you may continue the calculation.;" +;
";"+;
"Input a non-zero divisor and continue, or press Clear All [CA] to abort."
ELSEIF nError == XPP_ERR_NUMOVERFLOW
oDlg:cTopText := "ERROR: Numeric Overflow"
oDlg:cGenText :=;
"The value resulting from your last calculation is in excess of "+;
"the largest value capable of being processed by this calculator "+;
"and has caused a numeric overflow.;"+;
";"+;
"This is a Fatal Error, recovery is not possible...;"+;
";"+;
"The Calculator will now Close."
ELSEIF nError == XPP_ERR_NUMERR //Sic "Number Error"
oDlg:cTopText := "ERROR: Percent - Divide by Zero"
oDlg:cGenText :=;
"You have attempted to divide by Zero in a Percent operation.;" +;
";"+;
"The divide operation has been halted...;" +;
";"+;
"This is a recoverable error, you may continue the calculation.;" +;
";"+;
"Input a non-zero divisor and continue, or press Clear All [CA] to abort."
ELSEIF nError == (-255)
oDlg:cTopText := "ERROR: Number Base - nth. Root"
oDlg:cGenText :=;
"You have entered a negative number base.;"+;
";"+;
"BusiCalc cannot resolve a Root for a number with a negative base.;"+;
";"+;
" "+Alltrim(Str(oDlg:nIntermediate))+" ^ (1/"+oDlg:cDisplay+")"
ELSEIF nError == (-254)
oDlg:cTopText := "ERROR: Sqrt(Negative Number)"
oDlg:cGenText :=;
"You have entered a negative number base.;"+;
";"+;
"This request would result in complex number roots which "+;
"BusiCalc cannot resolve.;"+;
";"+;
"TechiCalc will perform this operation.;"+;
";"+;
" Sqrt( "+oDlg:cDisplay+" )."
ELSEIF nError == (-253)
oDlg:cTopText := "ERROR: Number resolution."
oDlg:cGenText :=;
"You have entered a number which is either invalid or "+;
"outside the range defined for BusiCalc operations. "+;
"Factorial: n= "+oDlg:cDisplay+";"+;
";"+;
"The number must be positive and within the range 1 - 21 "+;
"inclusive.;"+;
";"+;
"Decimal numbers will be reduced to Integer status."
ELSEIF nError == (-252)
oDlg:cClipText:=StrTran(oDlg:cClipText,';',' ')
***** (Otherwise we get CRLFs in display)
oDlg:cTopText := "ERROR: ClipBoard Junk."
oDlg:cGenText :=;
"There is something on the clipboard but, it is not a valid number:-;"+;
";"+;
IIF(Len(oDlg:cClipText)>100,Left(oDlg:cClipText,100),oDlg:cClipText)+";"+;
";"+;
"(Any carriage returns have been stripped out of the above text"+;
IIF(Len(oDlg:cClipText)>100," and it was truncated at 100 characters.)",".)")
ELSEIF nError == (-251)
oDlg:cTopText := "ClipBoard Status."
oDlg:cGenText :=;
"The clipboard is empty....;"+;
";"+;
"There is nothing to Import...."
ELSEIF nError == (-250)
oDlg:cTopText := "Decimal Places Change."
oDlg:cGenText :=;
"Please complete the current operation within brackets first. ;"+;
";"+;
"Making a change later will not affect the accuracy of your calculations."
ELSEIF nError == (-249)
oDlg:cTopText := "Exchange Rate Disparity."
oDlg:cGenText :=;
"Warning!;"+;
"A validation check on the exchange "+;
"rates indicates an inter-rate ;"+;
";"+;
"conversion error of: "+Alltrim(Str(nAlt,12,6))+"%;"+;
";"+;
"You may proceed in this knowledge "+;
"or enter the correct exchange rates."
ELSEIF nError == (-248)
oDlg:cTopText := "Exchange Rate Update."
oDlg:cGenText :=;
"Please complete the current calculation first. ;"+;
";"+;
"Making a currency change at this juncture cannot be accomodated."
ELSEIF nError == (-247)
oDlg:cTopText := "Exchange Rate Substitution"
oDlg:cGenText :=;
"The Exchange Rates file 'BusiCalc.xch' was "+;
IIF(nAlt==1,"not found and has been created.",;
IIF(nAlt==2,"not accessible. You cannot save Rates to this file.",;
"unreadable or is 'Read Only'. You cannot save Rates to this file."))+;
";"+;
";"+;
"Temporary Exchange Rates have been installed as of 30.Sep.2002.;"+;
";"+;
"It is essential that you check these rates and make adjustments "+;
"as necessary. "+;
IIF(nAlt==2 .OR. nAlt==3,;
"Check out why there is a problem with the Rates File.;","")+;
"Exchange Rates: http://www.xe.net/ucc/"
ELSEIF nError == (-246)
oDlg:cTopText := "Exchange Rate File Problem"
oDlg:cGenText :=;
"There is a problem with the Exchange Rates file 'BusiCalc.xch'.;"+;
";"+;
"When trying to save the Conversion Mode, or current Exchange Rates "+;
"to the file, the file could not be "+;
IIF(nAlt==1,"opened!.",;
IIF(nAlt==2,"created!.",;
IIF(nAlt==3,"found!.",;
IIF(nAlt==4,"written to!.",;
IIF(nAlt==5,"closed!.",;
"written to or closed!.")))))+;
";;"+;
"Your data has not been saved. If you just changed the conversion "+;
"mode, try: press 'x' (or click 'Set Rate') and press 's' (or click 'Save')."
ELSE
oDlg:cTopText := "ERROR: Code Gen "+Alltrim(Str(nError))+;
IIF(nAlt==-999,""," OS "+Alltrim(Str(nAlt)))
oDlg:cGenText :=;
"An error has occurred which is not documented in BusiCalc.;" +;
";"+;
"The status of the calculator is indeterminate...;" +;
";"+;
"It is recommended that you close the calculator and start again or "+;
"at least press Clear All [CA]."
ENDIF
Info( "Error", oDlg:aCalcSize, oDlg)
RETURN nil
* END FUNCTION MyErrorMsg()
*****************************************************************************
*
*****************************************************************************
* FUNCTION MakeHelp()
*****************************************************************************
*
FUNCTION MakeHelp(oDlg)
aAdd(oDlg:aHelp,{{"Contents"},{;
"General information.;"+;
"Notes and Display Limits;"+;
"Number Keys Disable.;"+;
"Mouse and Keyboard Action;"+;
"The Keyboard Keys;"+;
"The Keyboard Keys (continued);"+;
"Reciprocal, Negate, Factorial, Square;"+;
"and Square Root;"+;
"nth. Power, nth. Root, Percent;"+;
"Bracketed Operations;"+;
"Currency Operations;"+;
"Switching Currency;"+;
"Set Decimal Places;"+;
"Set Exchange Rates;"+;
"Import and Export Values;"+;
"Move - Minimise - Busicalc. Adenda."},{;
{ 1,NO_2},{ 2,NO_3},{ 3,NO_4},{ 5,NO_5},;
{ 6,NO_6},{ 7,NO_7},{ 9,NO_8},{10,NO_9},;
{11,NO_10},{12,NO_11},{13,NO_12},{14,NO_13},;
{15,NO_14},{16,NO_15}}})
aAdd(oDlg:aHelp,{{"General Information"},;
{"It is important to note that this help file will not teach "+;
"you how to use a calculator. It is assumed that you have a "+;
"basic understanding of the principles involved.;"+;
";"+;
"The help file will detail the aspects of BusiCalc which are "+;
"less frequently encountered and how those particular functions "+;
"can be used.;"+;
";"+;
"BusiCalc was designed to facilitate general business calculations. "+;
"It has some features not normally associated with general business "+;
"and in some cases limitations to their use apply, for example, n! "+;
"is limited to 21! ";
},{{ 16,NO_2}}})
aAdd(oDlg:aHelp,{{"Notes and Display Limits"},;
{"All calculations are performed to 14 places of decimal "+;
"regardless of what the display is set to. This means you "+;
"can change the number of decimals displayed and observe a more "+;
"(or less) accurate result at anytime during a calculation. "+;
"The result displayed is rounded up to the current number of "+;
"decimal places shown in the Set Decimals window.;"+;
";"+;
"BusiCalc can display results up to slightly less than 10^20 "+;
"(10 to the power of 20) and as long as the final result is less "+;
"than this figure, and the intervening results are not greater than "+;
"10^38, the calculator will display the correct result.";
},{{ 16,NO_3}}})
aAdd(oDlg:aHelp,{{"Keys, Mouse and Keyboard"},;
{"To reduce the potential for error during calculations the Number "+;
"Keys are sometimes disabled, indicating that an Operator Key is "+;
"expected. In all other respects it is a standard calculator.;"+;
";"+;
"With one or two exceptions, all of the main features can be actioned "+;
"using Keyboard Keys, or Mouse Clicks. Where possible the keys have "+;
"been selected to describe the Key function. You can use upper or "+;
"lower case.;"+;
";"+;
"For example, the function 'Add to Memory' is actioned by pressing "+;
"the letter 'A'. ...Add or clicking the appropriate key [ M+ ].";
},{{ 16,NO_4}}})
// Do not Line up text !!
aAdd(oDlg:aHelp,{{"The Keyboard Keys"},;
{;
"Key Action;"+;
"A ..... Add to Memory;"+;
"B ..... British Pounds to Dollars;"+;
"C ..... Clear Accumulator;"+;
"D ..... Decimals set;"+;
"E ..... Entry Clear;"+;
"F ..... Foreign to Local Currency;"+;
"G ..... Get Memory Value;"+;
"I ..... Invert Number (Reciprocal);"+;
"K ..... Pi constant;"+;
"L ..... Local to Foreign Currency;"+;
"N ..... Negate Number (Toggle);"+;
"P ..... Pounds British to Euro;"+;
"Q ..... Information about this program;"+;
"R ..... Root of value X"},{{ 16,NO_5}}})
// Do not Line up text !!
aAdd(oDlg:aHelp,{{"The Keyboard Keys (cont.)"},;
{;
"S ..... Square of value X;"+;
"T ..... Take from Memory (Mem Subtract);"+;
"U ..... US Dollars to Euro Currency;"+;
"W .... Wipe Memory (Mem Clear);"+;
"X ..... Exchange Rates Set;"+;
";"+;
"Numerics ! # % ( ) * + - . / 0123456789 = ^;"+;
";"+;
"F1 ... Help, This file.;"+;
"^V ... Paste from Clipboard (Ctrl+V);"+;
"^C ... Copy to Clipboard (Ctrl+C);"+;
"Esc... Entry Clear;"+;
";"+;
"Space Minimise: Spacebar;"+;
"^Space Maximise: Ctrl-SpaceBar;"+;
"(Operative only when BusiCalc has Focus)"},{{ 16,NO_6}}})
aAdd(oDlg:aHelp,{{"Operator Keys - Single Entry"},;
{;
"Some keys perform an immediate operation. ;"+;
";"+;
"Reciprocal [1/x];"+;
"Input 2 Press [1/x], Result is 0.5 (1/2);"+;
"Press [1/x] again and Result = Input, 2 ;"+;
"Negate [+/-];"+;
"Input 3 Press [+/-], Result is -3 (minus 3);"+;
"Press [+/-] again and Result = Input, 3;"+;
"Factorial [n!];"+;
"Input 5 Press [n!] Result: 120 (5x4x3x2x1);"+;
";"+;
"Square [XSqd];"+;
"Input 4 Press [XSqd] Result: 16 (4x4=16);"+;
"...the reverse is:;"+;
"Square Root [SqRt];"+;
"Input 16 Press [SqRt] Result: 4 ( ?x?=16)"},;
{{3,BM_RECIP},{6,BM_NEGATE},{9,BM_N_FACTORIAL},;
{12,BM_SQUARED},{15,BM_SQR_ROOT},{ 16,NO_7}}})
aAdd(oDlg:aHelp,{{"Operator Keys - Double Entry"},;
{;
"In each case you need to Input the first value;"+;
"'X', press the Key, Input the second value 'n',;"+;
"then press Enter, or a new Operator. The;"+;
"'X' value may be the current display value.;"+;
";"+;
"What is 4 multipled by 4 five times ?;"+;
"X to the power of n [Xn] ;"+;
"Input 4 Press [Xn] Input 5, Result: 1024;;"+;
"What multiplied by itself four times = 625 ?;"+;
"nth Root of X [nRtX] ;"+;
"Input 625 Press [nRtX] Input 4, Result: 5;;"+;
"How many 1/100ths (percent) is 40/80 ?;"+;
"Percent [%];"+;
"Input 40 Press [%] Input 80, Result: 50% (50/100)"},;
{{7,BM_NTH_POWER},{11,BM_NTH_ROOT},{15,BM_PERCENT},{ 16,NO_8}}})
aAdd(oDlg:aHelp,{{"Bracketed Operations"},;
{;
"You need to be careful using bracketed operations. "+;
"The operation does not, except in certain circumstances, "+;
"work like a computer spreadsheet evaluation where the "+;
"innermost bracketed contents are evaluated first and the "+;
"overall expression evaluated from right to left.;"+;
";"+;
"BusiCalc evaluates your input as you enter it and regards "+;
"a bracketed operation as a 'new' calculation until you close "+;
"the brackets. Then it evaluates the 'new' value from the "+;
"brackets and your input preceding the brackets."},{{16,NO_9}}})
aAdd(oDlg:aHelp,{{"Currency Operations"},;
{;
"BusiCalc is capable of converting between;"+;
"Pounds and Euro;"+;
"Euro and Pounds;;"+;
"US Dollars and Pounds;"+;
"Pounds and US Dollars;;"+;
"US Dollars and Euro;"+;
"Euro and US Dollars.;;"+;
"Which currency is default depends on your last choice "+;
"and the two larger buttons labelled 'L' (Local) and 'F' "+;
"(Foreign), for the want of a better description, allow "+;
"you to toggle the displayed value in those currencies."},;
{{2,BM_PND_TO_EUR},{3,BM_EUR_TO_PND},{5,BM_DLR_TO_PND},;
{6,BM_PND_TO_DLR},{8,BM_DLR_TO_EUR},{9,BM_EUR_TO_DLR},{16,NO_10}}})
aAdd(oDlg:aHelp,{{"Switching Currency"},;
{;
"If no currency symbol is showing to the left of the "+;
"main display, it is a simple matter of clicking one of "+;
"the three small currency buttons 'p','b','u' at the "+;
"bottom of BusiCalc to set the currency mode.;"+;
";"+;
"If however, a currency symbol is showing against the main "+;
"display, you may only instal conversion buttons that have a "+;
"corresponding symbol. This is done to prevent errors.;"+;
";"+;
"Displaying Cannot select;"+;
"'Euro' Dollars to Pounds;"+;
"'Dollar' Pounds to Euro;"+;
"'Pound' Dollars to Euro"},;
{{2,PB_PND_EUR},{3,PB_DLR_PND},{4,PB_DLR_EUR},{ 16,NO_11}}})
aAdd(oDlg:aHelp,{{"Set Decimal Places"},;
{;
"As mentioned earlier, all calculations are "+;
"performed to 14 decimal places of precision regardless "+;
"of what number of decimals the display is set to display.;"+;
";"+;
"To set the number of decimals displayed click 'Set "+;
"Dec' or press 'd'. Input the number of decimals "+;
"required, and press Enter.;"+;
";"+;
"This may be done at anytime during a calculation "+;
"with one exception, you may not do it during a "+;
"bracketed (...) operation.;"+;
";"+;
"Weird results can be displayed if you do not set enough "+;
"places. For example, with 0 places, 3/2 = 2"},;
{{7,PB_SET_DEC},{ 16,NO_12}}})
aAdd(oDlg:aHelp,{{"Set Exchange Rate(s)"},;
{;
"To set the rates click 'Set Rate' or press 'x';"+;
"Two of the rates are relative to the Euro. That is, "+;
"you Input the Dollar exchange rate to 1 Euro and the "+;
"Pound rate to 1 Euro.;"+;
";"+;
"For the third rate, you Input the Dollar rate to 1 Pound.;"+;
";"+;
"Any time you change the rates a validate routine will "+;
"run a test that cross-checks the three rates against "+;
"one another and outputs a message as to the accuracy "+;
"of the stored values.;"+;
";"+;
"This site has an exchange rate service. ;"+;
"http://www.xe.net/ucc/"},;
{{1,PB_SET_RATE},{ 16,NO_13}}})
aAdd(oDlg:aHelp,{{"Import and Export Values"},;
{;
"This feature allows you to Copy a value from "+;
"another application to the ClipBoard and Import it "+;
"into the display. Click Import or press Ctrl+C;"+;
";"+;
"You can also Export the value in the display to the "+;
"ClipBoard for Pasting to another application. Click "+;
"Export or press Ctrl+V;"+;
";"+;
"This feature can also provide you with another way "+;
"of saving the result of a calculation for later use by "+;
"Exporting it and Importing when needed."},;
{{4,PB_COPY},{8,PB_PASTE},{ 16,NO_14}}})
aAdd(oDlg:aHelp,{{"Move - Minimise - Busicalc"},;
{;
"To move BusiCalc: place the pointer in the Title area, click "+;
"with the left button and hold it down while you move the "+;
"calculator to a new location. This can only be done on the "+;
"Calculator window, not on Help, About or Messages.;"+;
";"+;
"To minimise BusiCalc: press the SpaceBar or click the minimise "+;
"button [ - ] on the title bar of BusiCalc.;"+;
";"+;
"To maximise BusiCalc: click the 'BusiCalc' button at the top "+;
"right side of the current screen. You may also press "+;
"Ctrl+SpaceBar if you have not clicked anything else since you "+;
"minimised.;"},{{ 16,NO_15}}})
aAdd(oDlg:aHelp,{{"Acknowledgements"},;
{;
"This Calculator was written using Alaska Software GmbH Xbase++ "+;
"(TM), a Win32 bit GUI / OOP relational database programming language "+;
"using a CA-Clipper (TM) style syntax. Alaska Software GmbH can be "+;
"reached at: ;http://www.alaska-software.com/;"+;
";"+;
"My thanks to Clayton Jones for the insight into GUI / OOP "+;
"programming techniques using the Xbase++ language, learned in "+;
"record time by studying his Top-Down (TM) Library code and "+;
"Tutorials. Clayton Jones can be reached at: ;"+;
"http://www.cjcom.net/bizcore.html"},{{ 16,NO_16}}})
RETURN nil
* END FUNCTION MakeHelp()
*****************************************************************************
*
*****************************************************************************
*
* Note concerning PutData(), GetData() and PullDataRecord()
*
* These routines may seem an overkill for handling 4 miserly bits of data
* transferring from Array - File - Array. They are however 'cut-down'
* versions of routines used in a more elaborate variable record size
* Random Access dB system and as such they were ready to hand.
*
* I suppose I could have reduced them further but I have to cut the grass!
*
*****************************************************************************
*
*****************************************************************************
* FUNCTION GetData()
*****************************************************************************
*
* FUNCTION GetData(cFileName, aData, nRecord_Len, nRecNo) --> nErrorCode
*
* Notes:
* ------
* aData is passed in by reference.
* nRecNo is only required when a specific record is to be returned.
*
* If used, nRecNo must be pre-validated to ensure it is an element
* of aData or an error will occur.
*
* Specifying a Record Number will only retrieve that record from the
* file and modify the array element accordingly. If nRecNo is ommitted,
* the aData array is cleared to zero elements and loaded with the file
* data records.
*
* Note: This is a modified and reduced features implementation of
* a more sophisticated routine used for Random Access Db work.
* Data error trapping is not required and has been removed.
*
*
* Returns ErrorCode levels.
*
* Error Description
*
* 4 ERROR CLOSING
* 3 ERROR READING
* 2 ERROR OPENING
* 1 ERROR NOTEXIST
* 0 SUCCESSFUL
*
* Requires: Companion function - PullDataRecord()
*
*****************************************************************************
//#include "Fileio.ch"
*
FUNCTION GetData(cFileName, aData, nRecord_Len, nRecNo)
LOCAL nHandle := 0
LOCAL nBytes := 0
LOCAL nErrorCode := 0
LOCAL lEndofFile := .F.
LOCAL cDataRecord := ""
nRecNo := IIF(ValType(nRecNo)="U","void",nRecNo)
IF !(FILE( cFileName ))
******************** DOES NOT EXIST
nErrorCode := 1
ELSE
nHandle:= ;
FOPEN( cFileName, FO_READ )
IF !(FERROR() == 0)
***************** ERROR OPENING
nErrorCode := 2
ELSE
nBytes:= ;
FSEEK(nHandle, 0, FS_END)
IF !(FERROR() == 0)
************** ERROR READING
nErrorCode := 3
ELSE
***** Reset to start
FSeek( nHandle, 0 , FS_SET )
lEndofFile:= .F.
IF !(ValType(nRecNo)=="N")
ARemove(aData,1,Len(aData))
ENDIF
Do While !(lEndofFile)
cDataRecord := ;
PullDataRecord( ;
nHandle ,;
nRecord_Len ,;
@lEndofFile ,;
nBytes,nRecNo)
IF cDataRecord == ;
"~|ERROR|~"
************** ERROR READING
nErrorCode := 3
EXIT
ENDIF
IF !(ValType(nRecNo)=="N")
aAdd(aData,cDataRecord)
ELSE
aData[nRecNo]:= cDataRecord
ENDIF
ENDDO // !EOF
ENDIF
ENDIF
IF !(FClose( nHandle ))
***************** ERROR CLOSING
nErrorCode := 4
ENDIF
ENDIF
RETURN (nErrorCode)
* END FUNCTION GetData()
*****************************************************************************
*
*****************************************************************************
*
* FUNCTION PutData( cFilename, aData, nRecord_Len, nRecNo ) --> nErrorCode
*
* Writes fixed length Record Data from an Array to a file.
*
* If a Record Number is omitted the routine will Create a new file
* overwriting any file of the same name with all aData elements
* submitted, otherwise, it replaces the relevant record in an
* existing file. Note *Existing File*
*
* Note: This is a modified and reduced features implementation of
* a more sophisticated routine used for Random Access Db work.
* Data error trapping is not required and has been removed.
*
* Returns ErrorCode levels.
*
* Error Description
*
* 6 ERROR WRITE+CLOSE
* 5 ERROR CLOSE
* 4 ERROR WRITE
* 3 ERROR BAD-ARGS
* 2 ERROR CREATE
* 1 ERROR OPEN
* 0 SUCCESSFUL
*
*****************************************************************************
*
//#include "Fileio.ch"
FUNCTION PutData( cFilename, aData, nRecord_Len, nRecNo )
LOCAL nHandle := 0
LOCAL i := 0
LOCAL nErrorCode := 0
LOCAL cBuffer := ""
LOCAL nOffset := 0
nRecNo := IIF(ValType(nRecNo)="U","void",nRecNo)
Do Case
Case ValType(nRecNo) == "N" .AND. FExists( cFilename )
nHandle := FOpen( cFilename, FO_READWRITE+FO_EXCLUSIVE )
IF !(FError() == 0)
************ ERROR OPEN
nErrorCode := 1
ENDIF
Case ValType(nRecNo) == "C"
nHandle := FCreate( cFilename, FC_NORMAL )
IF !(FError() == 0)
************ ERROR CREATE
nErrorCode := 2
ENDIF
OtherWise
*************** ERROR BAD-ARGS
nErrorCode := 3
ENDCASE
IF nErrorCode == 0
IF !Empty(aData)
IF ValType(nRecNo) == "N"
cBuffer := aData[nRecNo]
nOffSet := (nRecNo -1) * nRecord_Len
FSeek( nHandle, nOffSet, FS_SET)
FWrite(nHandle, cBuffer, nRecord_Len)
IF !(FError() == 0)
************ ERROR WRITE
nErrorCode := 4
ENDIF
ELSE
For i:= 1 TO Len(aData)
cBuffer := aData[i]
FWrite( nHandle, cBuffer, nRecord_Len)
IF !(FError() == 0)
************ ERROR WRITE
nErrorCode := 4
EXIT // From FOR
ENDIF
Next i
ENDIF
ENDIF
***** nErrorCode%2 = 0 is...
***** No Error, or File opened + Write Error
IF nErrorCode%2 == 0
IF !(FClose( nHandle ))
IF nErrorCode == 0
************ ERROR CLOSE
nErrorCode := 5
ELSE
************ ERROR ERROR WRITE + CLOSE
nErrorCode := 6
ENDIF
ENDIF
ENDIF
ENDIF
RETURN ( nErrorCode )
* END FUNCTION PutData()
*****************************************************************************
*
*****************************************************************************
* FUNCTION PullDataRecord() --> cDatarecord
*
* Pull a Data Record of set size or delimited by CRLF from a file.
* lEndofFile will change to .T. when EOF is reached.
* nRecord_Len holds the data record length and defaults to 80 chars.
*
* CRLF cannot be part of the data stream, it is a delimiter.
*
*
* Note: This is a modified and reduced features implementation of
* a more sophisticated routine used for Random Access Db work.
*
*****************************************************************************
*
*
FUNCTION PullDataRecord( nFileHandle,nRecord_Len,lEndofFile,nSizeOfFile, xRecNo)
LOCAL cCRLF := CHR(13) + CHR(10)
LOCAL cDataRecord := ''
LOCAL cTextBuffer := ''
LOCAL nCharsRead := 0
LOCAL nCharsToRead := 0
LOCAL nEndOfLinePosition := 0
LOCAL nCurrentPosition := FSeek(nFileHandle, 0, FS_RELATIVE)
IF Valtype(xRecNo) == "N"
nCurrentPosition:= (xRecNo -1) * nRecord_Len
IF !(nCurrentPosition > nSizeOfFile - nRecord_Len)
FSeek( nFileHandle, nCurrentPosition, FS_SET )
nCharsToRead:= Min( nRecord_Len, nSizeOfFile - nCurrentPosition )
cTextBuffer := Space( nCharsToRead )
nCharsRead := FRead( nFileHandle, @cTextBuffer, nCharsToRead )
cDataRecord := ''
ELSE
cDataRecord:= "~|ERROR|~"
ENDIF
ELSE
nCharsToRead := Min( nRecord_Len, nSizeOfFile - nCurrentPosition )
cTextBuffer := Space( nCharsToRead )
nCharsRead := FRead( nFileHandle, @cTextBuffer, nCharsToRead )
cDataRecord := ''
ENDIF
******* Check for read errors
*
IF !(FERROR() == 0) .OR. (cDataRecord == "~|ERROR|~")
cDataRecord:= "~|ERROR|~"
ELSE
******** Update the Textbuffer and the current file position
*
nEndOfLinePosition := At( cCRLF, cTextBuffer )
IF nEndOfLinePosition == 0
cDataRecord := Left( cTextBuffer, nCharsRead )
nCurrentPosition += nCharsRead
ELSE
cDataRecord := Left( cTextBuffer, ( nEndOfLinePosition - 1 ))
nCurrentPosition += ( nEndOfLinePosition + Len( cCRLF ) ) - 1
FSeek( nFileHandle, nCurrentPosition, FS_SET )
ENDIF
******** Hit the wall?
*
IF nCurrentPosition >= nSizeOfFile .OR. Valtype(xRecNo)=="N"
lEndofFile := .T.
ENDIF
ENDIF
RETURN( cDataRecord )
*
* END OF PullDataRecord()
*****************************************************************************
*
*****************************************************************************
****************************** END **********************************
*****************************************************************************