wnnumberedit.pas

一个处理数字的Edit的组件

begin
   if (Value < FDecimalNumber) or (Value > FloatMaxLength) then
      Exit;
   FDigitalNumber := Value;
   Invalidate;
end;

{ 读取FocusedColor }

function TWNCurrencyEdit.GetFocusedColor: TColor;
begin
   Result := FFocusedColor;
end;

{ 设定FocusedColor }

procedure TWNCurrencyEdit.SetFocusedColor(Value: TColor);
begin
   FFocusedColor := Value;
   Invalidate;
end;

function TWNCurrencyEdit.GetGridLineColor: TColor;
begin
   Result := FGridLineColor;
end;

procedure TWNCurrencyEdit.SetGridLineColor(Value: TColor);
begin
   FGridLineColor := Value;
   Invalidate;
end;

function TWNCurrencyEdit.GetGridLineWidth: Integer;
begin
   Result := FGridLineWidth;
end;

procedure TWNCurrencyEdit.SetGridLineWidth(Value: Integer);
begin
   FGridLineWidth := Value;
   Invalidate;
end;

function TWNCurrencyEdit.GetKilobitSeparatorColor: TColor;
begin
   Result := FKilobitSeparatorColor;
end;

procedure TWNCurrencyEdit.SetKilobitSeparatorColor(Value: TColor);
begin
   FKilobitSeparatorColor := Value;
   Invalidate;
end;

function TWNCurrencyEdit.GetMaxLength: Integer;
begin
   Result := FMaxLength;
end;

procedure TWNCurrencyEdit.SetMaxLength(Value: Integer);
begin
   if (Value < 0) or (Value > FloatMaxLength) then
      Exit;
   FMaxLength := Value;
end;

function TWNCurrencyEdit.GetMoveOutAllowed: Boolean;
begin
   Result := FMoveOutAllowed;
end;

procedure TWNCurrencyEdit.SetMoveOutAllowed(Value: Boolean);
begin
   FMoveOutAllowed := Value;
end;

function TWNCurrencyEdit.GetNegativeColor: TColor;
begin
   Result := FNegativeColor;
end;

procedure TWNCurrencyEdit.SetNegativeColor(Value: TColor);
begin
   FNegativeColor := Value;
   if (FNegativeSign = -1) then
      DrawText;
end;

procedure TWNCurrencyEdit.SetNegativeFont(Value: TFont);
begin
   FNegativeFont.Assign(Value);
   if (FNegativeSign = -1) then
      DrawText;
end;

function TWNCurrencyEdit.GetReadOnly: Boolean;
begin
   Result := FReadOnly;
end;

procedure TWNCurrencyEdit.SetReadOnly(Value: Boolean);
begin
   FReadOnly := Value;
end;

function TWNCurrencyEdit.GetShowNegativeColor: Boolean;
begin
   Result := FShowNegativeColor;
end;

procedure TWNCurrencyEdit.SetShowNegativeColor(Value: Boolean);
begin
   FShowNegativeColor := Value;
   if (FNegativeSign = -1) then
      DrawText;
end;

function TWNCurrencyEdit.GetShowNegativeFont: Boolean;
begin
   Result := FShowNegativeFont;
end;

procedure TWNCurrencyEdit.SetShowNegativeFont(Value: Boolean);
begin
   FShowNegativeFont := Value;
   if (FNegativeSign = -1) then
      DrawText;
end;

function TWNCurrencyEdit.GetShowNegativeSign: Boolean;
begin
   Result := FShowNegativeSign;
end;

procedure TWNCurrencyEdit.SetShowNegativeSign(Value: Boolean);
begin
   FShowNegativeSign := Value;
   if (FNegativeSign = -1) then
      DrawText;
end;

function TWNCurrencyEdit.GetTextLayout: TTextLayout;
begin
   Result := FTextLayout;
end;

procedure TWNCurrencyEdit.SetTextLayout(Value: TTextLayout);
begin
   FTextLayout := Value;
   DrawText;
end;

function TWNCurrencyEdit.GetValue: Currency;
begin
   Result := FValue * FNegativeSign;
   
end;

procedure TWNCurrencyEdit.SetValue(Value: Currency);
begin
   if (Value >= 0) then
   begin

      FValue := StrtoFloat(formatfloat('0.00',Value));
      FNegativeSign := 1;
   end
   else
   begin
      FValue := -StrtoFloat(formatfloat('0.00',Value));
      FNegativeSign := -1;
   end;
   FOriginValue := StrtoFloat(formatfloat('0.00',Value));
   SyncCursorPos;
   DrawText;

   FModified := false;
   FChineseCurrencyStr:=ArabiaToChinese(FValue);
end;

