home *** CD-ROM | disk | FTP | other *** search
Wrap
unit Vedit; {----------------------------------------------------------------------------- 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/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: VEdit.pas, released 12 September 2000. The Initial Developer of the Original Code is Mat Ballard. Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard. Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp. All Rights Reserved. Contributor(s): Mat Ballard e-mail: mat.ballard@chemware.hypermart.net. Last Modified: 10/01/2001 Current Version: 2.00 You may retrieve the latest version of this file from: http://Chemware.hypermart.net/ This work was created with the Project JEDI VCL guidelines: http://www.delphi-jedi.org/Jedi:VCLVCL in mind. Purpose: Limit user input to various types and ranges of number. Note: this component differs in some important but subtle ways to TNEdit: 1. the primary value is numerical, stored as Extended, rather than text; 2. the value is set after each keypress 3. there is an additional OnAssignment event 4. TFloatFormat is used directly 5. KeyOK is now public Known Issues: -----------------------------------------------------------------------------} {$I Misc.inc} interface uses Misc, Classes, SysUtils, {$IFDEF WINDOWS} WinTypes, WinProcs, Forms, StdCtrls, Graphics, Controls {$ENDIF} {$IFDEF WIN32} Windows, Forms, StdCtrls {$ENDIF} {$IFDEF LINUX} Untranslated, QForms, QStdCtrls {$ENDIF} ; type TDisplayType = (dtInteger, dtBinary, dtHex, dtReal); {TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency)} TVEdit = class(TCustomEdit) private { Private declarations } FDisplayType: TDisplayType; FDecimals: Byte; FFloatFormat: TFloatFormat; FMin: Extended; FMax: Extended; FValue: Extended; FOnAssignment: TNotifyEvent; FOnDisplayTypeChange: TNotifyEvent; function GetBinary: String; function GetHexadecimal: String; {$IFDEF DELPHI4_UP} function GetInteger: Int64; {$ELSE} function GetInteger: Integer; {$ENDIF} {$IFDEF DELPHI2_UP} function GetCurrency: Currency; {$ENDIF} procedure SetDecimals(Value: Byte); procedure SetFloatFormat(Value: TFloatFormat); procedure SetDisplayType(Value: TDisplayType); procedure SetBinary(Value: String); procedure SetHexadecimal(Value: String); {$IFDEF DELPHI4_UP} procedure SetInteger(Value: Int64); {$ELSE} procedure SetInteger(Value: Integer); {$ENDIF} procedure SetReal(Value: Extended); {$IFDEF DELPHI2_UP} procedure SetCurrency(Value: Currency); {$ENDIF} protected {Procedure KeyDown(var Key: Word; Shift: TShiftState); override;} Procedure KeyPress(var Key: Char); override; Procedure KeyUp(var Key: Word; Shift: TShiftState); override; procedure DoAssignment; virtual; procedure DoDisplayTypeChange; virtual; procedure DoExit; override; procedure DoText; virtual; procedure DoValue; virtual; public { Public declarations } Constructor Create(AOwner:TComponent);override; function KeyOK(Key: Char): Boolean; virtual; published { Published declarations } Property AsBinary: String read GetBinary write SetBinary stored FALSE; Property AsHex: String read GetHexadecimal write SetHexadecimal stored FALSE; Property AsReal: Extended read FValue write SetReal stored FALSE; Property AsInteger: {$IFDEF DELPHI4_UP}Int64{$ELSE}Integer{$ENDIF} read GetInteger write SetInteger stored FALSE; {$IFDEF DELPHI2_UP} Property AsCurrency: Currency read GetCurrency write SetCurrency stored FALSE; {$ENDIF} Property Decimals: Byte read FDecimals write SetDecimals; Property FloatFormat: TFloatFormat read FFloatFormat write SetFloatFormat; Property Min: Extended read FMin write FMin; Property Max: Extended read FMax write FMax; Property DisplayType: TDisplayType read FDisplayType write SetDisplayType; Property OnAssignment: TNotifyEvent read FOnAssignment write FOnAssignment; Property OnDisplayTypeChange: TNotifyEvent read FOnDisplayTypeChange write FOnDisplayTypeChange; {The Custom... properties:} property AutoSelect; property AutoSize; property BorderStyle; property CharCase; property Color; {$IFDEF MSWINDOWS} property Ctl3D; property DragCursor; {$ENDIF} property Enabled; property Font; property HideSelection; property MaxLength; {$IFDEF MSWINDOWS} property OEMConvert; {$ENDIF} property ParentColor; {$IFDEF MSWINDOWS} property ParentCtl3D; {$ENDIF} property ParentFont; property ParentShowHint; {$IFDEF MSWINDOWS} property PasswordChar; {$ENDIF} property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Text; property Visible; property OnChange; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; {$IFDEF DELPHI2_UP} {$ENDIF} {$IFDEF DELPHI3_UP} {$ENDIF} {$IFDEF DELPHI4_UP} property Anchors; {$IFDEF MSWINDOWS} property BiDiMode; {$ENDIF} property Constraints; {$IFDEF MSWINDOWS} property DragKind; {$ENDIF} property DragMode; {$IFDEF MSWINDOWS} property ImeMode; property ImeName; property ParentBiDiMode; {$ENDIF} property PopupMenu; {$IFDEF MSWINDOWS} property OnEndDock; property OnStartDock; {$ENDIF} property OnStartDrag; {$ENDIF} {$IFDEF DELPHI5_UP} {$ENDIF} end; const TVEdit_VERSION = 100; implementation {------------------------------------------------------------------------------ Procedure: TVEdit.Create Description: standard constructor Author: Mat Ballard Date created: 04/25/2000 Date modified: 04/25/2000 by Mat Ballard Purpose: sets the Text and DataType Known Issues: ------------------------------------------------------------------------------} constructor TVEdit.Create(AOwner:TComponent); begin inherited Create(AOwner); FDecimals := 0; FValue := 0; DoText; end; {------------------------------------------------------------------------------ Procedure: TVEdit.KeyDown Description: standard KeyDown event handler Author: Mat Ballard Date created: 04/25/2000 Date modified: 04/25/2000 by Mat Ballard Purpose: examines Key to see if valid Known Issues: ------------------------------------------------------------------------------} {Procedure TVEdit.KeyDown(var Key: Word; Shift: TShiftState); var KeyOK: Boolean; ChrKey: Char; begin KeyOK := FALSE; ChrKey := Chr(Key); if ((Key = VK_TAB) or (Key = VK_RETURN)) then {done or losing focus: KeyOK := TRUE else if ((Key = VK_BACK) or (Key = VK_CLEAR) or (Key = VK_RIGHT) or (Key = VK_DELETE) or (Key = VK_LEFT) or (Key = VK_END) or (Key = VK_HOME)) then KeyOK := TRUE else if (ChrKey in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) then {is a basic numeral: KeyOK := TRUE else if (ChrKey = '-') then begin if ((Length(Text) = 0) and (FMin < 0)) then {is a negative number: KeyOK := TRUE else if (UpperCase(Text[Length(Text)]) = 'E') then KeyOK := TRUE; end else begin Case FDisplayType of dtBinary: if (ChrKey in ['2', '3', '4', '5', '6', '7', '8', '9']) then KeyOK := FALSE; dtHex: if (ChrKey in ['a', 'b', 'c', 'd', 'e', 'f', 'A', 'B', 'C', 'D', 'E', 'F']) then KeyOK := TRUE; dtReal: if ((ChrKey in ['.', 'e', 'E']) and (Pos(ChrKey, Text) = 0))then KeyOK := TRUE; end; end; if (not KeyOK) then Key := 0; {call the TEdit parent function last: inherited KeyDown(Key, Shift); end; } {------------------------------------------------------------------------------ Procedure: TVEdit.KeyPress Description: standard KeyPress event handler Author: Mat Ballard Date created: 01/05/2001 Date modified: 01/05/2001 by Mat Ballard Purpose: examines Key to see if valid Known Issues: ------------------------------------------------------------------------------} Procedure TVEdit.KeyPress(var Key: Char); begin if (not KeyOK(Key)) then Key := Chr(0); {call the TEdit parent function last:} inherited KeyPress(Key); end; {------------------------------------------------------------------------------ Function: TVEdit.KeyOK Description: Is this Key OK ? Author: Mat Ballard Date created: 01/05/2001 Date modified: 01/05/2001 by Mat Ballard Purpose: examines Key to see if valid Known Issues: ------------------------------------------------------------------------------} Function TVEdit.KeyOK(Key: Char): Boolean; begin KeyOK := FALSE; if (Key in [Chr(VK_BACK), '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) then {is a basic numeral:} KeyOK := TRUE else if (Key = '-') then begin if ((Length(Text) = 0) and (FMin < 0)) then {is a negative number:} KeyOK := TRUE else if (UpperCase(Text[Length(Text)]) = 'E') then KeyOK := TRUE; end else begin Case FDisplayType of dtBinary: if (Key in ['2', '3', '4', '5', '6', '7', '8', '9']) then KeyOK := FALSE; dtHex: if (Key in ['a', 'b', 'c', 'd', 'e', 'f', 'A', 'B', 'C', 'D', 'E', 'F']) then KeyOK := TRUE; dtReal: if ((Key in ['.', 'e', 'E']) and (Pos(Key, Text) = 0))then KeyOK := TRUE; end; end; end; Procedure TVEdit.KeyUp(var Key: Word; Shift: TShiftState); begin if (Length(Text) > 0) then begin if ((Text = '-') or (Text = '.') or (Text = '-.')) then FValue := 0 else begin try Case FDisplayType of dtInteger, dtHex: FValue := StrToInt(Text); dtBinary: FValue := BinToInt(Text); dtReal: FValue := StrToFloat(Text); end; finally end; end; end else FValue := 0; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetFloatFormat Description: standard property Set procedure Author: Mat Ballard Date created: 01/04/2001 Date modified: 01/04/2000 by Mat Ballard Purpose: sets the Format Property Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.SetDecimals(Value: Byte); begin FDecimals := Value; DoText; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetFloatFormat Description: standard property Set procedure Author: Mat Ballard Date created: 01/04/2001 Date modified: 01/04/2000 by Mat Ballard Purpose: sets the Format Property Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.SetFloatFormat(Value: TFloatFormat); begin FFloatFormat := Value; DoText; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetDisplayType Description: standard property Set procedure Author: Mat Ballard Date created: 04/25/2000 Date modified: 01/04/2001 by Mat Ballard Purpose: sets the DisplayType Property Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.SetDisplayType(Value: TDisplayType); begin if (Value = FDisplayType) then exit; FDisplayType := Value; DoText; end; procedure TVEdit.DoAssignment; begin if Assigned(FOnAssignment) then OnAssignment(Self); end; procedure TVEdit.DoDisplayTypeChange; begin if Assigned(FOnDisplayTypeChange) then OnDisplayTypeChange(Self); end; {------------------------------------------------------------------------------ Procedure: TVEdit.DoExit Description: standard DoExit event handler Author: Mat Ballard Date created: 04/25/2000 Date modified: 04/25/2000 by Mat Ballard Purpose: examines the validity of the Text Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.DoExit; begin inherited DoExit; end; procedure TVEdit.DoText; var Digits, Precision: Integer; {FDecimals} begin Precision := 18; {Extended} Digits := 0; {often min number of exponent digits} case FDisplayType of dtInteger: Text := IntToStr(Round(FValue)); dtBinary: Text := IntToBin(Round(FValue)); dtHex: Text := IntToHex(Round(FValue), 0); dtReal: begin case FFloatFormat of {ffGeneral: ;} ffExponent: Precision := FDecimals+1; ffFixed: Digits := FDecimals; ffNumber: Digits := FDecimals; ffCurrency: Digits := FDecimals; end; Text := FloatToStrF(FValue, FFloatFormat, Precision, Digits); end; end; end; procedure TVEdit.DoValue; begin try Case FDisplayType of dtInteger: ; dtBinary: ; dtHex: ; dtReal: ; end; finally end; end; {------------------------------------------------------------------------------ Function: TVEdit.GetBinary Description: standard property Get function Author: Mat Ballard Date created: 01/04/2001 Date modified: 01/04/2001 by Mat Ballard Purpose: gets the value of the Value Property as a Binary string Return Value: String Known Issues: ------------------------------------------------------------------------------} function TVEdit.GetBinary: String; begin GetBinary := IntToBin(Round(FValue)); end; {------------------------------------------------------------------------------ Function: TVEdit.GetHexadecimal Description: standard property Get function Author: Mat Ballard Date created: 01/04/2001 Date modified: 01/04/2001 by Mat Ballard Purpose: gets the value of the Value Property as an Hexadecimal string Return Value: String Known Issues: ------------------------------------------------------------------------------} function TVEdit.GetHexadecimal: String; begin GetHexadecimal := IntToHex(Round(FValue), 0); end; {------------------------------------------------------------------------------ Function: TVEdit.GetInteger Description: standard property Get function Author: Mat Ballard Date created: 04/25/2000 Date modified: 04/25/2000 by Mat Ballard Purpose: gets the value of the Text Property as an Integer Return Value: IntEGER Known Issues: ------------------------------------------------------------------------------} {$IFDEF DELPHI4_UP} function TVEdit.GetInteger: Int64; {$ELSE} function TVEdit.GetInteger: Integer; {$ENDIF} begin GetInteger := Round(FValue); end; {------------------------------------------------------------------------------ Function: TVEdit.GetCurrency Description: standard property Get function Author: Mat Ballard Date created: 04/25/2000 Date modified: 04/25/2000 by Mat Ballard Purpose: gets the value of the Text Property as Currency Return Value: Currency Known Issues: ------------------------------------------------------------------------------} {$IFDEF DELPHI2_UP} function TVEdit.GetCurrency: Currency; begin GetCurrency := FValue; end; {$ENDIF} {------------------------------------------------------------------------------ Procedure: TVEdit.SetBinary Description: standard property Set procedure Author: Mat Ballard Date created: 01/04/2001 Date modified: 01/04/2001 by Mat Ballard Purpose: sets the Value as binary Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.SetBinary(Value: String); begin DisplayType := dtBinary; FValue := BinToInt(Value); DoText; DoAssignment; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetHexadecimal Description: standard property Set procedure Author: Mat Ballard Date created: 01/04/2001 Date modified: 01/04/2001 by Mat Ballard Purpose: sets the Value as hex Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.SetHexadecimal(Value: String); begin DisplayType := dtHex; FValue := StrToInt('$' + Value); DoText; DoAssignment; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetInteger Description: standard property Set procedure Author: Mat Ballard Date created: 04/25/2000 Date modified: 01/04/2001 by Mat Ballard Purpose: sets the Text Property Displayally Known Issues: ------------------------------------------------------------------------------} {$IFDEF DELPHI4_UP} procedure TVEdit.SetInteger(Value: Int64); {$ELSE} procedure TVEdit.SetInteger(Value: Integer); {$ENDIF} begin if (FDisplayType = dtReal) then DisplayType := dtInteger; FValue := Value; DoText; DoAssignment; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetReal Description: standard property Set procedure Author: Mat Ballard Date created: 04/25/2000 Date modified: 01/04/2001 by Mat Ballard Purpose: sets the Text Property Displayally Known Issues: ------------------------------------------------------------------------------} procedure TVEdit.SetReal(Value: Extended); begin DisplayType := dtReal; FValue := Value; if (FFloatFormat = ffCurrency) then FFloatFormat := ffGeneral; DoText; DoAssignment; end; {------------------------------------------------------------------------------ Procedure: TVEdit.SetCurrency Description: standard property Set procedure Author: Mat Ballard Date created: 04/25/2000 Date modified: 04/25/2000 by Mat Ballard Purpose: sets the Text Property Displayally Known Issues: ------------------------------------------------------------------------------} {$IFDEF DELPHI2_UP} procedure TVEdit.SetCurrency(Value: Currency); begin DisplayType := dtReal; FloatFormat := ffCurrency; FValue := Value; DoText; DoAssignment; end; {$ENDIF} end.