lbcurrencyctrls.pas

天涯進銷存系統

      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;

{ TLBCurrencyLabel }

{ Method to set variable and property values and create objects }
procedure TLBCurrencyLabel.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 TLBCurrencyLabel.AutoDestroy;
begin
  FDecimalSymbols.Free;
  FDigitalSymbols.Free;
end;

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

{ Write method for property BorderStyle }
procedure TLBCurrencyLabel.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 TLBCurrencyLabel.GetCellWidth: Integer;
begin
  Result := FCellWidth;
end;

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

  Invalidate;
end;

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

{ Write method for property CTL3D }
procedure TLBCurrencyLabel.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 TLBCurrencyLabel.GetDecimalNumber: Integer;
begin
  Result := FDecimalNumber;
end;

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

  Invalidate;
end;

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

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

  Invalidate;
end;

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

  Invalidate;
end;

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

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

  Invalidate;
end;

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

  Invalidate;
end;

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

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

  Invalidate;
end;

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

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

  Invalidate;
end;

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

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

  Invalidate;
end;

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

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

  Invalidate;
end;

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

  AutoInitialize;
end;

destructor TLBCurrencyLabel.Destroy;
begin
  AutoDestroy;

  inherited Destroy;
end;

{ draw grid only }
procedure TLBCurrencyLabel.DrawGrid;
var
  I: Integer;
  IntCellWidth,IntCellOffset: Integer;
  OldPenColor: TColor;
  OldPenWidth: Integer;
  OldPenPos: TPoint;
  OldBrushColor: TColor;
begin
  if (FCellWidth>-1) then
  begin
    Width := FCellWidth*FDigitalNumber + FGridLineWidth*(FDigitalNumber-1) + BorderSize*2;
    IntCellWidth := FCellWidth;
    IntCellOffset := 0;
  end
  else begin
    IntCellWidth := (Width-FGridLineWidth*(FDigitalNumber-1)-BorderSize*2) div FDigitalNumber;
    IntCellOffset := Width-FGridLineWidth*(FDigitalNumber-1)-BorderSize*2 - IntCellWidth*FDigitalNumber;
  end;

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

  Canvas.Pen.Width := 1;
  if (FBorderStyle=bsSingle) and Ctl3D then
  begin
    Canvas.Pen.Color := clGray;
    Canvas.MoveTo(0,Height-1);
    Canvas.LineTo(0,0);
    Canvas.LineTo(Width,0);
    Canvas.Pen.Color := clBlack;
    Canvas.MoveTo(1,Height-2);
    Canvas.LineTo(1,1);
    Canvas.LineTo(Width-1,1);

    Canvas.Pen.Color := clWhite;
    Canvas.MoveTo(0,Height-1);
    Canvas.LineTo(Width-1,Height-1);
    Canvas.LineTo(Width-1,-1);
    Canvas.Pen.Color := clSilver;
    Canvas.MoveTo(0,Height-2);
    Canvas.LineTo(Width-2,Height-2);
    Canvas.LineTo(Width-2,0);

    Canvas.Brush.Color := Color;
    Canvas.FillRect(Rect(BorderSize, BorderSize, Width-BorderSize, Height-BorderSize));
  end
  else begin
    if (FBorderStyle=bsSingle) then
      Canvas.Pen.Color := clBlack
    else
      Canvas.Pen.Color := Color;
    Canvas.Brush.Color := Color;
    Canvas.Rectangle(0, 0, Width, Height);
  end;

  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((IntCellWidth+FGridLineWidth)*I-FGridLineWidth+BorderSize+IntCellOffset, BorderSize);
    Canvas.LineTo((IntCellWidth+FGridLineWidth)*I-FGridLineWidth+BorderSize+IntCellOffset, Height-BorderSize);
  end;

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

{ draw text only }
procedure TLBCurrencyLabel.DrawText;
var
  I: Integer;
  XOffset, YOffset: Integer;
  TheRect: TRect;
begin
  if (FDigitalSymbols.Count<>0) or (FDecimalSymbols.Count<>0) then
  begin
    Canvas.Font.Assign(Font);
    Canvas.Brush.Color := Color;
    case FTextLayout of
      tlTop:    YOffset := 0;
      tlCenter: YOffset := (Height-BorderSize*2-Canvas.TextHeight(FDigitalSymbols.Strings[0])) div 2+1;
      tlBottom: YOffset := Height-BorderSize*2-Canvas.TextHeight(FDigitalSymbols.Strings[0]);
    else
      YOffset := 0;
    end;

    if (FDigitalSymbols.Count<>0) then
      for I:=0 to FDigitalNumber-FDecimalNumber-1 do
        if (FDigitalNumber-FDecimalNumber<=FDigitalSymbols.Count+I) then
        begin
          XOffset := (IntCellWidth-Canvas.TextWidth(FDigitalSymbols.Strings[FDigitalNumber-FDecimalNumber-1-I])) div 2;
          TheRect := Rect((IntCellWidth+FGridLineWidth)*I+BorderSize+IntCellOffset,BorderSize,(IntCellWidth+FGridLineWidth)*I+BorderSize+IntCellWidth+IntCellOffset,Height-BorderSize);
          Canvas.TextRect(TheRect,(IntCellWidth+FGridLineWidth)*I+BorderSize+XOffset+IntCellOffset,BorderSize+YOffset,FDigitalSymbols.Strings[FDigitalNumber-FDecimalNumber-1-I]);
        end;
    if (FDecimalSymbols.Count<>0) then
      for I:=0 to FDecimalNumber-1 do
        if (I<FDecimalSymbols.Count) then
        begin
          XOffset := (IntCellWidth-Canvas.TextWidth(DecimalSymbols.Strings[I])) div 2;
          TheRect := Rect((IntCellWidth+FGridLineWidth)*(FDigitalNumber-FDecimalNumber+I)+BorderSize+1+IntCellOffset,BorderSize+1,(IntCellWidth+FGridLineWidth)*(FDigitalNumber-FDecimalNumber+I)+BorderSize+IntCellWidth+IntCellOffset,Height-BorderSize);
          Canvas.TextRect(TheRect,(IntCellWidth+FGridLineWidth)*(FDigitalNumber-FDecimalNumber+I)+BorderSize+1+XOffset+IntCellOffset,BorderSize+1+YOffset,DecimalSymbols.Strings[I]);
        end;
  end;
end;

{ fully redraw control }
procedure TLBCurrencyLabel.Paint;
begin
  if (FCellWidth>-1) then
  begin
    IntCellWidth := FCellWidth;
    IntCellOffset := 0;
    Width := FCellWidth*FDigitalNumber + FGridLineWidth*(FDigitalNumber-1) + BorderSize*2;
  end
  else begin
    IntCellWidth := (Width-FGridLineWidth*(FDigitalNumber-1)-BorderSize*2) div FDigitalNumber;
    IntCellOffset := Width-FGridLineWidth*(FDigitalNumber-1)-BorderSize*2 - IntCellWidth*FDigitalNumber;
  end;

  DrawGrid;
  DrawText;
  inherited;
end;

{ TLBCustomCurrencyEdit }

{ Method to set variable and property values and create objects }
procedure TLBCustomCurrencyEdit.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 := 10;
  FFocusedColor := 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;
  FZeroEmpty := True;

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

  FModified := false;
end;

{ Method to free any objects created by AutoInitialize }
procedure TLBCustomCurrencyEdit.AutoDestroy;
begin
  FNegativeFont.Free;
end;

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

{ Write method for property BorderStyle }
procedure TLBCustomCurrencyEdit.SetBorderStyle(Value: TBorderStyle);
begin
  if (FBorderStyle<>Value) then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

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

{ Write method for property CellWidth }
procedure TLBCustomCurrencyEdit.SetCellWidth(Value: Integer);