Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.04.2017, 17:21   #1
Anton94.by
Форумчанин
 
Регистрация: 16.10.2011
Сообщений: 115
Восклицание TNumberEdit

Подскажите, где можно взять рабочую версию компонента TNumberEdit.
Нужно переделать программу написанную с использованием данного компонента. Пытался использовать код который ниже, но не работает.
Код:
unit NumberEdit;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
type
  TOnChanged = procedure(Sender: TObject; AValue: extended) of object;
  TNumberEdit = class(TCustomEdit)
  private
    FValue: extended;
    FMin: extended;
    FMax: extended;
    FTolerance: extended;
    FStep: extended;
    FLargeStep: extended;
    FFloatPoint: boolean;
    FShift: extended;
    FErrorBeep: boolean;
    FAuthor: String;
    FOnChanged: TNotifyEvent;
    function GetValue: extended;
    procedure SetValue(v: extended);
    function GetIntValue: integer;
    procedure SetIntValue(v: integer);
    procedure SetMin(v: extended);
    procedure SetMax(v: extended);
    procedure SetTolerance(v: extended);
    procedure SetStep(v: extended);
    procedure SetLargeStep(v: extended);
    procedure SetShift(v: extended);
    procedure SetErrorBeep(v: boolean);
    procedure SetAuthor(v: string);
  protected
    procedure UpdateText;
    procedure WMChar(var Msg: TWMChar); message WM_Char;
    procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KeyDown;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  public
    property FloatPoint: boolean read FFloatPoint;
    property Modified;
    property SelLength;
    property SelStart;
    property SelText;
    constructor Create(AOwner: TComponent); override;
  published
    property Tolerance: extended read FTolerance write SetTolerance;
    property Min: extended read FMin write SetMin;
    property Max: extended read FMax write SetMax;
    property Value: extended read GetValue write SetValue;
    property Step: extended read FStep write SetStep;
    property LargeStep: extended read FLargeStep write SetLargeStep;
    property Shift: extended read FShift write SetShift;
    property ErrorBeep: boolean read FErrorBeep write SetErrorBeep;
    property Author: string read FAuthor write SetAuthor;
    property IntValue: integer read GetIntValue write SetIntValue;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property Enabled;
    property Font;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    property OnChaged: TNotifyEvent read FOnChanged write FOnChanged;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('Samples', [TNumberEdit]);
end;
procedure TNumberEdit.SetAuthor(v: string);
begin
end;
procedure TNumberEdit.UpdateText;
begin
  FValue := round((FValue - FShift) / FTolerance) * FTolerance + FShift;
  Text := FloatToStr(FValue);
end;
procedure TNumberEdit.WMKillFocus(var Msg: TWMKillFocus);
begin
  inherited;
  Value := GetValue;
end;
procedure TNumberEdit.WMChar(var Msg: TWMChar);
var
  s: String;
  p, PointPos: integer;
begin
  case Msg.CharCode of
    //0..9, Backspace
    48..57, 8: begin
      inherited;
    end;
    //Minus
    45: begin
      if FMin < 0 then begin
        p := SelStart;
        s := Text;
        if (Length(s) > 0) and (s[1] = '-') then begin
          delete(s, 1, 1);
          if p > 0 then dec(p);
        end {then} else begin
          insert('-', s, 1);
          inc(p);
        end; {else}
        Text := s;
        SelStart := p;
      end {then} else if FErrorBeep then Beep;
    end;
    // Float point
    44, 46: begin
      if FFloatPoint then begin
        Msg.CharCode := ord(DecimalSeparator);
        inherited;
        p := SelStart;
        s := Text;
        PointPos := pos(DecimalSeparator, s);
        if PointPos = p then begin
          PointPos := pos(DecimalSeparator, copy(s, p + 1, Length(s) - p));
          if PointPos > 0
          then delete(s, PointPos + p, 1);
        end {then}
        else delete(s, PointPos, 1);
        if (Length(s) > 0) and (s[2] = '-') then begin
          s[2] := s[1];
          s[1] := '-';
        end; {if}
        Text := s;
        SelStart := pos(DecimalSeparator, s);
      end {then} else if FErrorBeep then Beep;
    end; 
    // Enter
    13: begin
      Value := GetValue;
      SelectAll;
    end; 
    //Escape
    27: begin
      UpdateText;
      SelectAll;
    end;
    //Any other key
    else begin
      if FErrorBeep then Beep;
    end;
  end; {case}
