📄 snccurrency.pas
字号:
{ ******************************************************************
sncCurrency version 1.1
Copyright (C) 1999 by Moore Xu. All Rights Reserved.
e-mail: moorexu@163.net
Description: very cool component set for chinese currency input.
LICENCE CONDITIONS
USE OF THE ENCLOSED SOFTWARE INDICATES YOUR ASSENT TO THE FOLLOWING
LICENCE CONDITIONS:
1. You are free to use sncCurrency in compiled form for any purpose.
However, use in commercial or shareware applications requires registration.
2. The sncCurrency source code or DCU, in whole or in part, modified or
unmodified, may not be redistributed for profit or as part of another
commercial or shareware software package without express written permission
from me.
3. Software using this code must contain a visible line of credit.
This code is distributed "as is" without any warranties, express or implied.
4. Register fee: $10 for person and $100 for organization.
Created: 1999.06.01
Last change: 1999.08.06
History:
1.0: Initial release
1.1: Fixed bug and rewrite whole component in standard code
****************************************************************** }
unit sncCurrency;
{$R-}
interface
uses Messages, SysUtils, Classes, Controls, Forms, Graphics,
Windows, StdCtrls, Extctrls;
const
FloatMaxLength = 18;
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
type
TsncCurrencyLabel = class(TGraphicControl)
private
FBorderStyle: TBorderStyle;
FCellWidth: Integer;
FCtl3D: Boolean;
FDecimalNumber: Integer;
FDecimalSeparatorColor: TColor;
FDecimalSymbols: TStrings;
FDigitalNumber: Integer;
FDigitalSymbols: TStrings;
FGridLineColor: TColor;
FGridLineWidth: Integer;
FKilobitSeparatorColor: TColor;
FTextLayout: TTextLayout;
BorderSize: Integer;
IntCellOffset: Integer;
IntCellWidth: Integer;
procedure AutoInitialize;
procedure AutoDestroy;
function GetBorderStyle: TBorderStyle;
procedure SetBorderStyle(Value: TBorderStyle);
function GetCellWidth: Integer;
procedure SetCellWidth(Value: Integer);
function GetCtl3D: Boolean;
procedure SetCtl3D(Value: Boolean);
function GetDecimalNumber: Integer;
procedure SetDecimalNumber(Value: Integer);
function GetDecimalSeparatorColor: TColor;
procedure SetDecimalSeparatorColor(Value: TColor);
procedure SetDecimalSymbols(Value: TStrings);
function GetDigitalNumber: Integer;
procedure SetDigitalNumber(Value: Integer);
procedure SetDigitalSymbols(Value: TStrings);
function GetGridLineColor: TColor;
procedure SetGridLineColor(Value: TColor);
function GetGridLineWidth: Integer;
procedure SetGridLineWidth(Value: Integer);
function GetKilobitSeparatorColor: TColor;
procedure SetKilobitSeparatorColor(Value: TColor);
function GetTextLayout: TTextLayout;
procedure SetTextLayout(Value: TTextLayout);
procedure DrawGrid;
procedure DrawText;
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle
default bsSingle;
property CellWidth: Integer read GetCellWidth write SetCellWidth
default -1;
property Ctl3D: Boolean read GetCtl3D write SetCtl3D
default True;
property DecimalNumber: Integer read GetDecimalNumber write SetDecimalNumber
default 2;
property DecimalSeparatorColor: TColor read GetDecimalSeparatorColor write SetDecimalSeparatorColor
default clRed;
property DecimalSymbols: TStrings read FDecimalSymbols write SetDecimalSymbols;
property DigitalNumber: Integer read GetDigitalNumber write SetDigitalNumber
default 10;
property DigitalSymbols: TStrings read FDigitalSymbols write SetDigitalSymbols;
property GridLineColor: TColor read GetGridLineColor write SetGridLineColor
default clSilver;
property GridLineWidth: Integer read GetGridLineWidth write SetGridLineWidth
default 1;
property KilobitSeparatorColor: TColor read GetKilobitSeparatorColor write SetKilobitSeparatorColor
default clBlack;
property TextLayout: TTextLayout read GetTextLayout write SetTextLayout
default tlCenter;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Color;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property ShowHint;
property Visible;
end;
TsncCustomCurrencyEdit = class(TCustomControl)
private
FBorderStyle: TBorderStyle;
FCellWidth: Integer;
FCurrencySymbol: String;
FCurrencySymbolAligned: Boolean;
FDecimalNumber: Integer;
FDecimalSeparatorColor: TColor;
FDigitalNumber: Integer;
FFocusedColor: TColor;
FGridLineColor: TColor;
FGridLineWidth: Integer;
FKilobitSeparatorColor: TColor;
FMaxLength: Integer;
FMoveOutAllowed: Boolean;
FNegativeColor: TColor;
FNegativeFont: TFont;
FReadOnly: Boolean;
FShowNegativeColor: Boolean;
FShowNegativeFont: Boolean;
FShowNegativeSign: Boolean;
FTextLayout: TTextLayout;
FValue: Extended;
FZeroEmpty: Boolean;
FOnChange: TNotifyEvent;
FModified: Boolean;
FOnBeforeChange: TNotifyEvent;
FOnMoveOut: TKeyEvent;
FCursorTimer: TTimer;
FCursorVisible: Boolean;
FCursorWidth: Integer;
FCursorXPos: Integer;
FCursorY: Integer;
FDotLength: Integer;
FFormatString: String;
FWorkCellOffset: Integer;
FWorkCellWidth: Integer;
FNegativeSign: Integer;
FOriginValue: Extended;
procedure AutoInitialize;
procedure AutoDestroy;
function GetBorderStyle: TBorderStyle;
procedure SetBorderStyle(Value: TBorderStyle);
function GetCellWidth: Integer;
procedure SetCellWidth(Value: Integer);
function GetCurrencySymbol: String;
procedure SetCurrencySymbol(Value: String);
function GetCurrencySymbolAligned: Boolean;
procedure SetCurrencySymbolAligned(Value: Boolean);
function GetDecimalNumber: Integer;
procedure SetDecimalNumber(Value: Integer);
function GetDecimalSeparatorColor: TColor;
procedure SetDecimalSeparatorColor(Value: TColor);
function GetDigitalNumber: Integer;
procedure SetDigitalNumber(Value: Integer);
function GetFocusedColor: TColor;
procedure SetFocusedColor(Value: TColor);
function GetGridLineColor: TColor;
procedure SetGridLineColor(Value: TColor);
function GetGridLineWidth: Integer;
procedure SetGridLineWidth(Value: Integer);
function GetKilobitSeparatorColor: TColor;
procedure SetKilobitSeparatorColor(Value: TColor);
function GetMaxLength: Integer;
procedure SetMaxLength(Value: Integer);
function GetMoveOutAllowed: Boolean;
procedure SetMoveOutAllowed(Value: Boolean);
function GetNegativeColor: TColor;
procedure SetNegativeColor(Value: TColor);
procedure SetNegativeFont(Value: TFont);
function GetReadOnly: Boolean;
procedure SetReadOnly(Value: Boolean);
function GetShowNegativeColor: Boolean;
procedure SetShowNegativeColor(Value: Boolean);
function GetShowNegativeFont: Boolean;
procedure SetShowNegativeFont(Value: Boolean);
function GetShowNegativeSign: Boolean;
procedure SetShowNegativeSign(Value: Boolean);
function GetTextLayout: TTextLayout;
procedure SetTextLayout(Value: TTextLayout);
function GetValue: Extended;
procedure SetValue(Value: Extended);
function GetZeroEmpty: Boolean;
procedure SetZeroEmpty(Value: Boolean);
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
procedure CMEnter(var Message: TMessage); message CM_ENTER;
procedure SyncCursorPos;
procedure ChangeValue(Value: Extended);
procedure CursorTimerHandle(Sender: TObject);
procedure DecodeCursorX(X: Integer);
procedure DrawCursor;
procedure DrawGrid;
procedure DrawText;
procedure InitCursorX(X: Integer);
procedure SetCursorState(Visible: Boolean);
procedure WMChar(var Message: TMessage); message WM_CHAR;
procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
procedure CNKEYDOWN(var Message: TMessage); message CN_KEYDOWN;
procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
protected
procedure BeforeChange; virtual;
procedure MoveOut(var Key: Word; Shift: TShiftState); virtual;
procedure Change; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle
default bsSingle;
property CellWidth: Integer read GetCellWidth write SetCellWidth
default -1;
property CurrencySymbol: String read GetCurrencySymbol write SetCurrencySymbol;
property CurrencySymbolAligned: Boolean read GetCurrencySymbolAligned write SetCurrencySymbolAligned
default False;
property DecimalNumber: Integer read GetDecimalNumber write SetDecimalNumber
default 2;
property DecimalSeparatorColor: TColor read GetDecimalSeparatorColor write SetDecimalSeparatorColor
default clRed;
property DigitalNumber: Integer read GetDigitalNumber write SetDigitalNumber
default 10; { not clude dot }
property FocusedColor: TColor read GetFocusedColor write SetFocusedColor
default clYellow;
property GridLineColor: TColor read GetGridLineColor write SetGridLineColor
default clSilver;
property GridLineWidth: Integer read GetGridLineWidth write SetGridLineWidth
default 1;
property KilobitSeparatorColor: TColor read GetKilobitSeparatorColor write SetKilobitSeparatorColor
default clBlack;
property MaxLength: Integer read GetMaxLength write SetMaxLength
default FloatMaxLength; { not include dot }
property MoveOutAllowed: Boolean read GetMoveOutAllowed write SetMoveOutAllowed
default False;
property NegativeColor: TColor read GetNegativeColor write SetNegativeColor
default clRed;
property NegativeFont: TFont read FNegativeFont write SetNegativeFont;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly
default False;
property ShowNegativeColor: Boolean read GetShowNegativeColor write SetShowNegativeColor
default False;
property ShowNegativeFont: Boolean read GetShowNegativeFont write SetShowNegativeFont
default False;
property ShowNegativeSign: Boolean read GetShowNegativeSign write SetShowNegativeSign
default True;
property TextLayout: TTextLayout read GetTextLayout write SetTextLayout
default tlCenter;
property Value: Extended read GetValue write SetValue;
property ZeroEmpty: Boolean read GetZeroEmpty write SetZeroEmpty
default True;
property OnBeforeChange: TNotifyEvent read FOnBeforeChange write FOnBeforeChange;
property OnMoveOut: TKeyEvent read FOnMoveOut write FOnMoveOut;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Modified: Boolean;
procedure UnDo;
end;
TsncCurrencyEdit = class(TsncCustomCurrencyEdit)
published
property BorderStyle;
property CellWidth;
property Color;
property Ctl3D;
property CurrencySymbol;
property CurrencySymbolAligned;
property DecimalNumber;
property DecimalSeparatorColor;
property DigitalNumber;
property Enabled;
property FocusedColor;
property Font;
property GridLineColor;
property GridLineWidth;
property KilobitSeparatorColor;
property MaxLength;
property MoveOutAllowed;
property NegativeColor;
property NegativeFont;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property ReadOnly;
property ShowHint;
property ShowNegativeColor;
property ShowNegativeFont;
property ShowNegativeSign;
property TabOrder;
property TabStop;
property TextLayout;
property Value;
property Visible;
property ZeroEmpty;
property OnBeforeChange;
property OnMoveOut;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure DrawCurrencyFrame(DestCanvas: TCanvas; DestRect: TRect; CurrencyEdit: TsncCustomCurrencyEdit; DestValue: Extended);
procedure Register;
implementation
function sncStuff(S, Pattern: String; Index, Len: Integer): String;
var
SLen, I: Integer;
S1, S2: String;
begin
Result := '';
SLen := Length(S);
if (Index<1) or (Len<0) or (Index>SLen+1) or (Index+Len>SLen+1) then
Exit;
S1 := '';
S2 := '';
for I := 1 to SLen do
if (I<Index) then
S1 := S1+S[I]
else
if (I>Index+Len-1) then
S2 := S2+S[I];
Result := S1 + Pattern + S2;
end;
procedure DrawCurrencyFrame(DestCanvas: TCanvas; DestRect: TRect; CurrencyEdit: TsncCustomCurrencyEdit; DestValue: Extended);
var
DotLength: Integer;
FormatString: String;
WorkCellOffset, WorkCellWidth: Integer;
DestHeight, DestWidth: Integer;
I, Len: Integer;
BrushColor: TColor;
OldPenColor: TColor;
OldPenWidth: Integer;
OldPenPos: TPoint;
OldBrushColor: TColor;
OldFont: TFont;
DestText: String;
XOffset, YOffset: Integer;
TheRect: TRect;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -