Lazarus Hacks
From Free Pascal wiki
Revision as of 16:52, 27 October 2009 by Mingodad (talk | contribs) (→Exposing/Extending TCustomEdit)
Exposing/Extending TCustomEdit
In some applications we need constantly convert TCustomEdit descendants Text property for or to numeric values:
TCustomEditFilters = (cefNone, cefInteger, cefUnsigned, cefCurrency, cefFloat);
{ TCustomEdit }
TCustomEdit = class(TWinControl) private ... FTmpModified : Boolean; FceFilter : TCustomEditFilters; procedure SetceFilter(aCeFilter: TCustomEditFilters); function GetAsInteger:Integer; procedure SetAsInteger(aVal: Integer); function GetAsFloat:Extended; procedure SetAsFloat(aVal: Extended); function GetAsCurrency:Currency; procedure SetAsCurrency(aVal: Currency);
public ... property TmpModified: Boolean read FTmpModified write FTmpModified; property AsInteger: Integer read getAsInteger write setAsInteger; property AsFloat: Extended read getAsFloat write setAsFloat; property AsCurrency: Currency read getAsCurrency write setAsCurrency; published property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; property ceFilter : TCustomEditFilters read FceFilter write SetceFilter default cefNone; end;
On the implementation part tcustomedit.inc:
resourcestring rsInvalidNumbe = 'Invalid number !';
procedure TCustomEdit.Change; begin FTmpModified := True; if Assigned(FOnChange) then FOnChange(Self); end;
procedure TCustomEdit.DoExit; begin if FCeFilter <> cefNone then begin case FCeFilter of cefInteger, cefUnsigned: AsInteger; cefFloat: AsFloat; cefCurrency: AsCurrency; end; end; FAutoSelected := False; inherited DoExit; end;
procedure TCustomEdit.SetceFilter(aCeFilter: TCustomEditFilters); begin FCeFilter := aCeFilter; if FCeFilter = cefNone then Alignment := taLeftJustify else Alignment := taRightJustify; end;
function TCustomEdit.GetAsInteger:Integer; begin TryStrToInt(Text, result); end;
procedure TCustomEdit.SetAsInteger(aVal: Integer); begin Text := IntToStr(aVal); end;
function TCustomEdit.GetAsFloat:Extended; begin if Text = ' then result := 0 else if not TryStrToFloat(Text, result) then Raise Exception.Create(rsInvalidNumbe); end;
procedure TCustomEdit.SetAsFloat(aVal: Extended); begin Text := FloatToStr(aVal); end;
function TCustomEdit.GetAsCurrency:Currency; begin if Text = ' then result := 0 else if not TryStrToCurr(Text, result) then raise Exception.Create(rsInvalidNumbe); end;
procedure TCustomEdit.SetAsCurrency(aVal: Currency); begin Text := CurrToStr(aVal); end;