lbcurrencyctrls.pas

天涯進銷存系統

begin
  FCellWidth := Value;
  Invalidate;
end;

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

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

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

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

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

{ Write method for property DecimalNumber }
procedure TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.GetDecimalSeparatorColor: TColor;
begin
  Result := FDecimalSeparatorColor;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{ Write method for property NegativeFont }
procedure TLBCustomCurrencyEdit.SetNegativeFont(Value: TFont);
begin
  FNegativeFont.Assign(Value);
  if (FNegativeSign=-1) then
    DrawText;
end;

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

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

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

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

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

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

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

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

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

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

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

{ Write method for property Value }
procedure TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.GetZeroEmpty: Boolean;
begin
  Result := FZeroEmpty;
end;

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

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

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

{ when ctrl3d has changed, redraw control face }
procedure TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoInitialize;
end;

procedure TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.CursorTimerHandle(Sender: TObject);
begin
  DrawCursor;
end;

{ calculate cursor pos }
procedure TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.Destroy;
begin
  AutoDestroy;
  inherited Destroy;
end;

{ draw flash cursor }
procedure TLBCustomCurrencyEdit.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 TLBCustomCurrencyEdit.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);