unit waehrEdit;
{
Author: Peter Johansson
Aenderungen und Anpassungebn hwd-world 2009
Description: Edit for entering a currency value. Has a property called Value
witch can be manipulated both by the user and the application. If
a error should occur it will stil hold a value but show a
exclamation sign "!" in from of the value.
Usage: Just put a TCurrencyEdit on the form and use the property Value
to read a valid Currency figure or of course to set it.
Version: 1.01
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
{I'am using a TMemo becourse it can
handle justification and reduced client
area, to make room for the error sign and to move the cursor away from
the right edge of the control}
TWaehrEdit =class(TEdit)
protected
fValue : Currency;
fOldValue : Currency;
fCanvas : TControlCanvas;
fIsValid : Boolean;
procedure SetRects;
procedure Validate;
procedure SetValue(value : Currency);
procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
procedure WMSize(var Message : TWMSize); message WM_SIZE;
procedure WMPaint(var Message : TWMPaint); message WM_PAINT;
// procedure CMEnter(var Message : TCMGotFocus); message CM_ENTER;
// procedure CMExit(var message : TCMGotFocus); message CM_EXIT;
procedure KeyPress(var Key: char); override;
public
procedure CreateWnd;override;
constructor Create(AOwner: TComponent); override;
destructor Destroy;override;
published
property BorderStyle;
property Color;
// property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
// property HideSelection;
property IsValid : Boolean Read fIsValid;
property Value : Currency read fValue write SetValue;
property ParentColor;
// property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
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;
end;
procedure Register;
implementation
procedure Register;
Begin
RegisterComponents('Standard', [TWaehrEdit]);
End;
procedure TWaehrEdit.SetRects;
Var
E : TRect;
Begin
E :=ClientRect; {Edit portion of CurrencyEdit}
E.Right :=ClientRect.Right - 5; {Move the cursor away from the edge}
E.Left :=ClientRect.Left + 20; {Make room for the error sign}
Perform(EM_SETRECT,0 ,LongInt(@E)); {Set the Edit control rect}
End;
procedure TWaehrEdit.Validate;
Begin
{Try to convert text to currency - if it fails user previeus entered value}
Try
fValue :=StrToFloat(Text);
Text :=FormatFloat('#0.00', fValue);
fOldValue :=fValue;
fIsValid :=True;
Except
fValue :=fOldValue;
Text :=FormatFloat('#0.00', fValue);
fIsValid :=False;
End;
End;
procedure TWaehrEdit.SetValue(value : Currency);
Begin
fValue :=value;
Text :=FormatFloat('#0.00', fValue);
fOldValue :=fValue;
fIsValid :=True;
End;
procedure TWaehrEdit.WMSetFont(var Message: TWMSetFont);
begin
inherited;
SetRects;
End;
procedure TWaehrEdit.WMSize(var Message: TWMSize);
Begin
Inherited;
SetRects;
End;
procedure TWaehrEdit.WMPaint(var Message : TWMPaint);
Begin
{If an error ocurred write an exclamation sign}
Inherited;
fCanvas.Brush.Color :=Color;
fCanvas.FillRect(Rect(1, 1, ClientRect.Left + 18, ClientRect.Bottom - 1));
If not fIsValid Then fCanvas.TextOut(3, 1, '!!');
End;
{procedure TWaehrEdit.CMEnter(var Message : TCMGotFocus);
Begin
Inherited;
SelectAll;
End; }
{procedure TWaehrEdit.CMExit(var message : TCMGotFocus);
Begin
{When loosing focus try to validate the entered figure and format it nice}
Validate;
Inherited;
End; }
procedure TWaehrEdit.KeyPress(var Key: char);
Begin
{Only number related keys allowed.
On Enter #13, try to vallidate
On Escape #27 Restore the previous entered value}
If (Length(Text) > 12) and (key <> #8)Then Key :=#0;
If not (Key in['-', '+', '0'..'9', DecimalSeparator, #8, #13, #27]) Then key :=#0;
If Key = #13 Then
Begin
Validate;
SelectAll;
End;
If Key = #27 Then
Begin
fValue :=fOldValue;
Text :=FormatFloat('#0.00', fValue);
SelectAll;
End;
Inherited KeyPress(Key);
End;
procedure TWaehrEdit.CreateWnd;
Begin
Inherited CreateWnd;
SetRects;
End;
constructor TWaehrEdit.Create(AOwner: TComponent);
begin
{Make it look and behave like a TEdit}
inherited Create(AOwner);
// WantReturns := False;
// WordWrap :=False;
Height := 23;
Width := 80;
fValue :=0;
fIsValid :=True;
fOldValue :=0;
Text :='0' + DecimalSeparator + '00';
Alignment := taRightJustify;
{Create the error space.
If an error occurs an exclamation sign will be painted here}
fCanvas :=TControlCanvas.Create;
fCanvas.Control :=Self;
fCanvas.Font :=Font;
fCanVas.Font.Style :=Font.Style + [fsBold];
end;
destructor TWaehrEdit.Destroy;
Begin
fCanvas.Destroy;
Inherited Destroy;
End;
end.