jvqvalidateedit.pas

East make Tray Icon in delphi

  if FHasMaxValue and (CheckValue > FMaxValue) then
    Result := Trunc(FMaxValue)
  else
  if FHasMinValue and (CheckValue < FMinValue) then
    Result := Trunc(FMinValue);
end;

function TJvCustomValidateEdit.GetEditText: string;
begin
  Result := FEditText;
end;

procedure TJvCustomValidateEdit.SetEditText(const NewValue: string);
begin
  FEditText := MakeValid(NewValue);
  if (FDisplayFormat = dfYear) and ((not FHasMaxValue) or
    (FHasMaxValue and (FMaxValue > 2000 + TwoDigitYearCenturyWindow))) and
    ((MaxLength = 0) or (MaxLength > 3)) then
    FEditText := IntToStr(MakeYear4Digit(StrToIntDef(FEditText, 0), TwoDigitYearCenturyWindow));
  if FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfHex, dfInteger,
    dfOctal, dfPercent, dfScientific, dfYear] then
  begin
    EnforceMaxValue;
    EnforceMinValue;
  end;
//  ChangeText(FEditText); 
  DisplayText;
  DoValueChanged;
end;

procedure TJvCustomValidateEdit.DoEnter;
begin
  DisplayText;
  inherited DoEnter;
end;

procedure TJvCustomValidateEdit.DoExit;
begin
  if not (csDestroying in ComponentState) then
    EditText := inherited Text;
  DoExit;
end;

procedure TJvCustomValidateEdit.ChangeText(const NewValue: string);
var
  S: string;
  Ps, I: Integer;
begin
  FSelfChange := True;
  try
    Ps := 0;
    if TrimDecimals then
    begin
      Ps := Pos(DecimalSeparator, NewValue);
      if Ps > 0 then
      begin
        I := Length(NewValue);
        while (I > Ps) and (NewValue[I] = '0') do
          Dec(I);
        if Ps = I then
          Dec(I); // skip decimal separator (Ivo Bauer)
        S := FDisplayPrefix + Copy(NewValue, 1, I) + FDisplaySuffix;
      end;
    end;
    if Ps = 0 then
      S := FDisplayPrefix + NewValue + FDisplaySuffix;
    if S <> inherited Text then
      inherited SetText(S);
  finally
    FSelfChange := False;
  end;
end;

procedure TJvCustomValidateEdit.DisplayText;
begin
  // The number types need to be formatted
  if (FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfInteger, dfOctal, dfPercent, dfScientific, dfYear]) and
    (AsFloat = 0) and FZeroEmpty then
    ChangeText('')
  else
  begin
    if (FCriticalPoints.CheckPoints <> cpNone) and
      (FDisplayFormat in [dfBinary, dfCurrency, dfFloat, dfHex, dfInteger, dfOctal, dfPercent, dfScientific, dfYear]) then
      SetFontColor;
    case FDisplayFormat of
      dfCurrency:
        ChangeText(Format('%.*m', [FDecimalPlaces, AsCurrency]));
      dfInteger:
        ChangeText(Format('%d', [AsInteger]));
      dfFloat:
        ChangeText(Format('%.*n', [FDecimalPlaces, AsFloat]));
      dfScientific:
        ChangeText(Format('%.*e', [FDecimalPlaces, AsFloat]));
      dfPercent:
        ChangeText(Format('%.*n%', [FDecimalPlaces, AsFloat]));
    else
      ChangeText(FEditText);
    end;
  end;
end;

function TJvCustomValidateEdit.ScientificStrToFloat(SciString: string): Double;
var
  I: Cardinal;
  sMantissa, sExponent: string;
  bInExp: Boolean;
begin
  if Pos('E', UpperCase(SciString)) = 0 then
    Result := StrToFloatDef(SciString, 0)
  else
  begin
    sMantissa := '';
    sExponent := '';
    bInExp := False;
    for I := 1 to Length(SciString) do
    begin
      if UpperCase(SciString[I]) = 'E' then
        bInExp := True
      else
      begin
        if bInExp then
          sExponent := sExponent + SciString[I]
        else
          sMantissa := sMantissa + SciString[I];
      end;
    end;
    Result := StrToFloatDef(sMantissa, 0) * Power(10, StrToFloatDef(sExponent, 0));
  end;
end;

function TJvCustomValidateEdit.BaseToInt(const BaseValue: string; Base: Byte): Integer;
var
  I: Integer;

  function BaseCharToInt(BaseChar: Char): Integer;
  begin
    case Ord(BaseChar) of
      Ord('0')..Ord('9'):
        Result := Ord(BaseChar) - Ord('0');
    else
      Result := Ord(BaseChar) - Ord('A') + 10;
    end;
  end;

begin
  Assert(Base <= 36, RsEBaseTooBig);
  Assert(Base > 1, RsEBaseTooSmall);

  Result := 0;
  for I := 1 to Length(BaseValue) do
    Inc(Result, Trunc(BaseCharToInt(BaseValue[I]) * Power(Base, Length(BaseValue) - I)));
end;

function TJvCustomValidateEdit.IntToBase(NewValue:Integer; Base: Byte): string;
var
  iDivisor, iRemainder, I: Cardinal;
  iBaseIterations: Integer;

  function IntToBaseChar(IntValue: Integer): Char;
  begin
    case IntValue of
      0..9:
        Result := Chr(Ord('0') + IntValue);
    else
      Result := Chr(Ord('A') + IntValue - 10);
    end;
  end;

begin
  Assert(Base <= 36, RsEBaseTooBig);
  Assert(Base > 1, RsEBaseTooSmall);

  Result := '';
  iRemainder := NewValue;
  if NewValue >= Base then
  begin
    iDivisor := 1;
    iBaseIterations := -1;
    while (Int64(NewValue) div iDivisor) > 0 do  // Int64 to remove warning about size of operands
    begin
      iDivisor := iDivisor * Base;
      Inc(iBaseIterations);
    end;
    iDivisor := iDivisor div Base;
    for I := 1 to iBaseIterations do
    begin
      Result := Result + IntToBaseChar(iRemainder div iDivisor);
      iRemainder := iRemainder mod iDivisor;
      iDivisor := iDivisor div Base;
    end;
  end;
  Result := Result + IntToBaseChar(iRemainder);
end;

procedure TJvCustomValidateEdit.DoValueChanged;
begin
  try
    if Assigned(FOnValueChanged) and (EnterText <> FEditText) then
      FOnValueChanged(Self);
  finally
    EnterText := FEditText;
  end;
end;

procedure TJvCustomValidateEdit.Change;
begin
  // Update FEditText for User changes, so that the AsInteger, etc,
  // functions work while editing
  if not FSelfChange then
    FEditText := inherited Text;
  inherited Change;
end;

procedure TJvCustomValidateEdit.SetText(const NewValue: TCaption);
begin
  EditText := NewValue;
  DoValueChanged;
end;

procedure TJvCustomValidateEdit.SetDisplayPrefix(const NewValue: string);
begin
  FDisplayPrefix := NewValue;
  DisplayText;
end;

procedure TJvCustomValidateEdit.SetDisplaySuffix(const NewValue: string);
begin
  FDisplaySuffix := NewValue;
  DisplayText;
end;

procedure TJvCustomValidateEdit.CriticalPointsChange(Sender: TObject);
begin
  SetFontColor;
  Invalidate;
end;

procedure TJvCustomValidateEdit.SetFontColor;
begin
  Font.OnChange := nil;
  case FCriticalPoints.CheckPoints of
    cpNone:
      Font.Color := FStandardFontColor;
    cpMaxValue:
      if AsFloat > FCriticalPoints.MaxValue then
        Font.Color := FCriticalPoints.ColorAbove
      else
        Font.Color := FStandardFontColor;
    cpBoth:
      if AsFloat > FCriticalPoints.MaxValue then
        Font.Color := FCriticalPoints.ColorAbove
      else
      if AsFloat < FCriticalPoints.MinValue then
        Font.Color := FCriticalPoints.ColorBelow
      else
        Font.Color := FStandardFontColor;
  end; 
  Palette.TextColor := Font.Color; 
  Font.OnChange := FontChange;
  Invalidate;
end;

procedure TJvCustomValidateEdit.FontChange(Sender: TObject);
begin
  FStandardFontColor := Font.Color;
  if Assigned(FOldFontChange) then
    FOldFontChange(Sender);
end;

procedure TJvCustomValidateEdit.EnforceMaxValue;
begin
  { Check the Value is within this range }
  if FHasMaxValue and (FDisplayFormat in [dfBinary, dfCurrency, dfFloat,
    dfHex, dfInteger, dfOctal, dfPercent, dfScientific, dfYear]) and
    (AsFloat > FMaxValue) then
    SetAsFloat(FMaxValue);
end;

procedure TJvCustomValidateEdit.EnforceMinValue;
begin
  { Check the Value is within this range }
  if FHasMinValue and (FDisplayFormat in [dfBinary, dfCurrency, dfFloat,
    dfHex, dfInteger, dfOctal, dfPercent, dfScientific, dfYear]) and
    (AsFloat < FMinValue) then
    SetAsFloat(FMinValue);
end;

//=== { TJvValidateEditCriticalPoints } ======================================

constructor TJvValidateEditCriticalPoints.Create;
begin
  inherited Create;
  FCheckPoints := cpNone;
  FColorAbove := clBlue;
  FColorBelow := clRed;
end;

procedure TJvValidateEditCriticalPoints.SetCheckPoints(NewValue: TJvValidateEditCriticalPointsCheck);
begin
  if FCheckPoints <> NewValue then
  begin
    FCheckPoints := NewValue;
    DoChanged;
  end;
end;

procedure TJvValidateEditCriticalPoints.SetColorAbove(NewValue: TColor);
begin
  if FColorAbove <> NewValue then
  begin
    FColorAbove := NewValue;
    DoChanged;
  end;
end;

procedure TJvValidateEditCriticalPoints.SetColorBelow(NewValue: TColor);
begin
  if FColorBelow <> NewValue then
  begin
    FColorBelow := NewValue;
    DoChanged;
  end;
end;

procedure TJvValidateEditCriticalPoints.SetMaxValue(NewValue: Double);
begin
  if FMaxValue <> NewValue then
  begin
    FMaxValue := NewValue;
    DoChanged;
  end;
end;

procedure TJvValidateEditCriticalPoints.SetMinValue(NewValue: Double);
begin
  if FMinValue <> NewValue then
  begin
    FMinValue := NewValue;
    DoChanged;
  end;
end;

procedure TJvValidateEditCriticalPoints.DoChanged;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvValidateEditCriticalPoints.Assign(Source: TPersistent);
var
  LocalSource: TJvValidateEditCriticalPoints;
begin
  inherited Assign(Source);
  if Source is TJvValidateEditCriticalPoints then
  begin
    LocalSource := Source as TJvValidateEditCriticalPoints;
    CheckPoints := LocalSource.CheckPoints;
    ColorAbove := LocalSource.ColorAbove;
    ColorBelow := LocalSource.ColorBelow;
    MaxValue := LocalSource.MaxValue;
    MinValue := LocalSource.MinValue;
  end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQValidateEdit.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2004/12/11 17:06:41 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.