snccurrency.pas

汽车销售管理系统Delphi源代码,里面有很多有用的代码

  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 TsncCurrencyLabel.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 TsncCurrencyLabel.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;

{ TsncCustomCurrencyEdit }

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

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

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

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

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

{ Read method for property CurrencySymbol }
function TsncCustomCurrencyEdit.GetCurrencySymbol: String;
begin
  Result := FCurrencySymbol;
end;

{ Write method for property CurrencySymbol }
procedure TsncCustomCurrencyEdit.SetCurrencySymbol(Value: String);
begin
  FCurrencySymbol := Value;
  DrawText;
end;

{ Read method for property CurrencySymbolAligned }
function TsncCustomCurrencyEdit.GetCurrencySymbolAligned: Boolean;
begin
  Result := FCurrencySymbolAligned;
end;

{ Write method for property CurrencySymbolAligned }
procedure TsncCustomCurrencyEdit.SetCurrencySymbolAligned(Value: Boolean);
begin
  FCurrencySymbolAligned := Value;
  DrawText;
end;

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

{ Write method for property DecimalNumber }
procedure TsncCustomCurrencyEdit.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;

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

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

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

{ Write method for property DigitalNumber }
procedure TsncCustomCurrencyEdit.SetDigitalNumber(Value: Integer);
begin
  if (Value<FDecimalNumber) or (Value>FloatMaxLength) then
    Exit;
  FDigitalNumber := Value;
  Invalidate;
end;

{ Read method for property FocusedColor }
function TsncCustomCurrencyEdit.GetFocusedColor: TColor;
begin
  Result := FFocusedColor;
end;

{ Write method for property FocusedColor }
procedure TsncCustomCurrencyEdit.SetFocusedColor(Value: TColor);
begin
  FFocusedColor := Value;
  Invalidate;
end;

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

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

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

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

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

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

{ Read method for property MaxLength }
function TsncCustomCurrencyEdit.GetMaxLength: Integer;
begin
  Result := FMaxLength;
end;

{ Write method for property MaxLength }
procedure TsncCustomCurrencyEdit.SetMaxLength(Value: Integer);
begin
  if (Value<0) or (Value>FloatMaxLength) then
    Exit;
  FMaxLength := Value;
end;

{ Read method for property MoveOutAllowed }
function TsncCustomCurrencyEdit.GetMoveOutAllowed: Boolean;
begin
  Result := FMoveOutAllowed;
end;

{ Write method for property MoveOutAllowed }
procedure TsncCustomCurrencyEdit.SetMoveOutAllowed(Value: Boolean);
begin
  FMoveOutAllowed := Value;
end;

{ Read method for property NegativeColor }
function TsncCustomCurrencyEdit.GetNegativeColor: TColor;
begin
  Result := FNegativeColor;
end;

{ Write method for property NegativeColor }
procedure TsncCustomCurrencyEdit.SetNegativeColor(Value: TColor);
begin
  FNegativeColor := Value;
  if (FNegativeSign=-1) then
    DrawText;
end;

{ Write method for property NegativeFont }
procedure TsncCustomCurrencyEdit.SetNegativeFont(Value: TFont);
begin
  FNegativeFont.Assign(Value);