end;
procedure TNumberEdit.WMKeyDown(var Msg: TWMKeyDown);
begin
  case Msg.CharCode of
    VK_UP: begin
      Value := GetValue;
      Value := FValue + FStep;
      SelectAll;
    end;
    VK_DOWN: begin
      Value := GetValue;
      Value := FValue - FStep;
      SelectAll;
    end;
    // PageUp
    33: begin
      Value := GetValue;
      Value := FValue + FLargeStep;
      SelectAll;
    end;
    // PageDown
    34: begin
      Value := GetValue;
      Value := FValue - FLargeStep;
      SelectAll;
    end;
    // Any other key
    else inherited;
  end; {case}
end;
constructor TNumberEdit.Create(AOwner: TComponent);
begin
  inherited;
  FMin := 0;
  FMax := 100;
  FTolerance := 1;
  FStep := 1;
  FLargeStep := 5;
  UpdateText;
  FErrorBeep := true;
  FAuthor := 'Karapetyan';
end;
function TNumberEdit.GetValue: extended;
begin
  if Text = ''
    then result := 0
    else result := StrToFloat(Text);
end;
procedure TNumberEdit.SetValue(v: extended);
var
  OldValue: extended;
begin
  OldValue := FValue;
  if v > FMax
  then v := FMax
  else if v < FMin then v := FMin;
  if OldValue = v then Exit;
  FValue := v;
  UpdateText;
  if Assigned(FOnChanged) then FOnChanged(self);
end;
function TNumberEdit.GetIntValue: integer;
begin
  if Text = ''
    then result := 0
    else result := round(StrToFloat(Text));
end;
procedure TNumberEdit.SetIntValue(v: integer);
var
  OldValue: integer;
begin
  OldValue := round(FValue);
  if v > FMax
  then v := trunc(FMax)
  else if v < FMin then v := trunc(FMin);
  if OldValue = v then Exit;
  FValue := v;
  UpdateText;
  if Assigned(FOnChanged) then FOnChanged(self);
end;
procedure TNumberEdit.SetMin(v: extended);
begin
  if v <= FMax - FTolerance
  then FMin := round((v - FShift) / FTolerance) * FTolerance + FShift
  else FMin := FMax - FTolerance;
  Value := FValue;
end;
procedure TNumberEdit.SetMax(v: extended);
begin
  if v >= FMin + FTolerance
  then FMax := round((v - FShift) / FTolerance) * FTolerance + FShift
  else FMax := FMin + FTolerance;
  Value := FValue;
end;
procedure TNumberEdit.SetTolerance(v: extended);
begin
  if (FTolerance <> abs(v)) then begin
    if v = 0
    then FTolerance := 1
    else FTolerance := abs(v);
    FFloatPoint := not (round(FTolerance) = FTolerance);
    FMin := round(FMin / FTolerance) * FTolerance;
    FMax := round(FMax / FTolerance) * FTolerance;
    if FMax <= FMin then FMax := FMin + FTolerance;
    Step := FStep;
    LargeStep := FLargeStep;
    Value := FValue;
  end; {if}
end;
procedure TNumberEdit.SetStep(v: extended);
begin
  FStep := abs(v);
  if FStep < FTolerance then FStep := FTolerance;
  FStep := round(FStep / FTolerance) * FTolerance;
  if FLargeStep < FStep then FLargeStep := FStep;
end;
procedure TNumberEdit.SetLargeStep(v: extended);
begin
  FLargeStep := abs(v);
  if FLargeStep < FStep then FLargeStep := FStep;
  FLargeStep := round(FLargeStep / FTolerance) * FTolerance;
end;
procedure TNumberEdit.SetShift(v: extended);
begin
  if FShift <> v then begin
    FShift := v;
    Min := FMin;
    Max := FMax;
    Value := FValue;
  end;
end;
procedure TNumberEdit.SetErrorBeep(v: boolean);
begin
  FErrorBeep := v;
end;
end.

Последний раз редактировалось Anton94.by; 19.04.2017 в 17:24.
Anton94.by вне форума Ответить с цитированием
Старый 20.05.2017, 08:41   #2
Sciv
Старожил
 
Аватар для Sciv
 
Регистрация: 16.05.2012
Сообщений: 3,211
По умолчанию

Что Вы понимаете под "не работает"?
Начал решать проблему с помощью регулярных выражений. Теперь решаю две проблемы...
Sciv вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск