📄 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;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -