wnnumberedit.pas

一个处理数字的Edit的组件

procedure TWNNumberEdit.setmax(Value: extended);
begin
	 if fmax <> Value then
	 begin
			if fmin > Value then
			begin
				 showmessage('最大值不能够小于最小值!');
				 Value := fmax;
			end;
			fmax := Value;
			setvalue(getvalue);
	 end;
end;

procedure TWNNumberEdit.keypress;
var
	 ts: string;
	 //   result:extended;
begin

	 if key = #27 then
	 begin
			setvalue(foldval);
			selectall;
			inherited;
			exit;
	 end;
	 if key < #32 then
	 begin
			inherited;
			exit;
	 end;
	 ts := copy(text, 1, selstart) + copy(text, selstart + sellength + 1, 500);
	 if (key < '0') or (key > '9') then
			if (key <> fdec) and (key <> '-') then
			begin
				 inherited;
				 key := #0;
				 exit;
			end;
	 if key = fdec then
			if pos(fdec, ts) <> 0 then
			begin
				 inherited;
				 key := #0;
				 exit;
			end;
	 if key = '-' then
			if pos('-', ts) <> 0 then
			begin
				 inherited;
				 key := #0;
				 exit;
			end;
	 if key = '-' then
			if fmin >= 0 then
			begin
				 inherited;
				 key := #0;
				 exit;
			end;
	 if key = fdec then
			if fdigits = 0 then
			begin
				 inherited;
				 key := #0;
				 exit;
			end;
	 //
	 ts := copy(text, 1, selstart) + key + copy(text, selstart + sellength + 1, 500);
	 //
	 if key > #32 then
			if pos(fdec, ts) <> 0 then
			begin
				 if length(ts) - pos(fdec, ts) > fdigits then
				 begin
						inherited;
						key := #0;
						exit;
				 end;
			end;
	 if key = '-' then
			if pos('-', ts) <> 1 then
			begin
				 inherited;
				 key := #0;
				 exit;
			end;

	 if ts = '' then
	 begin
			inherited;
			key := #0;
			text := floattostrf(fmin, fffixed, 18, fdigits);
			selectall;
			exit;
	 end;
	 if ts = '-' then
	 begin
			inherited;
			key := #0;
			text := '-0';
			selstart := 1;
			sellength := 1;
			exit;
	 end;
	 if ts = fdec then
	 begin
			inherited;
			key := #0;
			text := '0' + fdec + '0';
			selstart := 2;
			sellength := 1;
			exit;
	 end;
	 inherited;
end;

{ TWNCurrencyEdit }

function sncStuff(S, Pattern: string; Index, Len: Integer): string;
var
	 SLen, I: Integer;
	 S1, S2: string;
begin
	 Result := '';
	 SLen := Length(S);
	 if (Index < 1) or (Len < 0) or (Index > SLen + 1) or (Index + Len > SLen + 1) then
      Exit;
   S1 := '';
   S2 := '';
   for I := 1 to SLen do
      if (I < Index) then
         S1 := S1 + S[I]
      else
         if (I > Index + Len - 1) then
         S2 := S2 + S[I];
   Result := S1 + Pattern + S2;
end;

procedure DrawCurrencyFrame(DestCanvas: TCanvas; DestRect: TRect; CurrencyEdit: TWNCurrencyEdit; DestValue: Extended);
var
   DotLength: Integer;
   FormatString: string;
   WorkCellOffset, WorkCellWidth: Integer;
   DestHeight, DestWidth: Integer;

   I, Len: Integer;
   BrushColor: TColor;
   OldPenColor: TColor;
   OldPenWidth: Integer;
   OldPenPos: TPoint;
   OldBrushColor: TColor;
   OldFont: TFont;

   DestText: string;
   XOffset, YOffset: Integer;
   TheRect: TRect;
begin
   OldFont := TFont.Create;
   OldFont.Assign(DestCanvas.Font);
   OldBrushColor := DestCanvas.Brush.Color;

   //  DestRect

   DestHeight := DestRect.Bottom - DestRect.Top;
   DestWidth := DestRect.Right - DestRect.Left;

   with CurrencyEdit do
   begin
      if (DecimalNumber = 0) then
         DotLength := 0
      else
         DotLength := 1;
      FormatString := '0' + StringOfChar('.', DotLength) + StringOfChar('0', DecimalNumber);
      WorkCellWidth := (DestWidth - GridLineWidth * (DigitalNumber - 1)) div DigitalNumber;
      WorkCellOffset := DestWidth - GridLineWidth * (DigitalNumber - 1) - WorkCellWidth * DigitalNumber;

      if (DestValue < 0) and (ShowNegativeColor) then
         BrushColor := NegativeColor
      else
         BrushColor := Color;
      DestCanvas.Brush.Color := BrushColor;
      DestCanvas.FillRect(DestRect);

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

      DestCanvas.Pen.Width := GridLineWidth;
      for I := 1 to DigitalNumber - 1 do
      begin
         if ((DigitalNumber - DecimalNumber - I) = 0) then
            DestCanvas.Pen.Color := DecimalSeparatorColor
         else
            if ((DigitalNumber - DecimalNumber - I) mod 3 = 0) then
            DestCanvas.Pen.Color := KilobitSeparatorColor
         else
            DestCanvas.Pen.Color := GridLineColor;
         DestCanvas.MoveTo(DestRect.Left + (WorkCellWidth + GridLineWidth) * I - GridLineWidth + WorkCellOffset, DestRect.Top);
         DestCanvas.LineTo(DestRect.Left + (WorkCellWidth + GridLineWidth) * I - GridLineWidth + WorkCellOffset, DestRect.Bottom);
      end;

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

      if (DestValue < 0) and (ShowNegativeFont) then
         DestCanvas.Font.Assign(NegativeFont)
      else
         DestCanvas.Font.Assign(Font);

      if (ZeroEmpty and (DestValue = 0)) then
      begin
         DestCanvas.FillRect(Rect(DestRect.Left, DestRect.Top, DestRect.Left + WorkCellWidth + WorkCellOffset - 1, DestRect.Bottom));
         for I := 1 to DigitalNumber - 1 do
            DestCanvas.FillRect(Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellWidth + WorkCellOffset - 1, DestRect.Bottom));
      end
      else
      begin
         if (DestValue < 0) and not ShowNegativeSign then
            DestText := FormatFloat(FormatString, -DestValue)
         else
            DestText := FormatFloat(FormatString, DestValue);
         Len := Length(DestText);
         if (CurrencySymbol <> '') then
         begin
            if (DigitalNumber - (Len - DotLength) < 1) then
            begin
               DestText := StringOfChar('*', DigitalNumber - DecimalNumber - 1) + StringOfChar('.', DotLength) + StringOfChar('*', DecimalNumber);
               Len := DigitalNumber + DotLength - 1;
            end;
         end
         else
         begin
            if (DigitalNumber - (Len - DotLength) < 0) then
            begin
               DestText := StringOfChar('*', DigitalNumber - DecimalNumber) + StringOfChar('.', DotLength) + StringOfChar('*', DecimalNumber);
               Len := DigitalNumber + DotLength;
            end;
         end;
         case TextLayout of
            tlTop: YOffset := 0;
            tlCenter: YOffset := (DestHeight - DestCanvas.TextHeight('0')) div 2 + 1;
            tlBottom: YOffset := DestHeight - DestCanvas.TextHeight('0');
            else
               YOffset := 0;
         end;

         if (CurrencySymbol <> '') then
         begin
            DestCanvas.FillRect(Rect(DestRect.Left, DestRect.Top, DestRect.Left + WorkCellWidth + WorkCellOffset, DestRect.Bottom));
            XOffset := (WorkCellWidth - DestCanvas.TextWidth(CurrencySymbol)) div 2;
            if CurrencySymbolAligned or (DigitalNumber - (Len - DotLength) = 1) then
            begin
               TheRect := Rect(DestRect.Left, DestRect.Top, DestRect.Left + WorkCellWidth + WorkCellOffset, DestRect.Bottom);
               DestCanvas.TextRect(TheRect, DestRect.Left + XOffset + (WorkCellOffset div 2), DestRect.Top + YOffset, CurrencySymbol);
               for I := 1 to DigitalNumber - (Len - DotLength) - 1 do
                  DestCanvas.FillRect(Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellWidth + WorkCellOffset, DestRect.Bottom));
            end
            else
            begin
               for I := 1 to DigitalNumber - (Len - DotLength) - 1 - 1 do
                  DestCanvas.FillRect(Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellWidth + WorkCellOffset, DestRect.Bottom));
               TheRect := Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - (Len - DotLength) - 1) + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - (Len - DotLength) - 1) + WorkCellWidth + WorkCellOffset, DestRect.Bottom);
               DestCanvas.FillRect(TheRect);
               DestCanvas.TextRect(TheRect, DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - (Len - DotLength) - 1) + XOffset + WorkCellOffset, DestRect.Top + YOffset, CurrencySymbol);
            end;
         end
         else
         begin
            DestCanvas.FillRect(Rect(DestRect.Left, DestRect.Top, DestRect.Left + WorkCellWidth + WorkCellOffset, DestRect.Bottom));
            for I := 1 to DigitalNumber - (Len - DotLength) - 1 do
               DestCanvas.FillRect(Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * I + WorkCellWidth + WorkCellOffset, DestRect.Bottom));
         end;

         XOffset := (WorkCellWidth - DestCanvas.TextWidth('0')) div 2;
         for I := 1 to Len - DecimalNumber - DotLength do
         begin
            TheRect := Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - (Len - DotLength) - 1 + I) + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - (Len - DotLength) - 1 + I) + WorkCellWidth + WorkCellOffset, DestRect.Bottom);
            DestCanvas.FillRect(TheRect);
            DestCanvas.TextRect(TheRect, DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - (Len - DotLength) - 1 + I) + XOffset + WorkCellOffset, DestRect.Top + YOffset, DestText[I]);
         end;
         for I := 1 to DecimalNumber do
         begin
            TheRect := Rect(DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - DecimalNumber - 1 + I) + WorkCellOffset, DestRect.Top, DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - DecimalNumber - 1 + I) + WorkCellWidth + WorkCellOffset, DestRect.Bottom);
            DestCanvas.FillRect(TheRect);
            DestCanvas.TextRect(TheRect, DestRect.Left + (WorkCellWidth + GridLineWidth) * (DigitalNumber - DecimalNumber - 1 + I) + XOffset + WorkCellOffset, DestRect.Top + YOffset, DestText[Len - DecimalNumber + I]);
         end;
      end;
   end;

   DestCanvas.Brush.Color := OldBrushColor;
   DestCanvas.Font.Assign(OldFont);
   OldFont.Free;
end;

{设定变量和属性值，并创建对象 }

procedure TWNCurrencyEdit.AutoInitialize;
begin
   FCursorVisible := False;
   FCursorWidth := 0;
   FCursorXPos := 0;
   FCursorY := 0;
   FDotLength := 1;
   FFormatString := '0.00';
   FWorkCellOffset := 0;
   FWorkCellWidth := 0;
   FNegativeSign := 1;
   FOriginValue := 0.00;
   FBorderStyle := bsSingle;
   FCellWidth := -1;
   FCurrencySymbol := '￥';
   FCurrencySymbolAligned := False;
   FDecimalNumber := 2;
   FDecimalSeparatorColor := clRed;
   FDigitalNumber := 18;
   FFocusedColor := ClInfoBK; //clYellow;
   FGridLineColor := clSilver;
   FGridLineWidth := 1;
   FKilobitSeparatorColor := clBlack;
   FMaxLength := FloatMaxLength;
   FMoveOutAllowed := False;
   FNegativeColor := clRed;
   FNegativeFont := TFont.Create;
   FReadOnly := False;
   FShowNegativeColor := False;
   FShowNegativeFont := False;
   FShowNegativeSign := True;
   FTextLayout := tlCenter;
   FValue := 0.00;
   FChineseCurrencyStr:=ArabiaToChinese(FValue);
   FZeroEmpty := True;
   Width := 121;
   Height := 25;
   Color := clWindow;
   ParentColor := False;
   TabStop := True;
   FModified := false;
end;

{ 释放自动初始化所设定的所有对象 }

procedure TWNCurrencyEdit.AutoDestroy;
begin
   FNegativeFont.Free;
end;

{ 读取BorderStyle属性}

function TWNCurrencyEdit.GetBorderStyle: TBorderStyle;
begin
   Result := FBorderStyle;
end;

{ 设置BorderStyle属性 }

procedure TWNCurrencyEdit.SetBorderStyle(Value: TBorderStyle);
begin
   if (FBorderStyle <> Value) then
   begin
      FBorderStyle := Value;
      RecreateWnd;
   end;
end;

{ 读取CellWidth }

function TWNCurrencyEdit.GetCellWidth: Integer;
begin
   Result := FCellWidth;
end;

{ 设置CellWidth }

procedure TWNCurrencyEdit.SetCellWidth(Value: Integer);
begin
   FCellWidth := Value;
   Invalidate;
end;

{ 读取CurrencySymbol属性，也就是货币符号 }

function TWNCurrencyEdit.GetCurrencySymbol: string;
begin
   Result := FCurrencySymbol;
end;

{ 设置CurrencySymbol属性 }

procedure TWNCurrencyEdit.SetCurrencySymbol(Value: string);
begin
   FCurrencySymbol := Value;
   DrawText;
end;

{ 读取CurrencySymbolAligned }

function TWNCurrencyEdit.GetCurrencySymbolAligned: Boolean;
begin
   Result := FCurrencySymbolAligned;
end;

{ 设定CurrencySymbolAligned }

procedure TWNCurrencyEdit.SetCurrencySymbolAligned(Value: Boolean);
begin
   FCurrencySymbolAligned := Value;
   DrawText;
end;

{ 读取DecimalNumber }

function TWNCurrencyEdit.GetDecimalNumber: Integer;
begin
   Result := FDecimalNumber;
end;

{ 设定DecimalNumber }

procedure TWNCurrencyEdit.SetDecimalNumber(Value: Integer);
begin
   if (Value < 0) or (Value >= FDigitalNumber) then
      Exit;
   FDecimalNumber := Value;

   if (FDecimalNumber = 0) then
      FDotLength := 0
   else
      FDotLength := 1;
   FFormatString := '0' + StringOfChar('.', FDotLength) + StringOfChar('0', FDecimalNumber);
   Invalidate;
end;

{ 读取DecimalSeparatorColor }

function TWNCurrencyEdit.GetDecimalSeparatorColor: TColor;
begin
   Result := FDecimalSeparatorColor;
end;

{ 设定DecimalSeparatorColor }

procedure TWNCurrencyEdit.SetDecimalSeparatorColor(Value: TColor);
begin
   FDecimalSeparatorColor := Value;
   Invalidate;
end;

{ 读取DigitalNumber }

function TWNCurrencyEdit.GetDigitalNumber: Integer;
begin
   Result := FDigitalNumber;
end;

{ 设定DigitalNumber }

procedure TWNCurrencyEdit.SetDigitalNumber(Value: Integer);