527 lines
18 KiB
OpenEdge ABL
527 lines
18 KiB
OpenEdge ABL
/*----------------------------------------------------------------------------*/
|
|
/* */
|
|
/* Copyright (c) 2011-2014 Rexx Language Association. All rights reserved. */
|
|
/* */
|
|
/* This program and the accompanying materials are made available under */
|
|
/* the terms of the Common Public License v1.0 which accompanies this */
|
|
/* distribution. A copy is also available at the following address: */
|
|
/* https://www.oorexx.org/license.html */
|
|
/* */
|
|
/* Redistribution and use in source and binary forms, with or */
|
|
/* without modification, are permitted provided that the following */
|
|
/* conditions are met: */
|
|
/* */
|
|
/* Redistributions of source code must retain the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer. */
|
|
/* Redistributions in binary form must reproduce the above copyright */
|
|
/* notice, this list of conditions and the following disclaimer in */
|
|
/* the documentation and/or other materials provided with the distribution. */
|
|
/* */
|
|
/* Neither the name of Rexx Language Association nor the names */
|
|
/* of its contributors may be used to endorse or promote products */
|
|
/* derived from this software without specific prior written permission. */
|
|
/* */
|
|
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
|
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
|
|
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
|
|
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
|
|
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
|
|
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
|
|
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
|
|
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
|
|
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
|
|
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
|
|
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
|
|
/* */
|
|
/*----------------------------------------------------------------------------*/
|
|
|
|
/**
|
|
* The NumberOnlyEditEx class extends the .Edit class to provide an edit
|
|
* control which restricts entry to decimal only, or signed decimal only,
|
|
* numbers.
|
|
*
|
|
* The NumberOnlyEditEx.cls file is meant to be included in any ooDialog
|
|
* program where this extension to the edit control is desired. The programmer
|
|
* needs to take 4 steps to gain the functionality of a signed decimal number
|
|
* only edit control:
|
|
*
|
|
* 1.) Require the NumberOnlyEditEx.cls file (this file.)
|
|
*
|
|
* ::requires 'NumberOnlyEditEx.cls'
|
|
*
|
|
* 2.) Invoke the initDecimalOnly() method on each edit control object that is
|
|
* to be a decimal number only edit control. If initDecimalOnly() is not
|
|
* invoked, the behaviour of the edit control is unchanged.
|
|
*
|
|
* editObject = self~newEdit(IDC_EDIT)
|
|
* editObject~initDecimalOnly(decimalPlaces, allowSign)
|
|
*
|
|
* arguments:
|
|
*
|
|
* decimalPlaces [optional] The number of decimal places allowed in the
|
|
* number. The default is 2. Specifying 0
|
|
* decimal places is acceptable.
|
|
*
|
|
* allowSign [optional] If a sign character (+ or -) is allowed as the
|
|
* leading character of the number. The default
|
|
* is .false. Specify .true to allow a sign
|
|
* character.
|
|
*
|
|
* 3.) For each decimal only edit control, the character event must be
|
|
* connected to a method in the Rexx dialog object.
|
|
*
|
|
* editObject = self~newEdit(IDC_EDIT)
|
|
* editObject~connectCharEvent(onChar)
|
|
*
|
|
* 4.) In the connected character event handler, the message and its arguments
|
|
* must be forwarded on to the onChar() method of the edit control. The
|
|
* 6th argument to the event handler is the dialog control object where the
|
|
* character event occurred. That is the object the event must be forwared
|
|
* to.
|
|
*
|
|
* When the programmer connects the character event to a method named
|
|
* onChar, the event handler is simple:
|
|
*
|
|
* ::method onChar unguarded
|
|
* forward to (arg(6))
|
|
*
|
|
* If the programmer chooses a different method name for the event handler,
|
|
* then he must be sure to forward to the onChar() method of the edit
|
|
* control:
|
|
*
|
|
* ::method myOwnMethodName unguarded
|
|
* forward message 'onChar' to (arg(6))
|
|
*
|
|
* And of course there is no reason why the event handler can not be coded
|
|
* using the explicit arguments:
|
|
*
|
|
* ::method myOwnMethodName unguarded
|
|
* use arg char, isShift, isCtrl, isAlt, misc, control
|
|
* forward message 'onChar' to (control)
|
|
*/
|
|
|
|
-- Extend the .Edit control by inheriting the .NumberOnlyEditEx mixin class.
|
|
|
|
.Edit~inherit(.NumberOnlyEditEx, .EditControl)
|
|
|
|
::requires 'ooDialog.cls'
|
|
::requires 'winsystm.cls'
|
|
|
|
::class 'NumberOnlyEditEx' public mixinclass object
|
|
|
|
-- Users of the signed decimal number only edit control must invoke
|
|
-- initDecimalOnly() first to assign decimal places and specify if the sign
|
|
-- character is allowed. Until this is done, there is no change to the
|
|
-- behaviour of the Edit control object.
|
|
::method initDecimalOnly
|
|
expose decimalPlaces signOk initialized clipBoard
|
|
use strict arg decimalPlaces = 2, plusMinus = .false
|
|
|
|
if plusMinus~isA(.String), plusMinus~datatype('O') then signOk = plusMinus
|
|
else signOk = .false
|
|
|
|
initialized = .true
|
|
clipBoard = .WindowsClipboard~new
|
|
|
|
-- The onChar() method should be inovked at every character event. Returning
|
|
-- true allows the character, returning false disallows the character. When a
|
|
-- character is not allowed, an edit ballon is set with a message explaining to
|
|
-- the user why the character is not appearing when they type.
|
|
::method onChar unguarded
|
|
expose decimalPlaces initialized signOk
|
|
use arg char, isShift, isCtrl, isAlt, misc, control
|
|
|
|
if \ var('initialized') then return .true
|
|
|
|
if misc~pos("extended") <> 0, self~isExtendedKey(char) then return .true
|
|
|
|
if char == 8 then return .true
|
|
if signOk, (char == 43 | char == 45) then return self~checkSign
|
|
if char == 46 then return self~checkDecimal
|
|
if char >= 48, char <= 57 then return self~checkDigit
|
|
|
|
if isCtrl, \isAlt, \isShift then return self~checkControlKey(char)
|
|
|
|
reply .false
|
|
self~charBalloon
|
|
|
|
|
|
/** checkDigit()
|
|
*
|
|
* Checks that the digit being typed, at the cursor position, is allowed.
|
|
*/
|
|
::method checkDigit private unguarded
|
|
expose decimalPlaces signOk
|
|
|
|
text = self~getText
|
|
decimalPos = text~pos('.')
|
|
cursorPos = self~getCaretPos
|
|
|
|
if signOk, cursorPos == 1 then do
|
|
c = text~left(1)
|
|
|
|
if c == '-' | c == '+' then do
|
|
reply .false
|
|
self~showBalloon(.MT~NUM_TITLE, .MT~HAS_SIGN, "ERROR")
|
|
return
|
|
end
|
|
return .true
|
|
end
|
|
|
|
if decimalPos == 0 then return .true
|
|
|
|
if cursorPos <= decimalPos then return .true
|
|
|
|
if text~length < (decimalPos + decimalPlaces) then return .true
|
|
|
|
reply .false
|
|
|
|
msg = self~decimalPlacesUsedMsg
|
|
self~showBalloon(.MT~NUM_TITLE, msg, "ERROR")
|
|
|
|
|
|
/** checkSign()
|
|
*
|
|
* Checks that the sign character being typed is allowed at the current cursor
|
|
* position. Note that this method is only invoked when the sign character is
|
|
* allowed.
|
|
*/
|
|
::method checkSign private unguarded
|
|
expose decimalPlaces
|
|
|
|
text = self~getText
|
|
cursorPos = self~getCaretPos
|
|
|
|
if cursorPos == 1 then do
|
|
if self~hasSign(text) then do
|
|
reply .false
|
|
self~showBalloon(.MT~SIGN_TITLE, .MT~HAS_SIGN, "ERROR")
|
|
return
|
|
end
|
|
|
|
return .true
|
|
end
|
|
|
|
reply .false
|
|
|
|
decimalPos = text~pos('.')
|
|
if decimalPos <> 0 | decimalPlaces == 0 then msg = .MT~ONLY_NUMBER
|
|
else msg = .MT~ONLY_DECIMAL_NUMBER
|
|
|
|
self~showBalloon(.MT~SIGN_TITLE, msg, "ERROR")
|
|
|
|
|
|
/** checkDecimal()
|
|
*
|
|
* Checks that the decimal point being typed is allowed at the current cursor
|
|
* position.
|
|
*/
|
|
::method checkDecimal private unguarded
|
|
expose decimalPlaces signOk
|
|
|
|
text = self~getText
|
|
decimalPos = text~pos('.')
|
|
cursorPos = self~getCaretPos
|
|
|
|
if decimalPlaces == 0 then do
|
|
reply .false
|
|
self~decimalPointBalloon(decimalPos, cursorPos, text)
|
|
return
|
|
end
|
|
|
|
if decimalPos <> 0 then do
|
|
reply .false
|
|
self~decimalPointBalloon(decimalPos, cursorPos, text)
|
|
return
|
|
end
|
|
|
|
if cursorPos == 1, signOk, self~hasSign(text) then do
|
|
reply .false
|
|
self~decimalPointBalloon(decimalPos, cursorPos, text)
|
|
return
|
|
end
|
|
|
|
if text~length < cursorPos + decimalPlaces then return .true
|
|
|
|
reply .false
|
|
self~decimalPointBalloon(decimalPos, cursorPos, text)
|
|
|
|
|
|
/** checkControlKey()
|
|
*
|
|
* Invoked for a control key combination (Ctrl-?). Anything other than Ctrl-V
|
|
* is automatically allowed. Ctrl-V is of course the paste operation. For
|
|
* Ctrl-V, we check that the result after pasting the text would be a valid
|
|
* signed decimal number, under the constraints for this object. If not, it
|
|
* is disallowed and a ballon set.
|
|
*/
|
|
::method checkControlKey private unguarded
|
|
expose clipBoard decimalPlaces
|
|
use strict arg char
|
|
|
|
if char \== 22 then return .true -- Not Ctrl-V
|
|
|
|
-- If there is no text data available we don't care, pasting it will not do
|
|
-- any harm.
|
|
if \ clipBoard~isDataAvailable then return .true
|
|
|
|
pastedText = clipBoard~paste
|
|
|
|
-- We have text to paste, need to check is the text acceptable,
|
|
-- and is it acceptable for where it will be placed.
|
|
text = self~getText
|
|
len = text~length
|
|
decimalPos = text~pos('.')
|
|
cursorPos = self~getCaretPos
|
|
|
|
-- isValidDecimal() checks that the resulting text after inserting the pasted
|
|
-- text is valid.
|
|
if \ self~isValidDecimal(pastedText, text, cursorPos) then do
|
|
reply .false
|
|
self~pasteBalloon(pastedText, text, cursorPos)
|
|
return
|
|
end
|
|
|
|
return .true
|
|
|
|
|
|
/** decimalPointBalloon()
|
|
*
|
|
* This method produces the proper balloon message text when a decimal point has
|
|
* been typed, but is not allowed at the current position.
|
|
*/
|
|
::method decimalPointBalloon private unguarded
|
|
expose decimalPlaces signOk
|
|
use strict arg decimalPos, cursorPos, text
|
|
|
|
select
|
|
when cursorPos == 1 then do
|
|
if self~hasSign(text) then msg = .MT~HAS_SIGN
|
|
else if decimalPlaces == 0, signOk then msg = .MT~ONLY_WHOLE_SIGNED_NUMBER
|
|
else if signOk then msg = .MT~ONLY_SIGNED_NUMBER
|
|
else msg = .MT~ONLY_NUMBER
|
|
end
|
|
when decimalPlaces == 0 then do
|
|
msg = .MT~ONLY_WHOLE_NUMBER
|
|
end
|
|
when cursorPos <= decimalPos then do
|
|
msg = .MT~ONLY_NUMBER
|
|
end
|
|
when (decimalPos + decimalPlaces) > text~length then do
|
|
msg = .MT~ONLY_NUMBER
|
|
end
|
|
otherwise do
|
|
msg = self~decimalPlacesUsedMsg
|
|
end
|
|
end
|
|
-- End select
|
|
|
|
self~showBalloon(.MT~DEC_TITLE, msg, "ERROR")
|
|
|
|
|
|
/** charBalloon()
|
|
*
|
|
* This method produces the proper balloon message when a character is typed.
|
|
*/
|
|
::method charBalloon private unguarded
|
|
expose decimalPlaces signOk
|
|
|
|
text = self~getText
|
|
decimalPos = text~pos('.')
|
|
cursorPos = self~getCaretPos
|
|
|
|
msg = .MT~ONLY_NUMBER
|
|
|
|
select
|
|
when cursorPos == 1 then do
|
|
if self~hasSign(text) then msg = .MT~HAS_SIGN
|
|
else if decimalPlaces == 0, signOk then msg = .MT~ONLY_WHOLE_SIGNED_NUMBER
|
|
else if decimalPlaces == 0, \signOk then msg = .MT~ONLY_WHOLE_NUMBER
|
|
else if decimalPos == 0, signOk then msg = .MT~ONLY_SIGNED_DECIMAL_NUMBER
|
|
else if decimalPos == 0, \signOk then msg = .MT~ONLY_DECIMAL_NUMBER
|
|
else if signOk then msg = .MT~ONLY_SIGNED_NUMBER
|
|
else msg = .MT~ONLY_NUMBER
|
|
end
|
|
when decimalPlaces == 0 then do
|
|
msg = .MT~ONLY_WHOLE_NUMBER
|
|
end
|
|
when decimalPos == 0 then do
|
|
msg = .MT~ONLY_DECIMAL_NUMBER
|
|
end
|
|
when cursorPos <= decimalPos then do
|
|
msg = .MT~ONLY_NUMBER
|
|
end
|
|
when (decimalPos + decimalPlaces) > text~length then do
|
|
msg = .MT~ONLY_NUMBER
|
|
end
|
|
otherwise do
|
|
msg = self~decimalPlacesUsedMsg
|
|
end
|
|
end
|
|
-- End select
|
|
|
|
self~showBalloon(.MT~CHAR_TITLE, msg, "ERROR")
|
|
|
|
|
|
/** pasteBalloon()
|
|
*
|
|
* This method produces the proper balloon message when text is pasted into the
|
|
* edit control that is not allowed.
|
|
*/
|
|
::method pasteBalloon private unguarded
|
|
expose decimalPlaces signOk
|
|
use strict arg pastedText, text, cursorPos
|
|
|
|
if signOk then do
|
|
if decimalPlaces == 0 then msg = .MT~ONLY_PASTE_WHOLE_SIGNED
|
|
else msg = .MT~ONLY_PASTE_A_SIGNED decimalPlaces .MT~ONLY_PASTE_B
|
|
end
|
|
else do
|
|
if decimalPlaces == 0 then msg = .MT~ONLY_PASTE_WHOLE
|
|
else msg = .MT~ONLY_PASTE_A decimalPlaces .MT~ONLY_PASTE_B
|
|
end
|
|
|
|
resultText = text~substr(1, cursorPos - 1) || pastedText || text~substr(cursorPos)
|
|
|
|
-- Balloon text has to be less than 1023 characters. If we don't exceed that
|
|
-- length, we will show the incorrect text to the user. Otherwise we just
|
|
-- show the short message. Note that new line characters can be used to
|
|
-- format the balloon text.
|
|
len = msg~length + resultText~length + .MT~PASTED_A~length + .MT~PASTED_B~length + 8
|
|
|
|
if len < 1023 then do
|
|
msg ||= .endOfLine~copies(2) || .MT~PASTED_A || -
|
|
.endOfLine~copies(2) || '"'resultText'"' || -
|
|
.endOfLine~copies(2) || .MT~PASTED_B
|
|
end
|
|
|
|
self~showBalloon(.MT~PASTE_TITLE, msg, "ERROR")
|
|
|
|
|
|
/** decimalPlacesUsedMsg()
|
|
*
|
|
* Convenience method to return the proper message for the situation where the
|
|
* allowable number of decimal places have been filled.
|
|
*/
|
|
::method decimalPlacesUsedMsg private unguarded
|
|
expose decimalPlaces
|
|
|
|
if decimalPlaces == 1 then return .MT~ONLY_1_DECIMAL
|
|
else return .MT~ONLY_DECIMALS_A decimalPlaces .MT~ONLY_DECIMALS_B
|
|
|
|
|
|
/** isValidDecimal()
|
|
*
|
|
* Checks that the resulting text after the pasted text is inserted into text at
|
|
* the current position, results in a valid number using the current
|
|
* restrictions. Decimal places and sign allowed or not.
|
|
*/
|
|
::method isValidDecimal private unguarded
|
|
expose decimalPlaces signOk
|
|
use strict arg pasteText, text, cursorPos
|
|
|
|
resultText = text~substr(1, cursorPos - 1) || pasteText || text~substr(cursorPos)
|
|
|
|
-- Can't have any type of space character, tab, new line, etc..
|
|
if resultText \== resultText~space(0) then return .false
|
|
|
|
-- Eliminate obvious problems with decimals.
|
|
countDots = resultText~countStr(".")
|
|
if countDots > 1 then return .false
|
|
if decimalPlaces == 0, countDots > 0 then return .false
|
|
|
|
-- Eliminate any problems with the sign character.
|
|
if signOk then do
|
|
if resultText~pos('-') > 1 | resultText~pos('+') > 1 then return .false
|
|
end
|
|
else do
|
|
if resultText~pos('-') <> 0 | resultText~pos('+') <> 0 then return .false
|
|
end
|
|
|
|
|
|
decimalPos = resultText~pos('.')
|
|
if decimalPos > 0 then do
|
|
if resultText~length - decimalPos > decimalPlaces then return .false
|
|
|
|
-- Remove the decimal char so we can test for all digits.
|
|
resultText = resultText~changeStr('.', '')
|
|
end
|
|
|
|
-- Remove the sign character if it exists.
|
|
if self~hasSign(resultText) then resultText = resultText~substr(2)
|
|
|
|
-- Exponential notation can not be allowed.
|
|
if resultText~caselessPos('E') <> 0 then return .false
|
|
|
|
if \ resultText~datatype('W') then return .false
|
|
|
|
return .true
|
|
|
|
|
|
/** isExtendedKey
|
|
*
|
|
* Convenience method to test if the character, char, is an extended key we want
|
|
* to pass on to the edit control
|
|
*/
|
|
::method isExtendedKey private
|
|
use strict arg char
|
|
|
|
if char >= 33, char <= 40 then return .true
|
|
if char == 45 | char == 46 | char == 8 then return .true
|
|
return .false
|
|
|
|
|
|
/** hasSign
|
|
*
|
|
* Convenience method to test if a text string starts with a sign (+ or -)
|
|
* character.
|
|
*/
|
|
::method hasSign private
|
|
use strict arg text
|
|
|
|
c = text~left(1)
|
|
if c == '-' | c == '+' then return .true
|
|
return .false
|
|
|
|
|
|
/** getCaretPos()
|
|
*
|
|
* Returns the current caret (cursor) position of this edit control.
|
|
*/
|
|
::method getCaretPos private
|
|
return self~selection~startChar
|
|
|
|
|
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*\
|
|
Class: MT
|
|
|
|
This class is used to provide constant character strings. The strings are
|
|
used for the balloon messages put up by the NumberOnlyEditEx mixin class.
|
|
\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
|
|
::class 'MT' private
|
|
::constant CHAR_TITLE "Unacceptable Character"
|
|
::constant DEC_TITLE "Unacceptable Decimal Point"
|
|
::constant NUM_TITLE "Unacceptable Number"
|
|
::constant SIGN_TITLE "Unacceptable Sign Character"
|
|
::constant PASTE_TITLE "Unacceptable Pasted Text"
|
|
|
|
::constant ONLY_NUMBER "You can only type a number here."
|
|
::constant ONLY_SIGNED_NUMBER "You can only type a number or the sign here."
|
|
::constant ONLY_DECIMAL_NUMBER "You can only type a number or the decimal point here."
|
|
::constant ONLY_SIGNED_DECIMAL_NUMBER "You can only type a number, the sign, or the decimal point here."
|
|
::constant ONLY_WHOLE_NUMBER "You can only type a number here. Only whole numbers are allowed."
|
|
::constant ONLY_WHOLE_SIGNED_NUMBER "You can only type a number or the sign here. Only whole numbers are allowed."
|
|
|
|
::constant HAS_SIGN "You can not type here. The sign character is already in place."
|
|
::constant ONLY_1_DECIMAL "You can not type here. Only 1 decimal place is allowed."
|
|
::constant ONLY_DECIMALS_A "You can not type here. Only"
|
|
::constant ONLY_DECIMALS_B "decimal places are allowed."
|
|
|
|
::constant ONLY_PASTE_WHOLE "You can only paste text here that produces a whole number."
|
|
::constant ONLY_PASTE_WHOLE_SIGNED "You can only paste text here that produces a signed whole number."
|
|
::constant ONLY_PASTE_A_SIGNED "You can only paste text here that produces a signed decimal number with"
|
|
::constant ONLY_PASTE_A "You can only paste text here that produces a decimal number with"
|
|
::constant ONLY_PASTE_B "or less decimal places."
|
|
::constant PASTED_A "Resulting text of:"
|
|
::constant PASTED_B "is not valid."
|