⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 snccurrency.pas

📁 一个专门输入现金的控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  if (FNegativeSign=-1) then
    DrawText;
end;

{ Read method for property ReadOnly }
function TsncCustomCurrencyEdit.GetReadOnly: Boolean;
begin
  Result := FReadOnly;
end;

{ Write method for property ReadOnly }
procedure TsncCustomCurrencyEdit.SetReadOnly(Value: Boolean);
begin
  FReadOnly := Value;
end;

{ Read method for property ShowNegativeColor }
function TsncCustomCurrencyEdit.GetShowNegativeColor: Boolean;
begin
  Result := FShowNegativeColor;
end;

{ Write method for property ShowNegativeColor }
procedure TsncCustomCurrencyEdit.SetShowNegativeColor(Value: Boolean);
begin
  FShowNegativeColor := Value;
  if (FNegativeSign=-1) then
    DrawText;
end;

{ Read method for property ShowNegativeFont }
function TsncCustomCurrencyEdit.GetShowNegativeFont: Boolean;
begin
  Result := FShowNegativeFont;
end;

{ Write method for property ShowNegativeFont }
procedure TsncCustomCurrencyEdit.SetShowNegativeFont(Value: Boolean);
begin
  FShowNegativeFont := Value;
  if (FNegativeSign=-1) then
    DrawText;
end;

{ Read method for property ShowNegativeSign }
function TsncCustomCurrencyEdit.GetShowNegativeSign: Boolean;
begin
  Result := FShowNegativeSign;
end;

{ Write method for property ShowNegativeSign }
procedure TsncCustomCurrencyEdit.SetShowNegativeSign(Value: Boolean);
begin
  FShowNegativeSign := Value;
  if (FNegativeSign=-1) then
    DrawText;
end;

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

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

{ Read method for property Value }
function TsncCustomCurrencyEdit.GetValue: Extended;
begin
  Result := FValue*FNegativeSign;
end;

{ Write method for property Value }
procedure TsncCustomCurrencyEdit.SetValue(Value: Extended);
begin
  if (Value>=0) then begin
    FValue := Value;
    FNegativeSign := 1;
  end
  else begin
    FValue := -Value;
    FNegativeSign := -1;
  end;
  FOriginValue := Value;
  SyncCursorPos;
  DrawText;

  FModified := false;
end;

{ Read method for property ZeroEmpty }
function TsncCustomCurrencyEdit.GetZeroEmpty: Boolean;
begin
  Result := FZeroEmpty;
end;

{ Write method for property ZeroEmpty }
procedure TsncCustomCurrencyEdit.SetZeroEmpty(Value: Boolean);
begin
  FZeroEmpty := Value;
  DrawText;
end;

procedure TsncCustomCurrencyEdit.BeforeChange;
begin
  if Assigned(FOnBeforeChange) then
    FOnBeforeChange(Self);
end;

procedure TsncCustomCurrencyEdit.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{ when ctrl3d has changed, redraw control face }
procedure TsncCustomCurrencyEdit.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;

{ when control get focus, set cusor pos at tail of integer }
procedure TsncCustomCurrencyEdit.CMEnter(var Message: TMessage);
begin
  inherited;
  FCursorXPos := FDigitalNumber-FDecimalNumber-1;
end;

{ when value has been modified and control has focus, set cursor pos for new value }
procedure TsncCustomCurrencyEdit.SyncCursorPos;
var
  OldCursorVisible: Boolean;
  Len: Integer;
begin
  OldCursorVisible := FCursorVisible;
  SetCursorState(false);
  Len := Length(FormatFloat(FFormatString, FValue));
  if (FCursorXPos<FDigitalNumber-(Len-FDotLength)-1) then
    FCursorXPos := FDigitalNumber-FDecimalNumber-1;
  SetCursorState(OldCursorVisible);
end;

{ when value has been modified , draw text only }
procedure TsncCustomCurrencyEdit.ChangeValue(Value: Extended);
begin
  if not FModified then
  begin
    BeforeChange;
    FModified := true;
  end;

  if (Value>=0) then
  begin
    FValue := Value;
    FNegativeSign := 1;
  end
  else begin
    FValue := -Value;
    FNegativeSign := -1;
  end;
  DrawText;
  Change;
end;

constructor TsncCustomCurrencyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoInitialize;
end;

procedure TsncCustomCurrencyEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

{ cursor flash timer handle }
procedure TsncCustomCurrencyEdit.CursorTimerHandle(Sender: TObject);
begin
  DrawCursor;
end;

{ calculate cursor pos }
procedure TsncCustomCurrencyEdit.DecodeCursorX(X: Integer);
var
  I, Len: Integer;
begin
  Len := Length(FormatFloat(FFormatString, FValue));
  for I:=0 to FDigitalNumber-1 do
    if (X>=(FWorkCellWidth+FGridLineWidth)*I+FWorkCellOffset) and
       (X<=(FWorkCellWidth+FGridLineWidth)*I+FWorkCellWidth-1+FWorkCellOffset) then
      begin
        if (I<FDigitalNumber-(Len-FDotLength)-1) then
          FCursorXPos := FDigitalNumber-(Len-FDotLength)-1
        else
          FCursorXPos := I;
        Break;
      end;
end;

destructor TsncCustomCurrencyEdit.Destroy;
begin
  AutoDestroy;
  inherited Destroy;
end;

{ draw flash cursor }
procedure TsncCustomCurrencyEdit.DrawCursor;
var
  OldPenColor: TColor;
  OldPenMode: TPenMode;
  CursorX: Integer;
begin
  CursorX := (FWorkCellWidth+FGridLineWidth)*FCursorXPos+FWorkCellOffset+((FWorkCellWidth-FCursorWidth) div 2);
  with Self.Canvas do
  begin
    OldPenColor := Pen.Color;
    OldPenMode := Pen.Mode;

    Pen.Color := Self.Color;
    Pen.Mode :=  pmXor;
    PolyLine([Point(CursorX, FCursorY), Point(CursorX+FCursorWidth-1, FCursorY),
              Point(CursorX+FCursorWidth-1, FCursorY+1),Point(CursorX-1, FCursorY+1)]);

    Pen.Color := OldPenColor;
    Pen.Mode :=  OldPenMode;
  end;
  FCursorVisible := not FCursorVisible;
end;

{ draw grid only }
procedure TsncCustomCurrencyEdit.DrawGrid;
var
  I: Integer;
  BrushColor: TColor;
  OldPenColor: TColor;
  OldPenWidth: Integer;
  OldPenPos: TPoint;
  OldBrushColor: TColor;
  OldCursorVisible: Boolean;
begin
  OldCursorVisible := FCursorVisible;
  SetCursorState(False);

  if Focused then
    BrushColor := FocusedColor
  else
    if (FNegativeSign=-1) and (ShowNegativeColor) then
      BrushColor := NegativeColor
    else
      BrushColor := Color;
  OldBrushColor := Canvas.Brush.Color;
  Canvas.Brush.Color := BrushColor;
  Canvas.FillRect(ClientRect);
  Canvas.Brush.Color := OldBrushColor;

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

  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((FWorkCellWidth+FGridLineWidth)*I-FGridLineWidth+FWorkCellOffset, 0);
    Canvas.LineTo((FWorkCellWidth+FGridLineWidth)*I-FGridLineWidth+FWorkCellOffset, ClientHeight);
  end;

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

  SetCursorState(OldCursorVisible);
end;

{ draw grid only }
procedure TsncCustomCurrencyEdit.DrawText;
var
  I, Len: Integer;
  Text: String;
  XOffset, YOffset: Integer;
  TheRect: TRect;
  BrushColor: TColor;
  OldBrushColor: TColor;
  OldCursorVisible: Boolean;