function TWNCurrencyEdit.GetZeroEmpty: Boolean;
begin
   Result := FZeroEmpty;
end;

procedure TWNCurrencyEdit.SetZeroEmpty(Value: Boolean);
begin
   FZeroEmpty := Value;
   DrawText;
end;

procedure TWNCurrencyEdit.BeforeChange;
begin
   if Assigned(FOnBeforeChange) then
      FOnBeforeChange(Self);
end;

procedure TWNCurrencyEdit.Change;
begin
   if Assigned(FOnChange) then
      FOnChange(Self);
end;

procedure TWNCurrencyEdit.CMCtl3DChanged(var Message: TMessage);
begin
   if NewStyleControls and (FBorderStyle = bsSingle) then
      RecreateWnd;
   inherited;
end;

procedure TWNCurrencyEdit.CMEnter(var Message: TMessage);
begin
   inherited;
   FCursorXPos := FDigitalNumber - FDecimalNumber - 1;
end;

procedure TWNCurrencyEdit.SyncCursorPos;
var
   OldCursorVisible: Boolean;
   Len: Integer;
begin
   OldCursorVisible := FCursorVisible;
   SetCursorState(false);
   Len := Length(FormatFloat(FFormatString, FValue));
   if (FCursorXPos < FDigitalNumber - (Len - FDotLength) - 1) then
      FCursorXPos := FDigitalNumber - FDecimalNumber - 1;
   SetCursorState(OldCursorVisible);
end;

procedure TWNCurrencyEdit.ChangeValue(Value: Extended);
var
  tmp:Currency;
begin
   tmp:=FValue;
   if not FModified then
   begin
      BeforeChange;
      FModified := true;
   end;

   if (Value >= 0) then
   begin
      try
        FValue := Value;
        FNegativeSign := 1;
      except
        FValue:=tmp;
      end;
   end
   else
   begin
      try
        FValue := -Value;
        FNegativeSign := -1;
      except
        FValue:=tmp;
      end;
   end;
   DrawText;
   FChineseCurrencyStr:=ArabiaToChinese(FValue);
   Change;

end;

constructor TWNCurrencyEdit.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   AutoInitialize;
end;

procedure TWNCurrencyEdit.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   with Params do
   begin
      Style := Style or BorderStyles[FBorderStyle];
      if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
      begin
         Style := Style and not WS_BORDER;
         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
      end;
   end;
end;

procedure TWNCurrencyEdit.CursorTimerHandle(Sender: TObject);
begin
   DrawCursor;
end;

procedure TWNCurrencyEdit.DecodeCursorX(X: Integer);
var
   I, Len: Integer;
begin
   Len := Length(FormatFloat(FFormatString, FValue));
   for I := 0 to FDigitalNumber - 1 do
      if (X >= (FWorkCellWidth + FGridLineWidth) * I + FWorkCellOffset) and
         (X <= (FWorkCellWidth + FGridLineWidth) * I + FWorkCellWidth - 1 + FWorkCellOffset) then
      begin
         if (I < FDigitalNumber - (Len - FDotLength) - 1) then
            FCursorXPos := FDigitalNumber - (Len - FDotLength) - 1
         else
            FCursorXPos := I;
         Break;
      end;
end;

destructor TWNCurrencyEdit.Destroy;
begin
   AutoDestroy;
   inherited Destroy;
end;

procedure TWNCurrencyEdit.DrawCursor;
var
   OldPenColor: TColor;
   OldPenMode: TPenMode;
   CursorX: Integer;
begin
   CursorX := (FWorkCellWidth + FGridLineWidth) * FCursorXPos + FWorkCellOffset + ((FWorkCellWidth - FCursorWidth) div 2);
   with Self.Canvas do
   begin
      OldPenColor := Pen.Color;
      OldPenMode := Pen.Mode;

      Pen.Color := Self.Color;
      Pen.Mode := pmXor;
      PolyLine([Point(CursorX, FCursorY), Point(CursorX + FCursorWidth - 1, FCursorY),
         Point(CursorX + FCursorWidth - 1, FCursorY + 1), Point(CursorX - 1, FCursorY + 1)]);

      Pen.Color := OldPenColor;
      Pen.Mode := OldPenMode;
   end;
   FCursorVisible := not FCursorVisible;
end;

procedure TWNCurrencyEdit.DrawGrid;
var
   I: Integer;
   BrushColor: TColor;
   OldPenColor: TColor;
   OldPenWidth: Integer;
   OldPenPos: TPoint;
   OldBrushColor: TColor;
   OldCursorVisible: Boolean;
