abnumedit.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

  if FormatFloat(fFormatStr,FValue) = Text then exit;
  SetText(Value);
end;

function TAbNumEdit.CheckValue(Value: Double): Double;
begin
  Result := Value;
  if (eoLimitMin in Options) then
  begin
    LimitLo := (Value <= FMinValue);
    if Value <= FMinValue then begin
      Result := FMinValue;
    end;
  end;
  if (eoLimitMax in Options) then begin
    LimitUp := (Value >= FMaxValue);
    if Value >= FMaxValue then begin
      Result := FMaxValue;
    end;
  end;
end;

procedure TAbNumEdit.SetState(Value : TNumEditState);
begin
  if FState <> Value then begin
    FState := Value;

    case state of
      esNormal:  Color := ColorDefault;
      esEditing: Color := ColorEditing;
      esError:
        begin
          Color := ColorError;
          Application.ProcessMessages;
          Beep;
        end;
    end;

  end;
end;


procedure TAbNumEdit.CMEnter(var Message: TCMGotFocus);
begin
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited;
end;

procedure TAbNumEdit.SetText(ExtValue : Extended);
var
  LimitLow, LimitHigh : Extended;
  intValue : integer;
  singleValue : Single;
begin
  intValue := 0;
  singleValue := 0;

  // ===========================================================================
  // Range and Limit -check
  // ===========================================================================

    LimitLow  := eBase[ord(FEditBase)].MinValue;
    LimitHigh := eBase[ord(FEditBase)].MaxValue;

{    if (eoLimitMin in FOptions) then begin
      if LimitLow < FMinValue then begin
        LimitLow := FMinValue;
      end;
    end;

    if (eoLimitMax in FOptions) then begin
      if LimitHigh > FMaxValue then begin
        LimitHigh := FMaxValue;
      end;
    end;


    LimitLow := CheckValue(eBase[ord(FEditBase)].MinValue);
    LimitHigh := CheckValue(eBase[ord(FEditBase)].MaxValue);
 }
    if ExtValue < LimitLow then ExtValue := LimitLow;
    if ExtValue > LimitHigh then ExtValue := LimitHigh;


    if (ExtValue > -1.5e45) and (ExtValue < 3.4e38) then begin
      singleValue := ExtValue;
    end else if (ExtValue < -1.5e45) then begin
      singleValue := -1.5e45;
    end else if (ExtValue > 3.4e38) then begin
      singleValue := 3.4e38;
    end;

    if (ExtValue < 2147483647) and (ExtValue > -2147483647) then
      intValue := Round(ExtValue)
    else if (ExtValue > 2147483647) then
      intValue := 2147483647
    else if (ExtValue < -2147483647) then
      intValue := -2147483647;


  // ===========================================================================
  // Write to edit if enabled
  // ===========================================================================


      FValue := ExtValue;
      FValueAsSingle := singleValue;
      FValueAsInt := intValue;
      FValueAsHex := IntToHex(intValue,FDigitsHex);
      FValueAsBool := AbIntToBin(intValue,FDigitsBool);

     // LimitLo := ((eoLimitMin in FOptions) and (FValue <= LimitLow));
     // LimitUp := ((eoLimitMax in FOptions) and (FValue >= LimitHigh));

      case EditBase of
        ebBin : begin
                  Text := FValueAsBool;
                end;
        ebHex : begin
                  Text := FValueAsHex;
                end;
        ebFloat : begin
                  Text := FormatFloat(fFormatStr,FValue);
                end;
        ebInt : begin
                  Text := IntToStr(FValueAsInt);
                end;
      end;
      SetState(esNormal);
      if FirstDraw then FirstDraw := false
      else if Assigned(FOnValueChanged) and (OldText <> Text) then
        FOnValueChanged(self);


      OldText := Text;

end;



function TAbNumEdit.CheckEdit(WriteEnable : Boolean): Boolean;
var
  n, nn : Integer;
  lEditBase : TEditBase;      // local edit base
  posFrom, posTo : Integer;   // from/to position to cut the string
  selTextFrom, selTextTo : Integer;  // select from first until last invalid char
  Str : String;
  lEBase : TBaseProperties;
  multi : Single ;            // Multiplicator
  signCount,expSignCount : integer;
  exp : Boolean;
  ExtValue : Extended;
begin
  result := true;
  if (Text = '') then begin
    SetState(esEditing);
    exit;
  end;

  ExtValue := 0;
  posFrom := 1;
  posTo   := Length(Text);
  SelTextFrom := 0;
  SelTextTo := 0;
  multi := 1;
  signCount :=0;
  expSignCount  :=0;
  exp := false;


  // check first char, may this will change the EditBase
  // ===========================================================================
  if  (pos(Text[1],ValidFirstChar) <> 0) then posFrom := 2;