begin
  OldCursorVisible := FCursorVisible;
  SetCursorState(False);

  OldBrushColor := Canvas.Brush.Color;
  if Focused then
    BrushColor := FocusedColor
  else
    if (FNegativeSign=-1) and (ShowNegativeColor) then
      BrushColor := NegativeColor
    else
      BrushColor := Color;
  Canvas.Brush.Color := BrushColor;

  if (FNegativeSign=-1) and (ShowNegativeFont) then
    Canvas.Font.Assign(NegativeFont)
  else
    Canvas.Font.Assign(Font);
  FCursorWidth := Canvas.TextWidth('0')+2;

  if (FZeroEmpty and (FValue=0) and not Focused) then
  begin
    Canvas.FillRect(Rect(0,0,FWorkCellWidth+FWorkCellOffset,ClientHeight));
    for I:=1 to FDigitalNumber-1 do
      Canvas.FillRect(Rect((FWorkCellWidth+FGridLineWidth)*I+FWorkCellOffset,0,(FWorkCellWidth+FGridLineWidth)*I+FWorkCellWidth+FWorkCellOffset,ClientHeight));
  end
  else begin
    if (FNegativeSign=-1) and (ShowNegativeSign) then
      Text := FormatFloat(FFormatString, Value)
    else
      Text := FormatFloat(FFormatString, FValue);
    Len := Length(Text);
    if (FCurrencySymbol<>'') then
    begin
      if (FDigitalNumber-(Len-FDotLength)<1) then
      begin
        Text := StringOfChar('*',FDigitalNumber-FDecimalNumber-1)+StringOfChar('.',FDotLength)+StringOfChar('*',FDecimalNumber);
        Len := FDigitalNumber+FDotLength-1;
      end;
    end
    else begin
      if (FDigitalNumber-(Len-FDotLength)<0) then
      begin
        Text := StringOfChar('*',FDigitalNumber-FDecimalNumber)+StringOfChar('.',FDotLength)+StringOfChar('*',FDecimalNumber);
        Len := FDigitalNumber+FDotLength;
      end;
    end;
    case FTextLayout of
      tlTop:    YOffset := 0;
      tlCenter: YOffset := (ClientHeight-Canvas.TextHeight('0')) div 2+1;
      tlBottom: YOffset := ClientHeight-Canvas.TextHeight('0');
    else
      YOffset := 0;
    end;
    FCursorY := YOffset+Canvas.TextHeight('0')+0;
    if (FCursorY+1>=ClientHeight) then
      FCursorY := ClientHeight-2;

    if (FCurrencySymbol<>'') then
    begin
      Canvas.FillRect(Rect(0,0,FWorkCellWidth+FWorkCellOffset,ClientHeight));
      XOffset := (FWorkCellWidth-Canvas.TextWidth(FCurrencySymbol)) div 2;
      if FCurrencySymbolAligned or (FDigitalNumber-(Len-FDotLength)=1) then
      begin
        TheRect := Rect(0,0,FWorkCellWidth+FWorkCellOffset,ClientHeight);
        Canvas.TextRect(TheRect,XOffset+(FWorkCellOffset div 2),YOffset, FCurrencySymbol);
        for I:=1 to FDigitalNumber-(Len-FDotLength)-1 do
          Canvas.FillRect(Rect((FWorkCellWidth+FGridLineWidth)*I+FWorkCellOffset,0,(FWorkCellWidth+FGridLineWidth)*I+FWorkCellWidth+FWorkCellOffset,ClientHeight));
      end
      else begin
        for I:=1 to FDigitalNumber-(Len-FDotLength)-1-1 do
          Canvas.FillRect(Rect((FWorkCellWidth+FGridLineWidth)*I+FWorkCellOffset,0,(FWorkCellWidth+FGridLineWidth)*I+FWorkCellWidth+FWorkCellOffset,ClientHeight));
        TheRect := Rect((FWorkCellWidth+FGridLineWidth)*(FDigitalNumber-(Len-FDotLength)-1)+FWorkCellOffset,0,(FWorkCellWidth+FGridLineWidth)*(FDigitalNumber-(Len-FDotLength)-1)+FWorkCellWidth+FWorkCellOffset,ClientHeight);
        Canvas.FillRect(TheRect);
        Canvas.TextRect(TheRect,(FWorkCellWidth+FGridLineWidth)*(FDigitalNumber-(Len-FDotLength)-1)+XOffset+FWorkCellOffset,YOffset, FCurrencySymbol);
      end;
    end
    else begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -