jvbaseedits.pas

East make Tray Icon in delphi

end;

procedure TJvCustomNumEdit.SetBeepOnError(Value: Boolean);
begin
  if BeepOnError <> Value then
  begin
    inherited SetBeepOnError(Value);
    UpdatePopup;
  end;
end;

procedure TJvCustomNumEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TJvCustomNumEdit.SetDisplayFormat(const Value: string);
begin
  if DisplayFormat <> Value then
  begin
    FDisplayFormat := Value;
    Invalidate;
    DataChanged;
  end;
end;

function TJvCustomNumEdit.GetDisplayFormat: string;
begin
  Result := FDisplayFormat;
end;

procedure TJvCustomNumEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    Invalidate;
    FFormatting := True;
    try
      DataChanged;
    finally
      FFormatting := False;
    end;
  end;
end;

procedure TJvCustomNumEdit.SetFormatOnEditing(Value: Boolean);
begin
  if FFormatOnEditing <> Value then
  begin
    FFormatOnEditing := Value;
    if FFormatOnEditing then
      inherited Alignment := Alignment
    else
      inherited Alignment := taLeftJustify;
    if FFormatOnEditing and FFocused then
      ReformatEditText
    else
    if FFocused then
    begin
      UpdateData;
      DataChanged;
    end;
  end;
end;

procedure TJvCustomNumEdit.SetDecimalPlaces(Value: Cardinal);
begin
  if FDecimalPlaces <> Value then
  begin
    FDecimalPlaces := Value;
    // WAP Added. Changes to decimal places formerly did not change
    // FDisplayFormat, which causes both designtime and runtime problems!
    SetDisplayFormat(GetEditFormat);
    SetValue(CheckValue(FValue, False)); // Polaris (?)
    DataChanged;
    Invalidate;
  end;
end;

{WAP added this new property: Switches between using 0.000
     and 0.### as a FormatFloat picture. }
procedure TJvCustomNumEdit.SetDecimalPlacesAlwaysShown( Value:Boolean );
begin
  if FDecimalPlacesAlwaysShown <> Value then
  begin
    FDecimalPlacesAlwaysShown := Value;
    SetDisplayFormat(GetEditFormat); // Redo format picture
    SetValue(CheckValue(FValue, False)); // Polaris (?)
    DataChanged;
    Invalidate;
  end;
end;

function TJvCustomNumEdit.FormatDisplayText(Value: Extended): string;
begin
  if DisplayFormat <> '' then
    Result := FormatFloat(DisplayFormat, Value)
  else
    Result := FloatToStr(Value);
end;

function TJvCustomNumEdit.GetDisplayText: string;
begin
  Result := FormatDisplayText(FValue);
end;

procedure TJvCustomNumEdit.Clear;
begin
  Text := '';
end;

{WAP added GetEditFormat, this code used to be ininline inside DataChanged.}
function TJvCustomNumEdit.GetEditFormat:String;
begin
  Result := '0';
  if FDecimalPlaces > 0 then
    if FDecimalPlacesAlwaysShown then
       Result  := Result + '.' + MakeStr('0', FDecimalPlaces)
    else
       Result  := Result + '.' + MakeStr('#', FDecimalPlaces);
end;

procedure TJvCustomNumEdit.DataChanged;
var
  EditFormat: string;
  WasModified: Boolean;
begin
  EditFormat := GetEditFormat;
  { Changing EditText sets Modified to false }
  WasModified := Modified;
  try
    if (FValue = 0.0) and FZeroEmpty then
      EditText := ''
    else
      EditText := FormatFloat(EditFormat, CheckValue(FValue, False));
  finally
    Modified := WasModified;
  end;
end;

function TJvCustomNumEdit.CheckValue(NewValue: Extended;
  RaiseOnError: Boolean): Extended;
var
  DP: Integer;
begin
  if FDecimalPlaceRound then
  begin //Polaris
    DP := FDecimalPlaces;
    { (rb) Probably: Round to the nearest, and if two are equally near, away from zero
           Ln, Exp are slow; make more generic (why only this one?), see
           http://www.merlyn.demon.co.uk/pas-chop.htm
    }
    NewValue := Int(NewValue * Exp(DP * Ln(10)) + Sign(NewValue) * 0.50000001) * Exp(-DP * Ln(10));
  end;
  Result := NewValue;
  if FMaxValue <> FMinValue then
  begin
    if FMaxValue > FMinValue then
    begin
      if NewValue < FMinValue then
        Result := FMinValue
      else
      if NewValue > FMaxValue then
        Result := FMaxValue;
    end
    else
    begin
      if FMaxValue = 0 then
      begin
        if NewValue < FMinValue then
          Result := FMinValue;
      end
      else
      if FMinValue = 0 then
      begin
        if NewValue > FMaxValue then
          Result := FMaxValue;
      end;
    end;
    if RaiseOnError and (Result <> NewValue) then
      raise ERangeError.CreateResFmt(@RsEOutOfRangeXFloat,
        [DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
  end;
end;

procedure TJvCustomNumEdit.CheckRange;
begin
  if not (csDesigning in ComponentState) and CheckOnExit then
    CheckValue(StrToFloat(TextToValText(EditText)), True);
end;

procedure TJvCustomNumEdit.UpdateData;
begin
  ValidateEdit;
  FValue := CheckValue(StrToFloat(TextToValText(EditText)), False);
end;

procedure TJvCustomNumEdit.UpdatePopup;
begin
  if FPopup <> nil then
    SetupPopupCalculator(FPopup, DefCalcPrecision, BeepOnError);
end;

function TJvCustomNumEdit.GetValue: Extended;
begin
  if not (csDesigning in ComponentState) then
  try
    UpdateData;
  except
    FValue := FMinValue;
  end;
  Result := FValue;
end;

procedure TJvCustomNumEdit.SetValue(AValue: Extended);
begin
  FValue := CheckValue(AValue, False);
  DataChanged;
  Invalidate;
end;

function TJvCustomNumEdit.GetAsInteger: Longint;
begin
  Result := trunc(Value);
end;

procedure TJvCustomNumEdit.SetAsInteger(AValue: Longint);
begin
  SetValue(AValue);
end;

procedure TJvCustomNumEdit.SetMinValue(AValue: Extended);
begin
  if FMinValue <> AValue then
  begin
    FMinValue := AValue;
    Value := FValue;
  end;
end;

procedure TJvCustomNumEdit.SetMaxValue(AValue: Extended);
begin
  if FMaxValue <> AValue then
  begin
    FMaxValue := AValue;
    Value := FValue;
  end;
end;

function TJvCustomNumEdit.GetText: string;
begin
  Result := inherited Text;
end;

(*
function TJvCustomNumEdit.TextToValText(const AValue: string): string;
var
  I: Integer;
  X: Char;
begin
  Result := DelRSpace(AValue);
  if DecimalSeparator <> ThousandSeparator then
    Result := DelChars(Result, ThousandSeparator);
  if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
    Result := ReplaceStr(Result, '.', DecimalSeparator);
  if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
    Result := ReplaceStr(Result, ',', DecimalSeparator);

// Aquarius
  I := 1;
  while I <= Length(Result) do
  begin
    X := Result[I];
    if (X = DecimalSeparator) or (X = '-') or (X in DigitSymbols) then
    begin
      I := I + 1;
      Continue;
    end
    else
      Result := Copy(Result, 1, I - 1) + Copy(Result, I + 1, Length(Result) - 1);
  end;

  if Result = '' then
    Result := '0'
  else
  if Result = '-' then
    Result := '-0';
end;
*)

procedure TJvCustomNumEdit.SetText(const AValue: string);
begin
  if not (csReading in ComponentState) then
  begin
    FValue := CheckValue(StrToFloat(TextToValText(AValue)), False);
    DataChanged;
    Invalidate;
  end;
end;

procedure TJvCustomNumEdit.ReformatEditText;
var
  S: string;
  IsEmpty: Boolean;
  OldLen, SelStart, SelStop: Integer;
begin
  FFormatting := True;
  try
    S := inherited Text;
    OldLen := Length(S);
    IsEmpty := (OldLen = 0) or (S = '-');
    if HandleAllocated then
      GetSel(SelStart, SelStop);
    if not IsEmpty then
      S := TextToValText(S);
    S := FormatFloatStr(S, Pos(',', DisplayFormat) > 0);
    inherited Text := S;
    if HandleAllocated and (GetFocus = Handle) and
      not (csDesigning in ComponentState) then
    begin
      Inc(SelStart, Length(S) - OldLen);
      SetCursor(SelStart);
    end;
  finally
    FFormatting := False;
  end;
end;

procedure TJvCustomNumEdit.Change;
begin
  if not FFormatting then
  begin
    if FFormatOnEditing and FFocused then
      ReformatEditText;
    inherited Change;
  end;
end;

procedure TJvCustomNumEdit.AcceptValue(const Value: Variant);
begin
  inherited AcceptValue(Value);
  Self.Value := CheckValue(Value, False); //Polaris
end;

procedure TJvCustomNumEdit.WMPaste(var Msg: TMessage);
var
  S: string;
  WasModified: Boolean;
begin
  WasModified := Modified;
  S := EditText;
  try
    inherited;
    UpdateData;
  except
    { Changing EditText sets Modified to false }
    EditText := S;
    Modified := WasModified;
    SelectAll;
    if CanFocus then
      SetFocus;
    DoBeepOnError;
  end;
end;

procedure TJvCustomNumEdit.DoEnter;
begin
  SetFocused(True);
  if FFormatOnEditing then
    ReformatEditText;
  inherited DoEnter;
end;

procedure TJvCustomNumEdit.DoExit;
begin
  try
    CheckRange;
    UpdateData;
  except
    SelectAll;
    if CanFocus then
      SetFocus;
    raise;
  end;
  SetFocused(False);
  SetCursor(0);
  inherited DoExit;
end;

procedure TJvCustomNumEdit.EnabledChanged;
begin
  inherited EnabledChanged;
  if NewStyleControls and not FFocused then
    Invalidate;
end;

{$IFDEF VCL}
procedure TJvCustomNumEdit.WMPaint(var Msg: TWMPaint);
var
  S: string;
begin
  if PopupVisible then
    S := TJvPopupWindow(FPopup).GetPopupText
  else
    S := GetDisplayText;
  if not PaintComboEdit(Self, S, FAlignment,
    FFocused and not PopupVisible, FCanvas, Msg) then
    inherited;
end;
{$ENDIF VCL}

{$IFDEF VisualCLX}
procedure TJvCustomNumEdit.Paint;
var
  S: string;
begin
  if PopupVisible then
    S := TJvPopupWindow(FPopup).GetPopupText
  else
    S := GetDisplayText;
  if not PaintComboEdit(Self, S, FAlignment,
    True, FFocused and not PopupVisible, Canvas) then
    inherited;
end;
{$ENDIF VisualCLX}

procedure TJvCustomNumEdit.FontChanged;
begin
  inherited FontChanged;
  Invalidate;
end;

//=== { TJvxCurrencyEdit } ===================================================

constructor TJvxCurrencyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlState := ControlState + [csCreating];
  try
    ButtonWidth := 0;
  finally
    ControlState := ControlState - [csCreating];
  end;
end;

function TJvxCurrencyEdit.DefaultDisplayFormat: string;
var
  CurrStr: string;
  I: Integer;
  C: Char;
begin
  Result := ',0.' + MakeStr('0', CurrencyDecimals);
  CurrStr := '';
  for I := 1 to Length(CurrencyString) do
  begin
    C := CurrencyString[I];
    if C in [',', '.'] then
      CurrStr := CurrStr + '''' + C + ''''
    else
      CurrStr := CurrStr + C;
  end;
  if Length(CurrStr) > 0 then
    case CurrencyFormat of
      0:
        Result := CurrStr + Result; { '$1' }
      1:
        Result := Result + CurrStr; { '1$' }
      2:
        Result := CurrStr + ' ' + Result; { '$ 1' }
      3:
        Result := Result + ' ' + CurrStr; { '1 $' }
    end;
  Result := Format('%s;-%s', [Result, Result]);
end;

//=== { TJvCustomCalcEdit } ==================================================

constructor TJvCustomCalcEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls];
  ControlState := ControlState + [csCreating];
  try
    FPopup := TJvPopupWindow(CreatePopupCalculator(Self {$IFDEF VCL}, BiDiMode {$ENDIF}));
    TJvPopupWindow(FPopup).OnCloseUp := PopupCloseUp;
    UpdatePopup;
  finally
    ControlState := ControlState - [csCreating];
  end;
end;

procedure TJvCustomCalcEdit.PopupChange;
begin
  inherited PopupChange;
  if EnablePopupChange then
    DoChange;
end;

class function TJvCustomNumEdit.DefaultImageIndex: TImageIndex;
var
  Bmp: TBitmap;
begin
  if GCalcImageIndex < 0 then
  begin
    Bmp := TBitmap.Create;
    try
      //Bmp.Handle := LoadBitmap(HInstance, sCalcBmp);
      Bmp.LoadFromResourceName(HInstance, sCalcBmp);
      GCalcImageIndex := DefaultImages.AddMasked(Bmp, clFuchsia);
    finally
      Bmp.Free;
    end;
  end;

  Result := GCalcImageIndex;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.