//  leBase := eBase[ord(EditBase)];

  Case Text[1] of
  '$' : begin          // hex
          lEditBase := ebHex;
        end;
  '&' : begin          // Bin
          lEditBase := ebBin;
        end;
  '%' : begin          // integer
          lEditBase := ebInt;
        end;
  '!' : begin          // Single
          lEditBase := ebFloat;
        end;
  else
     lEditBase := EditBase;
  end;

  leBase := eBase[ord(lEditBase)];



  // ===========================================================================
  // check last char if enabled, may this is a multiplicator
  // ===========================================================================
  if leBase.MultiEnable and (pos(Text[posTo],ValidMultipChars) <> 0) then begin
     multi := Factors[(pos(Text[posTo],ValidMultipChars))-1];
     if (lEditBase = ebFloat) then begin
       PosTo := PosTo -1;
     end else begin             // all others accept only multi>1
       if multi > 1 then
          PosTo := PosTo -1
       else begin
         Multi := 1;
       end;
     end;
  end;

  if (PosFrom+PosTo) <> 1 then
    str := Copy(Text,posFrom,PosTo-PosFrom+1);

  If Str <> '' then begin
    // check first char may +/- sign
    // ===========================================================================
    if (pos(Text[posFrom],leBase.Sign) <> 0) then signCount :=1;


  // ===========================================================================
  // check the other chars according EditBase
  // ===========================================================================
    for n := posFrom+SignCount to posTo do begin
      if (pos(Text[n],ExpChars) <> 0) and leBase.ExpEnable then begin  // check exp., if is exp-char
        exp := true;                              // then break for/next-loop
        break;
      end;
      if (pos(Text[n],leBase.ValidChars) = 0) then
        if selTextFrom = 0 then begin
          selTextFrom := n;
          SelTextTo := n;
        end else SelTextTo := n;
    end;

    if exp and leBase.ExpEnable then begin                  // check exponent
      inc(n);
      if (pos(str[n],leBase.Sign) <> 0) then expSignCount :=1;
      for nn := n+expSignCount to posTo do begin
        if (pos(Text[nn],leBase.ValidChars) = 0) then
          if selTextFrom = 0 then begin
            selTextFrom := nn;
            SelTextTo := nn;
          end else SelTextTo := nn;
      end;
    end;
    //      Check that DecimalSeparator is only used once
    nn := 0;
    for n := PosFrom to PosTo do begin
       if Text[n] = DecimalSeparator then begin
         inc(nn);
         if nn > 1 then       // if more than once then mark the text
            if selTextFrom = 0 then begin
              selTextFrom := n;
              SelTextTo := n;
            end else if n > SelTextTo then SelTextTo:= n;
       end;
    end;
  end;


  // ===========================================================================
  // select the text from first until last invalid char or convert the string
  // ===========================================================================
  if selTextFrom > 0 then begin
    SetState(esError);
    if Enabled and Visible and not (csDesigning in ComponentState) then SetFocus;
    SelStart := selTextFrom-1;
    SelLength := SelTextTo - selTextFrom+1;
    result := false;
  end else begin
    if (Text <> OldText) and not WriteEnable then begin
      SetState(esEditing);
    end else begin
      SetState(esNormal);
    end;

    // correct if Text contains only one sign
    if (pos(str,leBase.Sign) <> 0) then  Str := Str+'0';

    // correct if Text firstchar is exp-sign
    if leBase.ExpEnable and (Length(str)>0) and (pos(str[1],ExpChars) <> 0) then Str := '1'+Str;

    // correct if Firstchar is multiplicator
    if leBase.MultiEnable and (multi <> 1) and (Str='') then Str := '1';

    str := AbRemoveSign(str,THOUSANDSEPARATOR);   //ignore THOUSANDSEPARATOR
    
  // ===========================================================================
  // get the Value from string & multiply with factor
  // ===========================================================================
    if str <> '' then
      case lEditBase of
      ebBin : begin
                ExtValue := AbBinToInt(Str);
              end;
      ebHex : begin
                ExtValue := StrToInt('$'+Str);
              end;
      ebInt : begin
                ExtValue := StrToInt(Str);
              end;
      ebFloat : begin
                ExtValue := StrToFloat(Str);
              end;
      end else ExtValue := 0;
     if multi <> 1 then ExtValue := ExtValue * multi;

     if WriteEnable then SetText(CheckValue(ExtValue));
  end;


end;

procedure TAbNumSpin.WMSize(var Message: TWMSize);
var
  MinHeight: Integer;
