
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@963 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2049 lines
53 KiB
ObjectPascal
2049 lines
53 KiB
ObjectPascal
{*********************************************************}
|
|
{* OVCSF.PAS 4.06 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* The contents of this file are subject to the Mozilla Public License *}
|
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
|
{* compliance with the License. You may obtain a copy of the License at *}
|
|
{* http://www.mozilla.org/MPL/ *}
|
|
{* *}
|
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
|
{* for the specific language governing rights and limitations under the *}
|
|
{* License. *}
|
|
{* *}
|
|
{* The Original Code is TurboPower Orpheus *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
{$I OVC.INC}
|
|
|
|
{$B-} {Complete Boolean Evaluation}
|
|
{$I+} {Input/Output-Checking}
|
|
{$P+} {Open Parameters}
|
|
{$T-} {Typed @ Operator}
|
|
{.W-} {Windows Stack Frame}
|
|
{$X+} {Extended Syntax}
|
|
|
|
unit ovcsf;
|
|
{-Simple field visual component}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
|
|
Classes, Controls, Graphics, SysUtils,
|
|
OvcBase, OvcColor, OvcCaret, OvcConst, OvcData, OvcEF, OvcExcpt,
|
|
OvcIntl, OvcMisc, OvcStr;
|
|
|
|
type
|
|
{simple field type names}
|
|
TSimpleDataType = (
|
|
sftString, sftChar, sftBoolean, sftYesNo,
|
|
sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
|
|
sftReal, sftExtended, sftDouble, sftSingle, sftComp);
|
|
|
|
type
|
|
TOvcCustomSimpleField = class(TOvcBaseEntryField)
|
|
{.Z+}
|
|
protected {private}
|
|
{property instance variables}
|
|
FSimpleDataType : TSimpleDataType; {data type for this field}
|
|
FPictureMask : AnsiChar; {picture mask name}
|
|
|
|
function sfGetDataType(Value : TSimpleDataType) : Byte;
|
|
{-return a Byte value representing the type of this field}
|
|
procedure sfResetFieldProperties(FT : TSimpleDataType);
|
|
{-reset field properties}
|
|
procedure sfSetDefaultRanges;
|
|
{-set default range values based on the field type}
|
|
|
|
protected
|
|
procedure CreateWnd;
|
|
override;
|
|
|
|
procedure efEdit(var Msg : TMessage; Cmd : Word);
|
|
override;
|
|
{-process the specified editing command}
|
|
function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
|
|
override;
|
|
{-return the display string in Dest and a pointer as the result}
|
|
procedure efIncDecValue(Wrap : Boolean; Delta : Double);
|
|
override;
|
|
{-increment field by Delta}
|
|
function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
|
|
override;
|
|
{-transfer data to/from the entry fields}
|
|
|
|
{virtual property methods}
|
|
procedure sfSetDataType(Value : TSimpleDataType);
|
|
virtual;
|
|
{-set the data type for this field}
|
|
procedure sfSetPictureMask(Value: AnsiChar);
|
|
virtual;
|
|
{-set the picture mask}
|
|
|
|
public
|
|
procedure Assign(Source : TPersistent);
|
|
override;
|
|
constructor Create(AOwner: TComponent);
|
|
override;
|
|
|
|
function efValidateField : Word;
|
|
override;
|
|
{-validate contents of field; result is error code or 0}
|
|
{.Z-}
|
|
|
|
{public properties}
|
|
property DataType : TSimpleDataType
|
|
read FSimpleDataType
|
|
write sfSetDataType;
|
|
|
|
property PictureMask : AnsiChar
|
|
read FPictureMask
|
|
write sfSetPictureMask;
|
|
|
|
end;
|
|
|
|
TOvcSimpleField = class(TOvcCustomSimpleField)
|
|
published
|
|
{inherited properties}
|
|
property DataType; {needs to loaded before most other properties}
|
|
{$IFDEF VERSION4}
|
|
property Anchors;
|
|
property Constraints;
|
|
property DragKind;
|
|
{$ENDIF}
|
|
property AutoSize;
|
|
property BorderStyle;
|
|
property CaretIns;
|
|
property CaretOvr;
|
|
property Color;
|
|
property ControlCharColor;
|
|
property Controller;
|
|
property Ctl3D;
|
|
property Borders;
|
|
property DecimalPlaces;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property EFColors;
|
|
property Enabled;
|
|
property Font;
|
|
property LabelInfo;
|
|
property MaxLength;
|
|
property Options;
|
|
property PadChar;
|
|
property ParentColor;
|
|
{$IFNDEF LCL}
|
|
property ParentCtl3D;
|
|
{$ENDIF}
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PasswordChar;
|
|
property PictureMask;
|
|
property PopupMenu;
|
|
property RangeHi stored False;
|
|
property RangeLo stored False;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property Tag;
|
|
property TextMargin;
|
|
property Uninitialized;
|
|
property Visible;
|
|
property ZeroDisplay;
|
|
property ZeroDisplayValue;
|
|
|
|
{inherited events}
|
|
property AfterEnter;
|
|
property AfterExit;
|
|
property OnChange;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnError;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnMouseWheel;
|
|
property OnUserCommand;
|
|
property OnUserValidation;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{*** TOvcCustomSimpleField ***}
|
|
|
|
procedure TOvcCustomSimpleField.Assign(Source : TPersistent);
|
|
var
|
|
SF : TOvcCustomSimpleField absolute Source;
|
|
begin
|
|
if (Source <> nil) and (Source is TOvcCustomSimpleField) then begin
|
|
DataType := SF.DataType;
|
|
AutoSize := SF.AutoSize;
|
|
BorderStyle := SF.BorderStyle;
|
|
Color := SF.Color;
|
|
ControlCharColor := SF.ControlCharColor;
|
|
DecimalPlaces := SF.DecimalPlaces;
|
|
EFColors.Error.Assign(SF.EFColors.Error);
|
|
EFColors.Highlight.Assign(SF.EFColors.Highlight);
|
|
MaxLength := SF.MaxLength;
|
|
Options := SF.Options;
|
|
PadChar := SF.PadChar;
|
|
PasswordChar := SF.PasswordChar;
|
|
PictureMask := SF.PictureMask;
|
|
RangeHi := SF.RangeHi;
|
|
RangeLo := SF.RangeLo;
|
|
TextMargin := SF.TextMargin;
|
|
Uninitialized := SF.Uninitialized;
|
|
ZeroDisplay := SF.ZeroDisplay;
|
|
ZeroDisplayValue := SF.ZeroDisplayValue;
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
constructor TOvcCustomSimpleField.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FSimpleDataType := sftString;
|
|
FPictureMask := pmAnyChar;
|
|
|
|
efFieldClass := fcSimple;
|
|
efDataType := sfGetDataType(FSimpleDataType);
|
|
efPicture[0] := pmAnyChar;
|
|
efPicture[1] := #0;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.CreateWnd;
|
|
var
|
|
P : array[0..MaxEditLen+1] of Byte;
|
|
begin
|
|
{save field data}
|
|
if efSaveData then
|
|
efTransfer(@P, otf_GetData);
|
|
|
|
inherited CreateWnd;
|
|
|
|
sfSetDefaultRanges;
|
|
efSetInitialValue;
|
|
|
|
{if we saved the field data, restore it}
|
|
if efSaveData then
|
|
efTransfer(@P, otf_SetData);
|
|
|
|
{set save data flag}
|
|
efSaveData := True;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.efEdit(var Msg : TMessage; Cmd : Word);
|
|
{-process the specified editing command}
|
|
|
|
procedure EditSimple(var Msg : TMessage; Cmd : Word);
|
|
{-process the specified editing command for String and PChar fields}
|
|
label
|
|
ExitPoint;
|
|
var
|
|
SaveHPos : Word;
|
|
DelEnd : Word;
|
|
Len : Word;
|
|
Ch : AnsiChar;
|
|
PrevCh : AnsiChar;
|
|
MF : ShortInt;
|
|
HaveSel : Boolean;
|
|
SelExtended : Boolean;
|
|
|
|
function CharIsOK : Boolean;
|
|
{-return true if Ch can be added to the string}
|
|
var
|
|
PrevCh : AnsiChar;
|
|
begin
|
|
if efIsNumericType then
|
|
if Ch = IntlSupport.DecimalChar then
|
|
Ch := pmDecimalPt
|
|
else if Ch = pmDecimalPt then
|
|
Ch := #0;
|
|
if (Ch < ' ') and not (sefLiteral in sefOptions) then begin
|
|
CharIsOK := False;
|
|
Exit;
|
|
end;
|
|
if efHPos = 0 then
|
|
PrevCh := ' '
|
|
else
|
|
PrevCh := efEditSt[efHPos-1];
|
|
CharIsOK := efCharOK(efPicture[0], Ch, PrevCh, True);
|
|
if efIsNumericType and (Ch = pmDecimalPt) then
|
|
Ch := IntlSupport.DecimalChar;
|
|
end;
|
|
|
|
function CheckAutoAdvance(SP : Integer) : Boolean;
|
|
{-see if we need to auto-advance to next/previous field}
|
|
begin
|
|
CheckAutoAdvance := False;
|
|
if (SP < 0) and
|
|
(efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
|
|
efMoveFocusToPrevField;
|
|
CheckAutoAdvance := True;
|
|
end else if (SP >= MaxLength) then
|
|
if (Cmd = ccChar) and
|
|
(efoAutoAdvanceChar in Controller.EntryOptions) then begin
|
|
efMoveFocusToNextField;
|
|
CheckAutoAdvance := True;
|
|
end else if (Cmd <> ccChar) and
|
|
(efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
|
|
efMoveFocusToNextField;
|
|
CheckAutoAdvance := True;
|
|
end;
|
|
end;
|
|
|
|
procedure FixSelValues;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
if efSelStart > efSelEnd then begin
|
|
I := efSelStart;
|
|
efSelStart := efSelEnd;
|
|
efSelEnd := I;
|
|
end;
|
|
end;
|
|
|
|
procedure UpdateSel;
|
|
begin
|
|
if efSelStart = SaveHPos then
|
|
efSelStart := efHPos
|
|
else
|
|
efSelEnd := efHPos;
|
|
FixSelValues;
|
|
end;
|
|
|
|
procedure WordLeftPrim;
|
|
begin
|
|
Dec(efHPos);
|
|
while (efHPos >= 0) and ((efHPos >= Len) or (efEditSt[efHPos] = ' ')) do
|
|
Dec(efHPos);
|
|
while (efHPos >= 0) and (efEditSt[efHPos] <> ' ') do
|
|
Dec(efHPos);
|
|
Inc(efHPos);
|
|
end;
|
|
|
|
procedure WordRightPrim;
|
|
begin
|
|
if efEditSt[efHPos] <> ' ' then
|
|
Inc(efHPos);
|
|
while (efHPos < Len) and (efEditSt[efHPos] <> ' ') do
|
|
Inc(efHPos);
|
|
while (efHPos < Len) and (efEditSt[efHPos] = ' ') do
|
|
Inc(efHPos);
|
|
end;
|
|
|
|
procedure DeleteSel;
|
|
begin
|
|
StrStDeletePrim(efEditSt, efSelStart, efSelEnd-efSelStart);
|
|
Len := StrLen(efEditSt);
|
|
efHPos := efSelStart;
|
|
efSelEnd := efHPos;
|
|
MF := 10;
|
|
end;
|
|
|
|
procedure PastePrim(P : PAnsiChar);
|
|
var
|
|
Ch : AnsiChar;
|
|
IsNum : Boolean;
|
|
begin
|
|
if HaveSel then
|
|
DeleteSel;
|
|
IsNum := efIsNumericType;
|
|
while P^ <> #0 do begin
|
|
Ch := P^;
|
|
if IsNum then
|
|
if Ch = IntlSupport.DecimalChar then
|
|
Ch := pmDecimalPt
|
|
else if (Ch = pmDecimalPt) or (Ch = ' ') then
|
|
Ch := #0;
|
|
if efCharOK(efPicture[0], Ch, #255, True) then begin
|
|
if (Len = MaxLength) and (efHPos < Len) and
|
|
(efoInsertPushes in Controller.EntryOptions) then begin
|
|
Dec(Len);
|
|
efEditSt[Len] := #0;
|
|
end;
|
|
if (Len < MaxLength) then begin
|
|
if efIsNumericType and (Ch = pmDecimalPt) then
|
|
Ch := IntlSupport.DecimalChar;
|
|
StrChInsertPrim(efEditSt, Ch, efHPos);
|
|
Inc(efHPos);
|
|
Inc(Len);
|
|
end;
|
|
MF := 10;
|
|
end;
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
HaveSel := efSelStart <> efSelEnd;
|
|
MF := Ord(HaveSel);
|
|
SaveHPos := efHPos;
|
|
SelExtended := False;
|
|
|
|
case Cmd of
|
|
ccAccept : {};
|
|
ccCtrlChar : Include(sefOptions, sefLiteral);
|
|
else
|
|
if Cmd <> ccChar then
|
|
Exclude(sefOptions, sefLiteral);
|
|
end;
|
|
|
|
Len := StrLen(efEditSt);
|
|
Exclude(sefOptions, sefCharOK);
|
|
|
|
case Cmd of
|
|
ccChar :
|
|
begin
|
|
Ch := AnsiChar(Lo(Msg.wParam));
|
|
if (sefAcceptChar in sefOptions) and CharIsOk then begin
|
|
Exclude(sefOptions, sefAcceptChar);
|
|
Exclude(sefOptions, sefLiteral);
|
|
if HaveSel then begin
|
|
DeleteSel;
|
|
if efHPos = 0 then
|
|
PrevCh := ' '
|
|
else
|
|
PrevCh := efEditSt[efHPos-1];
|
|
efCharOK(efPicture[0], Ch, PrevCh, True);
|
|
end;
|
|
if (sefInsert in sefOptions) then begin
|
|
if (Len = MaxLength) and (efHPos < Len) and
|
|
(efoInsertPushes in Controller.EntryOptions) then begin
|
|
Dec(Len);
|
|
efEditSt[Len] := #0;
|
|
end;
|
|
if (Len < MaxLength) then begin
|
|
StrChInsertPrim(efEditSt, Ch, efHPos);
|
|
Inc(efHPos);
|
|
CheckAutoAdvance(efHPos);
|
|
end else if not CheckAutoAdvance(efHPos) then
|
|
efConditionalBeep;
|
|
end else if (efHPos+1) <= MaxLength then begin
|
|
efEditSt[efHPos] := Ch;
|
|
if efHPos >= Len then
|
|
efEditSt[efHPos+1] := #0;
|
|
Inc(efHPos);
|
|
CheckAutoAdvance(efHPos);
|
|
end else begin
|
|
if not CheckAutoAdvance(efHPos) then
|
|
efConditionalBeep;
|
|
Dec(MF, 10);
|
|
end;
|
|
Inc(MF, 10);
|
|
end else begin
|
|
Exclude(sefOptions, sefLiteral);
|
|
if sefAcceptChar in sefOptions then
|
|
efConditionalBeep
|
|
else
|
|
goto ExitPoint;
|
|
end;
|
|
end;
|
|
ccMouse :
|
|
if Len > 0 then begin
|
|
efHPos := efGetMousePos(SmallInt(Msg.lParamLo));
|
|
{drag highlight initially if shift key is being pressed}
|
|
if (GetKeyState(vk_Shift) < 0) then begin
|
|
SelExtended := True;
|
|
if HaveSel then begin
|
|
if efHPos > efSelStart then
|
|
efSelEnd := efHPos
|
|
else
|
|
efSelStart := efHPos;
|
|
end else begin
|
|
efSelStart := SaveHPos;
|
|
efSelEnd := efHPos;
|
|
end;
|
|
FixSelValues;
|
|
end else begin
|
|
SetSelection(efHPos, efHPos);
|
|
efPositionCaret(False);
|
|
end;
|
|
end;
|
|
ccMouseMove :
|
|
if Len > 0 then begin
|
|
efHPos := efGetMousePos(SmallInt(Msg.lParamLo));
|
|
UpdateSel;
|
|
end;
|
|
ccDblClk :
|
|
if Len > 0 then begin
|
|
efHPos := efGetMousePos(SmallInt(Msg.lParamLo));
|
|
WordLeftPrim;
|
|
SaveHPos := efHPos;
|
|
efSelStart := SaveHPos;
|
|
efSelEnd := SaveHPos;
|
|
WordRightPrim;
|
|
UpdateSel;
|
|
end;
|
|
{$IFDEF LCL} //LCL form not seeing tab (?), so handle tab command here}
|
|
ccTab : efMoveFocusToNextField;
|
|
{$ENDIF}
|
|
ccLeft :
|
|
if efHPos > 0 then
|
|
Dec(efHPos)
|
|
else
|
|
CheckAutoAdvance(-1);
|
|
ccRight :
|
|
if efHPos < Len then
|
|
Inc(efHPos)
|
|
else
|
|
CheckAutoAdvance(MaxLength);
|
|
ccUp :
|
|
if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
|
|
efMoveFocusToPrevField
|
|
else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
|
|
IncreaseValue(True, 1)
|
|
else if efHPos > 0 then
|
|
Dec(efHPos)
|
|
else
|
|
CheckAutoAdvance(-1);
|
|
ccDown :
|
|
if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
|
|
efMoveFocusToNextField
|
|
else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
|
|
DecreaseValue(True, 1)
|
|
else if efHPos < Len then
|
|
Inc(efHPos)
|
|
else
|
|
CheckAutoAdvance(MaxLength);
|
|
ccWordLeft :
|
|
if efHPos > 0 then
|
|
WordLeftPrim
|
|
else
|
|
CheckAutoAdvance(-1);
|
|
ccWordRight :
|
|
if efHPos < Len then
|
|
WordRightPrim
|
|
else
|
|
CheckAutoAdvance(MaxLength);
|
|
ccHome :
|
|
efHPos := 0;
|
|
ccEnd :
|
|
efHPos := Len;
|
|
ccExtendLeft :
|
|
if efHPos > 0 then begin
|
|
Dec(efHPos);
|
|
UpdateSel;
|
|
end else
|
|
MF := -1;
|
|
ccExtendRight :
|
|
if efHPos < Len then begin
|
|
Inc(efHPos);
|
|
UpdateSel;
|
|
end else
|
|
MF := -1;
|
|
ccExtendHome :
|
|
begin
|
|
efHPos := 0;
|
|
UpdateSel;
|
|
end;
|
|
ccExtendEnd :
|
|
begin
|
|
efHPos := Len;
|
|
UpdateSel;
|
|
end;
|
|
ccExtWordLeft :
|
|
if efHPos > 0 then begin
|
|
WordLeftPrim;
|
|
UpdateSel;
|
|
end else
|
|
MF := -1;
|
|
ccExtWordRight :
|
|
if efHPos < Len then begin
|
|
WordRightPrim;
|
|
UpdateSel;
|
|
end else
|
|
MF := -1;
|
|
ccCut :
|
|
if HaveSel then
|
|
DeleteSel;
|
|
ccCopy : efCopyPrim;
|
|
ccPaste :
|
|
{for some reason, a paste action within the IDE}
|
|
{gets passed to the control. filter it out}
|
|
if not (csDesigning in ComponentState) then
|
|
PastePrim(PAnsiChar(Msg.lParam));
|
|
ccBack :
|
|
if HaveSel then
|
|
DeleteSel
|
|
else if efHPos > 0 then begin
|
|
Dec(efHPos);
|
|
StrStDeletePrim(efEditSt, efHPos, 1);
|
|
MF := 10;
|
|
end;
|
|
ccDel :
|
|
if HaveSel then
|
|
DeleteSel
|
|
else if efHPos < Len then begin
|
|
StrStDeletePrim(efEditSt, efHPos, 1);
|
|
MF := 10;
|
|
end;
|
|
ccDelWord :
|
|
if HaveSel then
|
|
DeleteSel
|
|
else if efHPos < Len then begin
|
|
{start deleting at the caret}
|
|
DelEnd := efHPos;
|
|
|
|
{delete all of the current word, if any}
|
|
if efEditSt[efHPos] <> ' ' then
|
|
while (efEditSt[DelEnd] <> ' ') and (DelEnd < Len) do
|
|
Inc(DelEnd);
|
|
|
|
{delete any spaces prior to the next word, if any}
|
|
while (efEditSt[DelEnd] = ' ') and (DelEnd < Len) do
|
|
Inc(DelEnd);
|
|
|
|
StrStDeletePrim(efEditSt, efHPos, DelEnd-efHPos);
|
|
MF := 10;
|
|
end;
|
|
ccDelLine :
|
|
if Len > 0 then begin
|
|
efEditSt[0] := #0;
|
|
efHPos := 0;
|
|
MF := 10;
|
|
end;
|
|
ccDelEol :
|
|
if efHPos < Len then begin
|
|
efEditSt[efHPos] := #0;
|
|
MF := 10;
|
|
end;
|
|
ccDelBol :
|
|
if Len > 0 then begin
|
|
StrStDeletePrim(efEditSt, 0, efHPos);
|
|
efHPos := 0;
|
|
MF := 10;
|
|
end;
|
|
ccIns :
|
|
begin
|
|
if sefInsert in sefOptions then
|
|
Exclude(sefOptions, sefInsert)
|
|
else
|
|
Include(sefOptions, sefInsert);
|
|
efCaret.InsertMode := (sefInsert in sefOptions);
|
|
end;
|
|
ccRestore : Restore;
|
|
ccAccept :
|
|
begin
|
|
Include(sefOptions, sefCharOK);
|
|
Include(sefOptions, sefAcceptChar);
|
|
Exit;
|
|
end;
|
|
ccDec :
|
|
DecreaseValue(True, 1);
|
|
ccInc :
|
|
IncreaseValue(True, 1);
|
|
ccCtrlChar, ccSuppress, ccPartial :
|
|
goto ExitPoint;
|
|
else
|
|
Include(sefOptions, sefCharOK);
|
|
goto ExitPoint;
|
|
end;
|
|
Exclude(sefOptions, sefAcceptChar);
|
|
|
|
case Cmd of
|
|
ccRestore, ccMouseMove, ccDblClk,
|
|
ccExtendLeft, ccExtendRight,
|
|
ccExtendHome, ccExtendEnd,
|
|
ccExtWordLeft, ccExtWordRight :
|
|
Inc(MF);
|
|
ccMouse :
|
|
if SelExtended then
|
|
Inc(MF);
|
|
ccCut, ccCopy, ccPaste : {};
|
|
else
|
|
efSelStart := efHPos;
|
|
efSelEnd := efHPos;
|
|
end;
|
|
|
|
ExitPoint:
|
|
if efPositionCaret(True) then
|
|
Inc(MF);
|
|
if MF >= 10 then
|
|
efFieldModified;
|
|
if MF > 0 then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure EditChar(var Msg : TMessage; Cmd : Word);
|
|
{-process the specified editing command for Char fields}
|
|
label
|
|
ExitPoint;
|
|
var
|
|
MF : Byte;
|
|
Ch : AnsiChar;
|
|
|
|
function CharIsOK : Boolean;
|
|
{-return true if Ch can be added to the string}
|
|
begin
|
|
if (Ch < ' ') and not (sefLiteral in sefOptions) then
|
|
CharIsOK := False
|
|
else
|
|
CharIsOK := efCharOK(efPicture[0], Ch, ' ', True);
|
|
end;
|
|
|
|
function CheckAutoAdvance(SP : Integer) : Boolean;
|
|
{-see if we need to auto-advance to next/previous field}
|
|
begin
|
|
CheckAutoAdvance := False;
|
|
if (SP < 0) and
|
|
(efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
|
|
efMoveFocusToPrevField;
|
|
Result := True;
|
|
end else if (SP > 0) then
|
|
if (Cmd = ccChar) and
|
|
(efoAutoAdvanceChar in Controller.EntryOptions) then begin
|
|
efMoveFocusToNextField;
|
|
Result := True;
|
|
end else if (Cmd <> ccChar) and
|
|
(efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
|
|
efMoveFocusToNextField;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure PastePrim(P : PAnsiChar);
|
|
begin
|
|
while P^ <> #0 do begin
|
|
Ch := P^;
|
|
if efCharOK(efPicture[0], Ch, #255, True) then begin
|
|
efEditSt[0] := Ch;
|
|
MF := 10;
|
|
Exit;
|
|
end;
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
MF := Ord(efSelStart <> efSelEnd);
|
|
case Cmd of
|
|
ccAccept : ;
|
|
ccCtrlChar :
|
|
Include(sefOptions, sefLiteral);
|
|
else
|
|
efHPos := 0;
|
|
if Cmd <> ccChar then
|
|
Exclude(sefOptions, sefLiteral);
|
|
end;
|
|
|
|
Exclude(sefOptions, sefCharOK);
|
|
case Cmd of
|
|
ccChar :
|
|
begin
|
|
Ch := AnsiChar(Lo(Msg.wParam));
|
|
if sefAcceptChar in sefOptions then
|
|
if CharIsOk then begin
|
|
efEditSt[0] := Ch;
|
|
efEditSt[1] := #0;
|
|
CheckAutoAdvance(1);
|
|
MF := 10;
|
|
end else
|
|
efConditionalBeep;
|
|
{end;}
|
|
sefOptions := sefOptions - [sefAcceptChar, sefLiteral];
|
|
end;
|
|
ccLeft, ccWordLeft :
|
|
CheckAutoAdvance(-1);
|
|
ccRight, ccWordRight :
|
|
CheckAutoAdvance(MaxLength);
|
|
ccUp :
|
|
if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
|
|
efMoveFocusToPrevField
|
|
else
|
|
CheckAutoAdvance(-1);
|
|
ccDown :
|
|
if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
|
|
efMoveFocusToNextField
|
|
else
|
|
CheckAutoAdvance(MaxLength);
|
|
ccRestore :
|
|
Restore;
|
|
ccExtendRight, ccExtendEnd, ccExtWordRight :
|
|
efSelEnd := 1;
|
|
ccMouseMove :
|
|
if efGetMousePos(SmallInt(Msg.lParamLo)) > 0 then
|
|
efSelEnd := 1
|
|
else
|
|
efSelEnd := 0;
|
|
ccDblClk :
|
|
efSelEnd := 1;
|
|
ccCopy : efCopyPrim;
|
|
ccPaste :
|
|
{for some reason, a paste action within the IDE}
|
|
{gets passed to the control. filter it out}
|
|
if not (csDesigning in ComponentState) then
|
|
PastePrim(PAnsiChar(Msg.lParam));
|
|
ccAccept :
|
|
begin
|
|
sefOptions := sefOptions + [sefCharOK, sefAcceptChar];
|
|
Exit;
|
|
end;
|
|
ccMouse, ccExtendLeft, ccExtendHome, ccExtWordLeft : ;
|
|
ccDec :
|
|
DecreaseValue(True, 1);
|
|
ccInc :
|
|
IncreaseValue(True, 1);
|
|
ccCtrlChar, ccSuppress, ccPartial :
|
|
goto ExitPoint;
|
|
else
|
|
Include(sefOptions, sefCharOK);
|
|
goto ExitPoint;
|
|
end;
|
|
Exclude(sefOptions, sefAcceptChar);
|
|
|
|
case Cmd of
|
|
ccRestore, ccMouseMove, ccDblClk, ccExtendRight,
|
|
ccExtendEnd, ccExtWordRight :
|
|
Inc(MF);
|
|
else
|
|
efSelStart := 0;
|
|
efSelEnd := 0;
|
|
end;
|
|
|
|
ExitPoint:
|
|
if efPositionCaret(True) then
|
|
Inc(MF);
|
|
if MF >= 10 then
|
|
efFieldModified;
|
|
if MF > 0 then
|
|
Invalidate;
|
|
end;
|
|
|
|
begin {edit}
|
|
case FSimpleDataType of
|
|
sftString,
|
|
sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
|
|
sftReal, sftExtended, sftDouble, sftSingle, sftComp :
|
|
EditSimple(Msg, Cmd);
|
|
sftChar, sftBoolean, sftYesNo :
|
|
EditChar(Msg, Cmd);
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomSimpleField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
|
|
{-return the display string in Dest and a pointer as the result}
|
|
var
|
|
Len : Word;
|
|
begin
|
|
Result := inherited efGetDisplayString(Dest, Size);
|
|
|
|
Len := StrLen(Dest);
|
|
if Len = 0 then
|
|
Exit;
|
|
|
|
if Uninitialized and not (sefHaveFocus in sefOptions) then begin
|
|
FillChar(Dest[0], Len, ' ');
|
|
Exit;
|
|
end;
|
|
|
|
if (efoPasswordMode in Options) then
|
|
FillChar(Dest[0], Len, PasswordChar);
|
|
|
|
if PadChar <> ' ' then begin
|
|
FillChar(Dest[Len], MaxLength-Len, PadChar);
|
|
Dest[MaxLength] := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.efIncDecValue(Wrap : Boolean; Delta : Double);
|
|
{-increment field by Delta}
|
|
var
|
|
S : TEditString;
|
|
|
|
procedure IncDecValueChar;
|
|
{-increment Char field by Delta}
|
|
var
|
|
C, CC, CL, CH, MC : AnsiChar;
|
|
OK : Boolean;
|
|
begin
|
|
{get valid range}
|
|
CL := efRangeLo.rtChar;
|
|
CH := efRangeHi.rtChar;
|
|
if CL = CH then begin
|
|
CL := #1;
|
|
CH := #255;
|
|
end;
|
|
|
|
{get current character}
|
|
C := efEditSt[0];
|
|
|
|
{get mask character}
|
|
MC := efPicture[0];
|
|
|
|
{exit if we're at the range limit and not allowed to wrap}
|
|
if (Delta < 0) and (C = CL) then begin
|
|
if not Wrap then
|
|
Exit;
|
|
end else if (Delta > 0) and (C = CH) then
|
|
if not Wrap then
|
|
Exit;
|
|
|
|
{find the next/prev allowable character}
|
|
OK := False;
|
|
repeat
|
|
repeat
|
|
if Delta = 1 then
|
|
Inc(C)
|
|
else
|
|
Dec(C);
|
|
CC := C;
|
|
efFixCase(MC, CC, ' ');
|
|
until efCharOK(MC, C, ' ', False) and (C = CC);
|
|
|
|
{check result to see if it's in valid range}
|
|
if (C >= CL) and (C <= CH) then
|
|
OK := True
|
|
else if Wrap then
|
|
OK := False
|
|
else
|
|
Exit;
|
|
until OK;
|
|
|
|
efTransfer(@C, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
|
|
procedure IncDecValueBoolean;
|
|
var
|
|
Ch : AnsiChar;
|
|
B : Boolean;
|
|
begin
|
|
Ch := UpCaseChar(efEditSt[0]);
|
|
if Ch = IntlSupport.TrueChar then
|
|
Ch := IntlSupport.FalseChar
|
|
else
|
|
Ch := IntlSupport.TrueChar;
|
|
B := Ch = IntlSupport.TrueChar;
|
|
|
|
efTransfer(@B, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
|
|
procedure IncDecValueYesNo;
|
|
var
|
|
Ch : AnsiChar;
|
|
B : Boolean;
|
|
begin
|
|
Ch := UpCaseChar(efEditSt[0]);
|
|
if Ch = IntlSupport.YesChar then
|
|
Ch := IntlSupport.NoChar
|
|
else
|
|
Ch := IntlSupport.YesChar;
|
|
B := Ch = IntlSupport.YesChar;
|
|
|
|
efTransfer(@B, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
|
|
procedure IncDecValueLongInt;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if efStr2Long(efEditSt, L) then begin
|
|
if (Delta < 0) and (L <= efRangeLo.rtLong) then
|
|
if Wrap then
|
|
L := efRangeHi.rtLong
|
|
else Exit
|
|
else if (Delta > 0) and (L >= efRangeHi.rtLong) then
|
|
if Wrap then
|
|
L := efRangeLo.rtLong
|
|
else Exit
|
|
else
|
|
Inc(L, Trunc(Delta));
|
|
|
|
{insure valid value}
|
|
if L < efRangeLo.rtLong then
|
|
L := efRangeLo.rtLong;
|
|
if L > efRangeHi.rtLong then
|
|
L := efRangeHi.rtLong;
|
|
|
|
efTransfer(@L, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
end;
|
|
|
|
procedure IncDecValueReal;
|
|
var
|
|
Re : Real;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to a real}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, Re, Code);
|
|
{$ELSE}
|
|
Val(String(S), Re, Code);
|
|
{$ENDIF}
|
|
if Code = 0 then begin
|
|
if (Delta < 0) and (Re <= efRangeLo.rtReal) then
|
|
if Wrap then
|
|
Re := efRangeHi.rtReal
|
|
else Exit
|
|
else if (Delta > 0) and (Re >= efRangeHi.rtReal) then
|
|
if Wrap then
|
|
Re := efRangeLo.rtReal
|
|
else Exit
|
|
else
|
|
Re := Re + Delta;
|
|
|
|
{insure valid value}
|
|
if Re < efRangeLo.rtReal then
|
|
Re := efRangeLo.rtReal;
|
|
if Re > efRangeHi.rtReal then
|
|
Re := efRangeHi.rtReal;
|
|
|
|
efTransfer(@Re, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
end;
|
|
|
|
procedure IncDecValueExtended;
|
|
var
|
|
Ex : Extended;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an real}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, Ex, Code);
|
|
{$ELSE}
|
|
Val(String(S), Ex, Code);
|
|
{$ENDIF}
|
|
if Code = 0 then begin
|
|
if (Delta < 0) and (Ex <= efRangeLo.rtExt) then
|
|
if Wrap then
|
|
Ex := efRangeHi.rtExt
|
|
else Exit
|
|
else if (Delta > 0) and (Ex >= efRangeHi.rtExt) then
|
|
if Wrap then
|
|
Ex := efRangeLo.rtExt
|
|
else Exit
|
|
else
|
|
Ex := Ex + Delta;
|
|
|
|
{insure valid value}
|
|
if Ex < efRangeLo.rtExt then
|
|
Ex := efRangeLo.rtExt;
|
|
if Ex > efRangeHi.rtExt then
|
|
Ex := efRangeHi.rtExt;
|
|
|
|
efTransfer(@Ex, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
end;
|
|
|
|
procedure IncDecValueDouble;
|
|
var
|
|
Db : Double;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an real}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, Db, Code);
|
|
{$ELSE}
|
|
Val(String(S), Db, Code);
|
|
{$ENDIF}
|
|
if Code = 0 then begin
|
|
if (Delta < 0) and (Db <= efRangeLo.rtExt) then
|
|
if Wrap then
|
|
Db := efRangeHi.rtExt
|
|
else Exit
|
|
else if (Delta > 0) and (Db >= efRangeHi.rtExt) then
|
|
if Wrap then
|
|
Db := efRangeLo.rtExt
|
|
else Exit
|
|
else
|
|
Db := Db + Delta;
|
|
|
|
{insure valid value}
|
|
if Db < efRangeLo.rtExt then
|
|
Db := efRangeLo.rtExt;
|
|
if Db > efRangeHi.rtExt then
|
|
Db := efRangeHi.rtExt;
|
|
|
|
efTransfer(@Db, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
end;
|
|
|
|
procedure IncDecValueSingle;
|
|
var
|
|
Si : Single;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an real}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, Si, Code);
|
|
{$ELSE}
|
|
Val(String(S), Si, Code);
|
|
{$ENDIF}
|
|
if Code = 0 then begin
|
|
if (Delta < 0) and (Si <= efRangeLo.rtExt) then
|
|
if Wrap then
|
|
Si := efRangeHi.rtExt
|
|
else Exit
|
|
else if (Delta > 0) and (Si >= efRangeHi.rtExt) then
|
|
if Wrap then
|
|
Si := efRangeLo.rtExt
|
|
else Exit
|
|
else
|
|
Si := Si + Delta;
|
|
|
|
{insure valid value}
|
|
if Si < efRangeLo.rtExt then
|
|
Si := efRangeLo.rtExt;
|
|
if Si > efRangeHi.rtExt then
|
|
Si := efRangeHi.rtExt;
|
|
|
|
efTransfer(@Si, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
end;
|
|
|
|
procedure IncDecValueComp;
|
|
var
|
|
{$IFNDEF FPC}
|
|
Co : Comp;
|
|
{$ELSE}
|
|
{$IFDEF CPU86}
|
|
Co : Comp;
|
|
{$ELSE}
|
|
Co : Double;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an real}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, Co, Code);
|
|
{$ELSE}
|
|
Val(String(S), Co, Code);
|
|
{$ENDIF}
|
|
if Code = 0 then begin
|
|
if (Delta < 0) and (Co <= efRangeLo.rtExt) then
|
|
if Wrap then
|
|
Co := efRangeHi.rtExt
|
|
else Exit
|
|
else if (Delta > 0) and (Co >= efRangeHi.rtExt) then
|
|
if Wrap then
|
|
Co := efRangeLo.rtExt
|
|
else Exit
|
|
else
|
|
Co := Co + Delta;
|
|
|
|
{insure valid value}
|
|
if Co < efRangeLo.rtExt then
|
|
Co := efRangeLo.rtExt;
|
|
if Co > efRangeHi.rtExt then
|
|
Co := efRangeHi.rtExt;
|
|
|
|
efTransfer(@Co, otf_SetData);
|
|
efPerformRepaint(True);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not (sefHaveFocus in sefOptions) then
|
|
Exit;
|
|
case FSimpleDataType of
|
|
sftString : {not supported for this field type};
|
|
sftChar : IncDecValueChar;
|
|
sftBoolean : IncDecValueBoolean;
|
|
sftYesNo : IncDecValueYesNo;
|
|
sftLongInt,
|
|
sftWord,
|
|
sftInteger,
|
|
sftByte,
|
|
sftShortInt : IncDecValueLongInt;
|
|
sftReal : IncDecValueReal;
|
|
sftExtended : IncDecValueExtended;
|
|
sftDouble : IncDecValueDouble;
|
|
sftSingle : IncDecValueSingle;
|
|
sftComp : IncDecValueComp;
|
|
else
|
|
raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
|
|
end;
|
|
efPositionCaret(False);
|
|
end;
|
|
|
|
function TOvcCustomSimpleField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
|
|
{-transfer data to/from the entry fields}
|
|
var
|
|
S : TEditString;
|
|
|
|
procedure TransferString;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
if TransferFlag = otf_GetData then
|
|
ShortString(DataPtr^) := StrPas(efEditSt)
|
|
else begin
|
|
if ShortString(DataPtr^) = '' then
|
|
efEditSt[0] := #0
|
|
else begin
|
|
StrPLCopy(efEditSt, ShortString(DataPtr^), MaxLength);
|
|
for I := 0 to Integer(StrLen(efEditSt))-1 do
|
|
efFixCase(efNthMaskChar(I), efEditSt[I], #255);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TransferChar;
|
|
begin
|
|
if TransferFlag = otf_GetData then
|
|
AnsiChar(DataPtr^) := efEditSt[0]
|
|
else begin
|
|
efEditSt[0] := AnsiChar(DataPtr^);
|
|
efEditSt[1] := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TransferBoolean;
|
|
begin
|
|
if TransferFlag = otf_GetData then
|
|
Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.TrueChar)
|
|
else begin
|
|
if Boolean(DataPtr^) then
|
|
efEditSt[0] := IntlSupport.TrueChar
|
|
else
|
|
efEditSt[0] := IntlSupport.FalseChar;
|
|
efEditSt[1] := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TransferYesNo;
|
|
begin
|
|
if TransferFlag = otf_GetData then
|
|
Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.YesChar)
|
|
else begin
|
|
if Boolean(DataPtr^) then
|
|
efEditSt[0] := IntlSupport.YesChar
|
|
else
|
|
efEditSt[0] := IntlSupport.NoChar;
|
|
efEditSt[1] := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TransferLongInt;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
if not efStr2Long(efEditSt, LongInt(DataPtr^)) then
|
|
LongInt(DataPtr^) := 0;
|
|
end else
|
|
efLong2Str(efEditSt, LongInt(DataPtr^));
|
|
end;
|
|
|
|
procedure TransferWord;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
if efStr2Long(efEditSt, L) then
|
|
Word(DataPtr^) := Word(L)
|
|
else
|
|
Word(DataPtr^) := 0;
|
|
end else
|
|
efLong2Str(efEditSt, Word(DataPtr^));
|
|
end;
|
|
|
|
procedure TransferInteger;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
if efStr2Long(efEditSt, L) then
|
|
SmallInt(DataPtr^) := SmallInt(L)
|
|
else
|
|
SmallInt(DataPtr^) := 0;
|
|
end else
|
|
efLong2Str(efEditSt, SmallInt(DataPtr^));
|
|
end;
|
|
|
|
procedure TransferByte;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
if efStr2Long(efEditSt, L) then
|
|
Byte(DataPtr^) := Byte(L)
|
|
else
|
|
Byte(DataPtr^) := 0;
|
|
end else
|
|
efLong2Str(efEditSt, Byte(DataPtr^));
|
|
end;
|
|
|
|
procedure TransferShortInt;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
if efStr2Long(efEditSt, L) then
|
|
ShortInt(DataPtr^) := ShortInt(L)
|
|
else
|
|
ShortInt(DataPtr^) := 0;
|
|
end else
|
|
efLong2Str(efEditSt, ShortInt(DataPtr^));
|
|
end;
|
|
|
|
procedure TransferReal;
|
|
label
|
|
UseExp;
|
|
var
|
|
Code : Integer;
|
|
I : Cardinal;
|
|
R : Real;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
StrCopy(S, efEditSt);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(PAnsiChar(@S[0]), R, Code);
|
|
{$ELSE}
|
|
Val(String(PAnsiChar(@S[0])), R, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
R := 0;
|
|
Real(DataPtr^) := R;
|
|
end else begin
|
|
{try to use regular notation}
|
|
R := Real(DataPtr^);
|
|
if StrScan(efPicture, pmScientific) <> nil then
|
|
goto UseExp;
|
|
Str(R:0:DecimalPlaces, S);
|
|
|
|
{trim trailing 0's if appropriate}
|
|
if StrScan(S, pmDecimalPt) <> nil then
|
|
TrimTrailingZerosPChar(S);
|
|
|
|
{does it fit?}
|
|
if StrLen(S) > MaxLength then begin
|
|
{won't fit--use scientific notation}
|
|
UseExp:
|
|
if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
|
|
Str(R:9+DecimalPlaces, S)
|
|
else
|
|
Str(R:MaxLength, S);
|
|
TrimAllSpacesPChar(S);
|
|
TrimEmbeddedZerosPChar(S);
|
|
end;
|
|
|
|
{convert decimal point}
|
|
if StrChPos(S, pmDecimalPt, I) then
|
|
S[I] := IntlSupport.DecimalChar;
|
|
|
|
StrLCopy(efEditSt, S, MaxLength);
|
|
end;
|
|
end;
|
|
|
|
procedure TransferExtended;
|
|
label
|
|
UseExp;
|
|
var
|
|
Code : Integer;
|
|
I : Cardinal;
|
|
E : Extended;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
StrCopy(S, efEditSt);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, E, Code);
|
|
{$ELSE}
|
|
Val(String(S), E, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
E := 0;
|
|
Extended(DataPtr^) := E;
|
|
end else begin
|
|
{try to use regular notation}
|
|
E := Extended(DataPtr^);
|
|
if StrScan(efPicture, pmScientific) <> nil then
|
|
goto UseExp;
|
|
Str(E:0:DecimalPlaces, S);
|
|
|
|
{trim trailing 0's if appropriate}
|
|
if StrScan(S, pmDecimalPt) <> nil then
|
|
TrimTrailingZerosPChar(S);
|
|
|
|
{does it fit?}
|
|
if StrLen(S) > MaxLength then begin
|
|
{won't fit--use scientific notation}
|
|
UseExp:
|
|
if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
|
|
Str(E:9+DecimalPlaces, S)
|
|
else
|
|
Str(E:MaxLength, S);
|
|
TrimAllSpacesPChar(S);
|
|
TrimEmbeddedZerosPChar(S);
|
|
end;
|
|
|
|
{convert decimal point}
|
|
if StrChPos(S, pmDecimalPt, I) then
|
|
S[I] := IntlSupport.DecimalChar;
|
|
|
|
StrLCopy(efEditSt, S, MaxLength);
|
|
end;
|
|
end;
|
|
|
|
procedure TransferDouble;
|
|
label
|
|
UseExp;
|
|
var
|
|
Code : Integer;
|
|
I : Cardinal;
|
|
D : Double;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
StrCopy(S, efEditSt);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(PAnsiChar(@S[0]), D, Code);
|
|
{$ELSE}
|
|
Val(String(PAnsiChar(@S[0])), D, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
D := 0;
|
|
Double(DataPtr^) := D;
|
|
end else begin
|
|
{try to use regular notation}
|
|
D := Double(DataPtr^);
|
|
if StrScan(efPicture, pmScientific) <> nil then
|
|
goto UseExp;
|
|
Str(D:0:DecimalPlaces, S);
|
|
|
|
{trim trailing 0's if appropriate}
|
|
if StrScan(S, pmDecimalPt) <> nil then
|
|
TrimTrailingZerosPChar(S);
|
|
|
|
{does it fit?}
|
|
if StrLen(S) > MaxLength then begin
|
|
{won't fit--use scientific notation}
|
|
UseExp:
|
|
if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
|
|
Str(D:9+DecimalPlaces, S)
|
|
else
|
|
Str(D:MaxLength, S);
|
|
TrimAllSpacesPChar(S);
|
|
TrimEmbeddedZerosPChar(S);
|
|
end;
|
|
|
|
{convert decimal point}
|
|
if StrChPos(S, pmDecimalPt, I) then
|
|
S[I] := IntlSupport.DecimalChar;
|
|
|
|
StrLCopy(efEditSt, S, MaxLength);
|
|
end;
|
|
end;
|
|
|
|
procedure TransferSingle;
|
|
label
|
|
UseExp;
|
|
var
|
|
Code : Integer;
|
|
I : Cardinal;
|
|
G : Single;
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
StrCopy(S, efEditSt);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, G, Code);
|
|
{$ELSE}
|
|
Val(String(S), G, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
G := 0;
|
|
Single(DataPtr^) := G;
|
|
end else begin
|
|
{try to use regular notation}
|
|
G := Single(DataPtr^);
|
|
if StrScan(efPicture, pmScientific) <> nil then
|
|
goto UseExp;
|
|
Str(G:0:DecimalPlaces, S);
|
|
|
|
{trim trailing 0's if appropriate}
|
|
if StrScan(S, pmDecimalPt) <> nil then
|
|
TrimTrailingZerosPChar(S);
|
|
|
|
{does it fit?}
|
|
if StrLen(S) > MaxLength then begin
|
|
{won't fit--use scientific notation}
|
|
UseExp:
|
|
if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
|
|
Str(G:9+DecimalPlaces, S)
|
|
else
|
|
Str(G:MaxLength, S);
|
|
TrimAllSpacesPChar(S);
|
|
TrimEmbeddedZerosPChar(S);
|
|
end;
|
|
|
|
{convert decimal point}
|
|
if StrChPos(S, pmDecimalPt, I) then
|
|
S[I] := IntlSupport.DecimalChar;
|
|
|
|
StrLCopy(efEditSt, S, MaxLength);
|
|
end;
|
|
end;
|
|
|
|
procedure TransferComp;
|
|
{-transfer data to or from Comp fields}
|
|
label
|
|
UseExp;
|
|
var
|
|
Code : Integer;
|
|
{$IFNDEF FPC}
|
|
C : Comp;
|
|
{$ELSE}
|
|
{$IFDEF CPU86}
|
|
C : Comp;
|
|
{$ELSE}
|
|
C : Double;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
begin
|
|
if TransferFlag = otf_GetData then begin
|
|
StrCopy(S, efEditSt);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(PAnsiChar(@S[0]), C, Code);
|
|
{$ELSE}
|
|
Val(String(PAnsiChar(@S[0])), C, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
C := 0;
|
|
{$IFNDEF FPC}
|
|
Comp(DataPtr^) := C;
|
|
{$ELSE}
|
|
{$IFDEF CPU86}
|
|
Comp(DataPtr^) := C;
|
|
{$ELSE}
|
|
Double(DataPtr^) := C;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end else begin
|
|
{try to use regular notation}
|
|
{$IFNDEF FPC}
|
|
C := Comp(DataPtr^);
|
|
{$ELSE}
|
|
{$IFDEF CPU86}
|
|
C := Comp(DataPtr^);
|
|
{$ELSE}
|
|
C := Double(DataPtr^);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
if StrScan(efPicture, pmScientific) <> nil then
|
|
goto UseExp;
|
|
Str(C:0:DecimalPlaces, S);
|
|
|
|
{trim trailing 0's if appropriate}
|
|
if StrScan(S, pmDecimalPt) <> nil then
|
|
TrimTrailingZerosPChar(S);
|
|
|
|
{does it fit?}
|
|
if StrLen(S) > MaxLength then begin
|
|
{won't fit--use scientific notation}
|
|
UseExp:
|
|
Str(C:MaxLength, S);
|
|
TrimAllSpacesPChar(S);
|
|
TrimEmbeddedZerosPChar(S);
|
|
end;
|
|
StrLCopy(efEditSt, S, MaxLength);
|
|
end;
|
|
end;
|
|
|
|
begin {transfer}
|
|
if DataPtr = nil then begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
|
|
case FSimpleDataType of
|
|
sftString : TransferString;
|
|
sftChar : TransferChar;
|
|
sftBoolean : TransferBoolean;
|
|
sftYesNo : TransferYesNo;
|
|
sftLongInt : TransferLongInt;
|
|
sftWord : TransferWord;
|
|
sftInteger : TransferInteger;
|
|
sftByte : TransferByte;
|
|
sftShortInt : TransferShortInt;
|
|
sftReal : TransferReal;
|
|
sftExtended : TransferExtended;
|
|
sftDouble : TransferDouble;
|
|
sftSingle : TransferSingle;
|
|
sftComp : TransferComp;
|
|
else
|
|
raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
|
|
end;
|
|
|
|
Result := inherited efTransfer(DataPtr, TransferFlag);
|
|
end;
|
|
|
|
function TOvcCustomSimpleField.efValidateField : Word;
|
|
{-validate contents of field; result is error code or 0}
|
|
var
|
|
S : TEditString;
|
|
|
|
procedure ValidateString;
|
|
var
|
|
L : Word;
|
|
begin
|
|
if sefGettingValue in sefOptions then
|
|
Exit;
|
|
|
|
if efoTrimBlanks in Options then
|
|
if sefHaveFocus in sefOptions then begin
|
|
L := StrLen(efEditSt);
|
|
TrimAllSpacesPChar(efEditSt);
|
|
if StrLen(efEditSt) <> L then
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateChar;
|
|
begin
|
|
if (efRangeLo.rtChar <> efRangeHi.rtChar) and
|
|
((efEditSt[0] < efRangeLo.rtChar) or (efEditSt[0] > efRangeHi.rtChar)) then
|
|
Result := oeRangeError;
|
|
end;
|
|
|
|
procedure ValidateBoolean;
|
|
begin
|
|
if (UpCaseChar(efEditSt[0]) <> IntlSupport.TrueChar) and
|
|
(UpCaseChar(efEditSt[0]) <> IntlSupport.FalseChar) then
|
|
Result := oeRangeError;
|
|
end;
|
|
|
|
procedure ValidateYesNo;
|
|
begin
|
|
if (UpCaseChar(efEditSt[0]) <> IntlSupport.YesChar) and
|
|
(UpCaseChar(efEditSt[0]) <> IntlSupport.NoChar) then
|
|
Result := oeRangeError;
|
|
end;
|
|
|
|
procedure ValidateLongInt;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if not efStr2Long(efEditSt, L) then
|
|
Result := oeInvalidNumber
|
|
else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
efTransfer(@L, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateWord;
|
|
var
|
|
L : LongInt;
|
|
begin
|
|
if not efStr2Long(efEditSt, L) then
|
|
Result := oeInvalidNumber
|
|
else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
efTransfer(@L, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateInteger;
|
|
var
|
|
L : LongInt;
|
|
I : Integer;
|
|
begin
|
|
if not efStr2Long(efEditSt, L) then
|
|
Result := oeInvalidNumber
|
|
else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
I := L;
|
|
efTransfer(@I, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateByte;
|
|
var
|
|
L : LongInt;
|
|
B : Byte;
|
|
begin
|
|
if not efStr2Long(efEditSt, L) then
|
|
Result := oeInvalidNumber
|
|
else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
B := L;
|
|
efTransfer(@B, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateShortInt;
|
|
var
|
|
L : LongInt;
|
|
Si : ShortInt;
|
|
begin
|
|
if not efStr2Long(efEditSt, L) then
|
|
Result := oeInvalidNumber
|
|
else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
Si := L;
|
|
efTransfer(@Si, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateReal;
|
|
var
|
|
R : Real;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to a real}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, R, Code);
|
|
{$ELSE}
|
|
Val(String(S), R, Code);
|
|
{$ENDIF}
|
|
|
|
{format OK?}
|
|
if Code <> 0 then
|
|
Result := oeInvalidNumber
|
|
else if (R < efRangeLo.rtReal) or (R > efRangeHi.rtReal) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
efTransfer(@R, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateExtended;
|
|
var
|
|
E : Extended;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an extended}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, E, Code);
|
|
{$ELSE}
|
|
Val(String(S), E, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
Result := oeInvalidNumber
|
|
else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
efTransfer(@E, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateDouble;
|
|
var
|
|
E : Extended;
|
|
D : Double;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an extended}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, E, Code);
|
|
{$ELSE}
|
|
Val(String(S), E, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
Result := oeInvalidNumber
|
|
else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
D := E;
|
|
efTransfer(@D, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateSingle;
|
|
var
|
|
E : Extended;
|
|
Si : Single;
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an extended}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, E, Code);
|
|
{$ELSE}
|
|
Val(String(S), E, Code);
|
|
{$ENDIF}
|
|
if Code <> 0 then
|
|
Result := oeInvalidNumber
|
|
else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
Si := E;
|
|
efTransfer(@Si, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure ValidateComp;
|
|
var
|
|
E : Extended;
|
|
{$IFNDEF FPC}
|
|
C : Comp;
|
|
{$ELSE}
|
|
{$IFDEF CPU86}
|
|
C : Comp;
|
|
{$ELSE}
|
|
C : Double;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Code : Integer;
|
|
begin
|
|
{convert efEditSt to an extended}
|
|
StrLCopy(S, efEditSt, 80);
|
|
FixRealPrim(S, IntlSupport.DecimalChar);
|
|
{$IFNDEF FPC}
|
|
Val(S, C, Code);
|
|
{$ELSE}
|
|
Val(String(S), C, Code);
|
|
{$ENDIF}
|
|
E := C;
|
|
if Code <> 0 then
|
|
Result := oeInvalidNumber
|
|
else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
|
|
Result := oeRangeError
|
|
else begin
|
|
if sefHaveFocus in sefOptions then
|
|
if not (sefGettingValue in sefOptions) then begin
|
|
efTransfer(@C, otf_SetData);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := 0;
|
|
case FSimpleDataType of
|
|
sftString : ValidateString;
|
|
sftChar : ValidateChar;
|
|
sftBoolean : ValidateBoolean;
|
|
sftYesNo : ValidateYesNo;
|
|
sftLongInt : ValidateLongInt;
|
|
sftWord : ValidateWord;
|
|
sftInteger : ValidateInteger;
|
|
sftByte : ValidateByte;
|
|
sftShortInt : ValidateShortInt;
|
|
sftReal : ValidateReal;
|
|
sftExtended : ValidateExtended;
|
|
sftDouble : ValidateDouble;
|
|
sftSingle : ValidateSingle;
|
|
sftComp : ValidateComp;
|
|
end;
|
|
|
|
if not (sefUserValidating in sefOptions) then begin
|
|
{user may retrieve data from field. flag that we are doing}
|
|
{user validation to avoid calling this routine recursively}
|
|
Include(sefOptions, sefUserValidating);
|
|
DoOnUserValidation(Result);
|
|
Exclude(sefOptions, sefUserValidating);
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.sfSetDataType(Value : TSimpleDataType);
|
|
{-set the data type for this field}
|
|
begin
|
|
if FSimpleDataType <> Value then begin
|
|
FSimpleDataType := Value;
|
|
efDataType := sfGetDataType(FSimpleDataType);
|
|
Options := Options + [efoCaretToEnd];
|
|
efSetDefaultRange(efDataType);
|
|
|
|
{set defaults for this field type}
|
|
sfResetFieldProperties(FSimpleDataType);
|
|
if HandleAllocated then begin
|
|
{don't save data through create window}
|
|
efSaveData := False;
|
|
{$IFNDEF LCL}
|
|
RecreateWnd;
|
|
{$ELSE}
|
|
MyMisc.RecreateWnd(Self);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.sfSetPictureMask(Value: AnsiChar);
|
|
{-set the picture mask}
|
|
var
|
|
Buf : array[0..1] of AnsiChar;
|
|
begin
|
|
if FPictureMask <> Value then begin
|
|
if Value in SimplePictureChars then begin
|
|
FPictureMask := Value;
|
|
if csDesigning in ComponentState then begin
|
|
efPicture[0] := Value;
|
|
efPicture[1] := #0;
|
|
Repaint;
|
|
end else begin
|
|
Buf[0] := Value;
|
|
Buf[1] := #0;
|
|
efChangeMask(Buf);
|
|
{$IFNDEF LCL}
|
|
RecreateWnd;
|
|
{$ELSE}
|
|
MyMisc.RecreateWnd(Self);
|
|
{$ENDIF}
|
|
end;
|
|
end else
|
|
raise EInvalidPictureMask.Create(Value);
|
|
end;
|
|
end;
|
|
|
|
function TOvcCustomSimpleField.sfGetDataType(Value : TSimpleDataType) : Byte;
|
|
{-return a Byte value representing the type of this field}
|
|
begin
|
|
case Value of
|
|
sftString : Result := fidSimpleString;
|
|
sftChar : Result := fidSimpleChar;
|
|
sftBoolean : Result := fidSimpleBoolean;
|
|
sftYesNo : Result := fidSimpleYesNo;
|
|
sftLongInt : Result := fidSimpleLongInt;
|
|
sftWord : Result := fidSimpleWord;
|
|
sftInteger : Result := fidSimpleInteger;
|
|
sftByte : Result := fidSimpleByte;
|
|
sftShortInt : Result := fidSimpleShortInt;
|
|
sftReal : Result := fidSimpleReal;
|
|
sftExtended : Result := fidSimpleExtended;
|
|
sftDouble : Result := fidSimpleDouble;
|
|
sftSingle : Result := fidSimpleSingle;
|
|
sftComp : Result := fidSimpleComp;
|
|
else
|
|
raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.sfResetFieldProperties(FT : TSimpleDataType);
|
|
{-reset field properties based on current setings}
|
|
|
|
procedure Update(Len: Word; Mask: AnsiChar);
|
|
begin
|
|
MaxLength := Len;
|
|
FPictureMask := Mask;
|
|
efPicture[0] := Mask;
|
|
efPicture[1] := #0;
|
|
DecimalPlaces := 0;
|
|
end;
|
|
|
|
begin
|
|
case FT of
|
|
sftString : Update(15, pmAnyChar);
|
|
sftBoolean : Update(1, pmTrueFalse);
|
|
sftYesNo : Update(1, pmYesNo);
|
|
sftChar : Update(1, pmAnyChar);
|
|
sftLongInt : Update(11, pmWhole);
|
|
sftWord : Update(5, pmPositive);
|
|
sftInteger : Update(6, pmWhole);
|
|
sftByte : Update(3, pmPositive);
|
|
sftShortInt : Update(4, pmWhole);
|
|
sftReal : Update(14, pmDecimal);
|
|
sftExtended : Update(14, pmDecimal);
|
|
sftDouble : Update(14, pmDecimal);
|
|
sftSingle : Update(14, pmDecimal);
|
|
sftComp : Update(14, pmWhole);
|
|
else
|
|
raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcCustomSimpleField.sfSetDefaultRanges;
|
|
{-set default range values based on the field type}
|
|
begin
|
|
case FSimpleDataType of
|
|
sftChar, sftBoolean, sftYesNo :
|
|
if efRangeLo.rtChar = efRangeHi.rtChar then
|
|
efSetDefaultRange(efDataType);
|
|
sftLongInt, sftWord, sftInteger, sftByte, sftShortInt :
|
|
if efRangeLo.rtLong = efRangeHi.rtLong then
|
|
efSetDefaultRange(efDataType);
|
|
sftReal :
|
|
if efRangeLo.rtReal = efRangeHi.rtReal then
|
|
efSetDefaultRange(efDataType);
|
|
sftExtended, sftDouble, sftSingle, sftComp :
|
|
if efRangeLo.rtExt = efRangeHi.rtExt then
|
|
efSetDefaultRange(efDataType);
|
|
else
|
|
efSetDefaultRange(efDataType);
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|