begin
   OldCursorVisible := FCursorVisible;
   SetCursorState(False);

   if Focused then
      BrushColor := FocusedColor
   else
      if (FNegativeSign = -1) and (ShowNegativeColor) then
      BrushColor := NegativeColor
   else
      BrushColor := Color;
   OldBrushColor := Canvas.Brush.Color;
   Canvas.Brush.Color := BrushColor;
   Canvas.FillRect(ClientRect);
   Canvas.Brush.Color := OldBrushColor;

   OldPenColor := Canvas.Pen.Color;
   OldPenWidth := Canvas.Pen.Width;
   OldPenPos := Canvas.PenPos;

   Canvas.Pen.Width := FGridLineWidth;
   for I := 1 to FDigitalNumber - 1 do
   begin
      if ((FDigitalNumber - FDecimalNumber - I) = 0) then
         Canvas.Pen.Color := FDecimalSeparatorColor
      else
         if ((FDigitalNumber - FDecimalNumber - I) mod 3 = 0) then
         Canvas.Pen.Color := FKilobitSeparatorColor
      else
         Canvas.Pen.Color := FGridLineColor;
      Canvas.MoveTo((FWorkCellWidth + FGridLineWidth) * I - FGridLineWidth + FWorkCellOffset, 0);
      Canvas.LineTo((FWorkCellWidth + FGridLineWidth) * I - FGridLineWidth + FWorkCellOffset, ClientHeight);
   end;

   Canvas.Pen.Color := OldPenColor;
   Canvas.Pen.Width := OldPenWidth;
   Canvas.PenPos := OldPenPos;

   SetCursorState(OldCursorVisible);
end;

procedure TWNCurrencyEdit.DrawText;
var
   I, Len: Integer;
   Text: string;
   XOffset, YOffset: Integer;
   TheRect: TRect;
   BrushColor: TColor;
   OldBrushColor: TColor;
   OldCursorVisible: Boolean;
begin
   OldCursorVisible := FCursorVisible;
   SetCursorState(False);

   OldBrushColor := Canvas.Brush.Color;
   if Focused then
      BrushColor := FocusedColor
   else
      if (FNegativeSign = -1) and (ShowNegativeColor) then
      BrushColor := NegativeColor
   else
      BrushColor := Color;
   Canvas.Brush.Color := BrushColor;

   if (FNegativeSign = -1) and (ShowNegativeFont) then
      Canvas.Font.Assign(NegativeFont)
   else
      Canvas.Font.Assign(Font);
   FCursorWidth := Canvas.TextWidth('0') + 2;

   if (FZeroEmpty and (FValue = 0) and not Focused) then
   begin
      Canvas.FillRect(Rect(0, 0, FWorkCellWidth + FWorkCellOffset, ClientHeight));
      for I := 1 to FDigitalNumber - 1 do
         Canvas.FillRect(Rect((FWorkCellWidth + FGridLineWidth) * I + FWorkCellOffset, 0, (FWorkCellWidth + FGridLineWidth) * I + FWorkCellWidth + FWorkCellOffset, ClientHeight));
   end
   else
   begin
      if (FNegativeSign = -1) and (ShowNegativeSign) then
         Text := FormatFloat(FFormatString, Value)
      else
         Text := FormatFloat(FFormatString, FValue);
      Len := Length(Text);
      if (FCurrencySymbol <> '') then
      begin
         if (FDigitalNumber - (Len - FDotLength) < 1) then
         begin
            Text := StringOfChar('*', FDigitalNumber - FDecimalNumber - 1) + StringOfChar('.', FDotLength) + StringOfChar('*', FDecimalNumber);
            Len := FDigitalNumber + FDotLength - 1;
         end;
      end
      else
      begin
         if (FDigitalNumber - (Len - FDotLength) < 0) then
         begin
            Text := StringOfChar('*', FDigitalNumber - FDecimalNumber) + StringOfChar('.', FDotLength) + StringOfChar('*', FDecimalNumber);
            Len := FDigitalNumber + FDotLength;
         end;
      end;
      case FTextLayout of
         tlTop: YOffset := 0;
         tlCenter: YOffset := (ClientHeight - Canvas.TextHeight('0')) div 2 + 1;
         tlBottom: YOffset := ClientHeight - Canvas.TextHeight('0');
         else
            YOffset := 0;
      end;
      FCursorY := YOffset + Canvas.TextHeight('0') + 0;
      if (FCursorY + 1 >= ClientHeight) then
         FCursorY := ClientHeight - 2;

      if (FCurrencySymbol <> '') then
      begin
         Canvas.FillRect(Rect(0, 0, FWorkCellWidth + FWorkCellOffset, ClientHeight));
         XOffset := (FWorkCellWidth - Canvas.TextWidth(FCurrencySymbol)) div 2;
         if FCurrencySymbolAligned or (FDigitalNumber - (Len - FDotLength) = 1) then
         begin