begin
  inherited;
  MinHeight := GetMinHeight;
  if Height < MinHeight then
    Height := MinHeight
  else if FButton <> nil then
  begin
    if NewStyleControls and Ctl3D then
      FButton.SetBounds(Width - FButton.Width - 4, 0, FButton.Width-1, Height -4)
    else FButton.SetBounds (Width - FButton.Width+1, 1, FButton.Width-1, Height -3);
    SetEditRect;
  end;
end;

procedure TAbNumSpin.SetStartDelay(Value : Integer);
begin
  FButton.StartDelay := Value;
end;

function TAbNumSpin.GetStartDelay: Integer;
begin
  result := FButton.StartDelay;
end;

procedure TAbNumSpin.SetInterval(Value : Integer);
begin
  FButton.Interval := Value;
end;

function TAbNumSpin.GetInterval: Integer;
begin
  result := FButton.Interval;
end;



function TAbNumSpin.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 +2;
end;

procedure TAbNumSpin.SetEditRect;
var
  r: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@r));
  r.Bottom := ClientHeight + 1;
  r.Right := ClientWidth - FButton.Width - 2;
  r.Top := 0;
  r.Left := 0;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@r));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@r));  {debug}
end;

constructor TAbNumSpin.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButton := TAbSpinButton.Create (Self);
  FButton.SetBounds(Width - 11, 0, 16, Height -4);
  FButton.Visible := True;
  FButton.Parent := Self;
  FButton.FocusControl := Self;
  ControlStyle := ControlStyle - [csSetCaption];
  FButton.OnUpClick := UpClick;
  FButton.OnDownClick := DownClick;
end;

procedure TAbNumSpin.Limit;
begin
  FButton.FUpButton.Enabled := not LimitUp;
  FButton.FDownButton.Enabled := not LimitLo;
  //if LimitUp then FButton.FUpButton.perform(WM_LBUTTONUP,0,0);
  //if LimitLo then FButton.FDownButton.perform(WM_LBUTTONUP,0,0);
  //FButton.FUpButton.Invalidate;
  //FButton.FDownButton.Invalidate;
  inherited Limit;
end;


procedure TAbNumSpin.SetEnabled(Value: Boolean);
begin
  {$IFDEF CEnabled} inherited SetEnabled(Value); {$ENDIF}
  FButton.Enabled := Value;
  FButton.FUpButton.Enabled := FButton.Enabled and (not LimitUp);
  FButton.FDownButton.Enabled := FButton.Enabled and (not LimitLo);
end;

procedure TAbNumSpin.SetState (Value : TNumEditState);
begin
  if (FButton = nil) or (State = Value) then exit;
  inherited SetState(Value);
    case state of
      esNormal:
        begin
          FButton.FUpButton.Enabled := FButton.Enabled and (not LimitUp);
          FButton.FDownButton.Enabled := FButton.Enabled and (not LimitLo);
        end;
    else
      FButton.FUpButton.Enabled   := false;
      FButton.FDownButton.Enabled := false;
    end;
end;


procedure TAbNumSpin.CreateWnd;
begin
  inherited CreateWnd;
  SetEditRect;
end;

destructor TAbNumSpin.Destroy;
begin
  FButton.Free;
  FButton := nil;
  inherited Destroy;
end;



initialization
  EBase[ord(ebBin)].ValidChars := '01';
  EBase[ord(ebBin)].ExpEnable := false;
  EBase[ord(ebBin)].MultiEnable := False;
  EBase[ord(ebBin)].Sign := '';
  EBase[ord(ebBin)].MinValue := -2147483647;
  EBase[ord(ebBin)].MaxValue := 2147483647;

  EBase[ord(ebHex)].ValidChars := '0123456789abcdefABCDEF';
  EBase[ord(ebHex)].ExpEnable := false;
  EBase[ord(ebHex)].MultiEnable := False;
  EBase[ord(ebHex)].Sign := '';
  EBase[ord(ebHex)].MinValue := -2147483647;
  EBase[ord(ebHex)].MaxValue := 2147483647;

  EBase[ord(ebFloat)].ValidChars := '0123456789'+DecimalSeparator+THOUSANDSEPARATOR;
  EBase[ord(ebFloat)].ExpEnable := true;
  EBase[ord(ebFloat)].MultiEnable := True;
  EBase[ord(ebFloat)].Sign := '+-';
  EBase[ord(ebFloat)].MinValue := -5.0e324;
  EBase[ord(ebFloat)].MaxValue := 1.7e308;

  EBase[ord(ebInt)].ValidChars := '0123456789'+THOUSANDSEPARATOR;
  EBase[ord(ebInt)].ExpEnable := false;
  EBase[ord(ebInt)].MultiEnable := True;
  EBase[ord(ebInt)].Sign := '+-';
  EBase[ord(ebInt)].MinValue := -2147483647;
  EBase[ord(ebInt)].MaxValue := 2147483647;

finalization

end.