snccurrency.pas

一个专门输入现金的控件

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 Register;
begin
  RegisterComponents('SNC', [TsncCurrencyLabel]);
  RegisterComponents('SNC', [TsncCurrencyEdit]);
end;

{ TsncCurrencyLabel }

{ Method to set variable and property values and create objects }
procedure TsncCurrencyLabel.AutoInitialize;
begin
  BorderSize := 2;
  IntCellOffset := 0;
  IntCellWidth := 0;
  FBorderStyle := bsSingle;
  FCellWidth := -1;
  FCtl3D := True;
  FDecimalNumber := 2;
  FDecimalSeparatorColor := clRed;
  FDecimalSymbols := TStringList.Create;
  FDigitalNumber := 10;
  FDigitalSymbols := TStringList.Create;
  FGridLineColor := clSilver;
  FGridLineWidth := 1;
  FKilobitSeparatorColor := clBlack;
  FTextLayout := tlCenter;

  Width := 121;
  Height := 25;
  Color := clWindow;
  ParentColor := False;

  FDigitalSymbols.Add('元');
  FDigitalSymbols.Add('十');
  FDigitalSymbols.Add('百');
  FDigitalSymbols.Add('千');
  FDigitalSymbols.Add('万');
  FDigitalSymbols.Add('十');
  FDigitalSymbols.Add('百');
  FDigitalSymbols.Add('千');
  FDigitalSymbols.Add('亿');
  FDigitalSymbols.Add('十');
  FDigitalSymbols.Add('百');
  FDigitalSymbols.Add('千');
  FDigitalSymbols.Add('万');
  FDecimalSymbols.Add('角');
  FDecimalSymbols.Add('分');
end;

{ Method to free any objects created by AutoInitialize }
procedure TsncCurrencyLabel.AutoDestroy;
begin
  FDecimalSymbols.Free;
  FDigitalSymbols.Free;
end;

{ Read method for property BorderStyle }
function TsncCurrencyLabel.GetBorderStyle: TBorderStyle;
begin
  Result := FBorderStyle;
end;

{ Write method for property BorderStyle }
procedure TsncCurrencyLabel.SetBorderStyle(Value: TBorderStyle);
begin
  FBorderStyle := Value;

  if (FBorderStyle=bsNone) then
    BorderSize := 0
  else
    if Ctl3D then
      BorderSize := 2
    else
      BorderSize := 1;
  Invalidate;
end;

{ Read method for property CellWidth }
function TsncCurrencyLabel.GetCellWidth: Integer;
begin
  Result := FCellWidth;
end;

{ Write method for property CellWidth }
procedure TsncCurrencyLabel.SetCellWidth(Value: Integer);
begin
  FCellWidth := Value;

  Invalidate;
end;

{ Read method for property CTL3D }
function TsncCurrencyLabel.GetCtl3D: Boolean;
begin
  Result := FCtl3D;
end;

{ Write method for property CTL3D }
procedure TsncCurrencyLabel.SetCtl3D(Value: Boolean);
begin
  FCtl3D := Value;

  if (FBorderStyle=bsSingle) then
  begin
    if Ctl3D then
      BorderSize := 2
    else
      BorderSize := 1;
    Invalidate;
  end;
end;

{ Read method for property DecimalNumber }
function TsncCurrencyLabel.GetDecimalNumber: Integer;
begin
  Result := FDecimalNumber;
end;

{ Write method for property DecimalNumber }
procedure TsncCurrencyLabel.SetDecimalNumber(Value: Integer);
begin
  if (Value<0) or (Value>FDigitalNumber) then
    Exit;
  FDecimalNumber := Value;

  Invalidate;
end;

{ Read method for property DecimalSeparatorColor }
function TsncCurrencyLabel.GetDecimalSeparatorColor: TColor;
begin
  Result := FDecimalSeparatorColor;
end;

{ Write method for property DecimalSeparatorColor }
procedure TsncCurrencyLabel.SetDecimalSeparatorColor(Value: TColor);
begin
  FDecimalSeparatorColor := Value;

  Invalidate;
end;

{ Write method for property DecimalSymbols }
procedure TsncCurrencyLabel.SetDecimalSymbols(Value: TStrings);
begin
  FDecimalSymbols.Assign(Value);

  Invalidate;
end;

{ Read method for property DigitalNumber }
function TsncCurrencyLabel.GetDigitalNumber: Integer;
begin
  Result := FDigitalNumber;
end;

{ Write method for property DigitalNumber }
procedure TsncCurrencyLabel.SetDigitalNumber(Value: Integer);
begin
  if (Value<FDecimalNumber) then
    Exit;
  FDigitalNumber := Value;

  Invalidate;
end;

{ Write method for property DigitalSymbols }
procedure TsncCurrencyLabel.SetDigitalSymbols(Value: TStrings);
begin
  FDigitalSymbols.Assign(Value);

  Invalidate;
end;

{ Read method for property GridLineColor }
function TsncCurrencyLabel.GetGridLineColor: TColor;
begin
  Result := FGridLineColor;
end;

{ Write method for property GridLineColor }
procedure TsncCurrencyLabel.SetGridLineColor(Value: TColor);
begin
  FGridLineColor := Value;

  Invalidate;
end;

{ Read method for property GridLineWidth }
function TsncCurrencyLabel.GetGridLineWidth: Integer;
begin
  Result := FGridLineWidth;
end;

{ Write method for property GridLineWidth }
procedure TsncCurrencyLabel.SetGridLineWidth(Value: Integer);
begin
  FGridLineWidth := Value;

  Invalidate;
end;

{ Read method for property KilobitSeparatorColor }
function TsncCurrencyLabel.GetKilobitSeparatorColor: TColor;
begin
  Result := FKilobitSeparatorColor;
end;

{ Write method for property KilobitSeparatorColor }
procedure TsncCurrencyLabel.SetKilobitSeparatorColor(Value: TColor);
begin
  FKilobitSeparatorColor := Value;

  Invalidate;
end;

{ Read method for property TextLayout }
function TsncCurrencyLabel.GetTextLayout: TTextLayout;
begin
  Result := FTextLayout;
end;

{ Write method for property TextLayout }
procedure TsncCurrencyLabel.SetTextLayout(Value: TTextLayout);
begin
  FTextLayout := Value;

  Invalidate;
end;

constructor TsncCurrencyLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  AutoInitialize;
end;

destructor TsncCurrencyLabel.Destroy;
begin
  AutoDestroy;

  inherited Destroy;
end;

{ draw grid only }
procedure TsncCurrencyLabel.DrawGrid;
var
  I: Integer;
  IntCellWidth,IntCellOffset: Integer;