📄 xibutton.pas
字号:
{================================================================
XiButton 1.13
Written by Eugene Genev
=================================================================}
unit XiButton;
interface
uses
Windows, Classes, Controls, Graphics, Messages, Forms, Dialogs,
Math, SysUtils;
type
TBtnState = (bsNormal, bsOver, bsDown);
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TColorScheme = (csNeoDesert, csNeoSky, csNeoGrass, csNeoSilver,
csNeoRose, csNeoSun,
csDesert, csGrass, csSky, csSun, csRose, csSilver, csCustom);
TXiButton = class(TCustomControl)
private
FColorFace: TColor;
FColorGrad: TColor;
FColorBorder: TColor;
FColorLight: TColor;
FColorDark: TColor;
FColorText: TColor;
FOverColorFace: TColor;
FOverColorGrad: TColor;
FOverColorBorder: TColor;
FOverColorLight: TColor;
FOverColorDark: TColor;
FOverColorText: TColor;
FDownColorFace: TColor;
FDownColorGrad: TColor;
FDownColorBorder: TColor;
FDownColorLight: TColor;
FDownColorDark: TColor;
FDownColorText: TColor;
FDisabledColorFace: TColor;
FDisabledColorGrad: TColor;
FDisabledColorBorder: TColor;
FDisabledColorLight: TColor;
FDisabledColorDark: TColor;
FDisabledColorText: TColor;
FColorFocusRect: TColor;
FFocused: Boolean;
FColorScheme: TColorScheme;
FCtl3D: boolean;
FLayout: TButtonLayout;
FGlyph: TBitmap;
FTransparentGlyph: Boolean;
FGradient: Boolean;
FSpacing: integer;
FModalResult: TModalResult;
FCancel: Boolean;
FDefault: Boolean;
FHotTrack: Boolean;
FClicked: Boolean;
procedure SetColors(Index: integer; Value: TColor);
procedure SetColorScheme(Value: TColorScheme);
procedure SetCtl3D(Value: Boolean);
procedure SetLayout(Value: TButtonLayout);
procedure SetGlyph(Value: TBitmap);
procedure SetTransparentGlyph(Value: Boolean);
procedure SetGradient(Value: Boolean);
procedure SetSpacing(Value: Integer);
procedure SetModalResult(Value: TModalResult);
procedure SetCancel(Value: Boolean);
procedure SetDefault(Value: Boolean);
procedure SetHotTrack(Value: Boolean);
procedure GradientFillRect(Canvas: TCanvas; Rect: TRect;
StartColor, EndColor: TColor);
protected
FBtnState: TBtnState;
procedure Paint; override;
procedure Click; Override;
procedure MouseEnter(var msg: TMessage); message CM_MOUSEENTER;
procedure MouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
procedure WMSetFocus(var msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var msg: TWMKillFocus); message WM_KILLFOCUS;
procedure WMKeyUp(var msg: TWMKeyUp); message WM_KEYUP;
procedure WMKeyDown(var msg: TWMKeyDown); message WM_KEYDOWN;
procedure CMDialogKey(var msg: TCMDialogKey); message CM_DIALOGKEY;
procedure CMDialogChar(var msg: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMTextChanged (var msg: TMessage); message CM_TEXTCHANGED;
procedure CMFontChanged(var msg: TMessage); message CM_FONTCHANGED;
procedure CMEnabledChanged (var msg: TMessage); message CM_ENABLEDCHANGED;
function GetColorScheme: TStringList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ColorFace: TColor index 0 read FColorFace write SetColors;
property ColorGrad: TColor index 1 read FColorGrad write SetColors;
property ColorDark: TColor index 2 read FColorDark write SetColors;
property ColorLight: TColor index 3 read FColorLight write SetColors;
property ColorBorder: TColor index 4 read FColorBorder write SetColors;
property ColorText: TColor index 5 read FColorText write SetColors;
property OverColorFace: TColor index 6 read FOverColorFace write SetColors;
property OverColorGrad: TColor index 7 read FOverColorGrad write SetColors;
property OverColorDark: TColor index 8 read FOverColorDark write SetColors;
property OverColorLight: TColor index 9 read FOverColorLight write SetColors;
property OverColorBorder: TColor index 10 read FOverColorBorder write SetColors;
property OverColorText: TColor index 11 read FOverColorText write SetColors;
property DownColorFace: TColor index 12 read FDownColorFace write SetColors;
property DownColorGrad: TColor index 13 read FDownColorGrad write SetColors;
property DownColorDark: TColor index 14 read FDownColorDark write SetColors;
property DownColorLight: TColor index 15 read FDownColorLight write SetColors;
property DownColorBorder: TColor index 16 read FDownColorBorder write SetColors;
property DownColorText: TColor index 17 read FDownColorText write SetColors;
property DisabledColorFace: TColor index 18 read FDisabledColorFace write SetColors;
property DisabledColorGrad: TColor index 19 read FDisabledColorGrad write SetColors;
property DisabledColorDark: TColor index 20 read FDisabledColorDark write SetColors;
property DisabledColorLight: TColor index 21 read FDisabledColorLight write SetColors;
property DisabledColorBorder: TColor index 22 read FDisabledColorBorder write SetColors;
property DisabledColorText: TColor index 23 read FDisabledColorText write SetColors;
property ColorFocusRect: TColor index 24 read FColorFocusRect write SetColors;
property ColorScheme: TColorScheme read FColorScheme write SetColorScheme;
property Ctl3D: Boolean read FCtl3D write SetCtl3D;
property Layout: TButtonLayout read FLayout write SetLayout;
property Glyph: TBitmap read FGlyph write SetGlyph;
property Spacing: integer read FSpacing write SetSpacing;
property TransparentGlyph: Boolean read FTransparentGlyph write SetTransparentGlyph;
property Gradient: Boolean read FGradient write SetGradient;
property HotTrack: Boolean read FHotTrack write FHotTrack;
property Action;
property Align;
property Anchors;
property BiDiMode;
property Cancel: Boolean read FCancel write FCancel default False;
property Caption;
property Constraints;
property Default: Boolean read FDefault write SetDefault default False;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ModalResult: TModalResult read FModalResult write SetModalResult default 0;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property OnClick;
// property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
{//$R XiButton.res}
implementation
procedure Register;
begin
RegisterComponents('XiControls', [TXiButton]);
end;
constructor TXiButton.Create(AOwner: TComponent);
begin
inherited;
Width:= 75;
Height:= 25;
FCtl3D:= True;
FGlyph:= TBitmap.Create;
TransparentGlyph:= True;
FGradient:= False;
TabStop:= True;
FSpacing:= 4;
FCancel:= False;
FDefault:= False;
FHotTrack:= True;
ColorScheme:= csNeoDesert;
FClicked:= False;
FOverColorGrad:= clWhite;
FDownColorGrad:= clWhite;
FDisabledColorGrad:= clWhite;
end;
destructor TXiButton.Destroy;
begin
FGlyph.Free;
inherited Destroy;
end;
procedure TXiButton.Paint;
var
BtnBmp: TBitmap;
CaptionRect: TRect;
GlyphLeft, GlyphTop, TextTop, TextLeft, TextWidth, TextHeight: integer;
FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor: TColor;
begin
BtnBmp:= TBitmap.Create;
BtnBmp.Width:= Width;
BtnBmp.Height:= Height;
case FBtnState of
bsNormal: begin
FaceColor:= FColorFace;
GradColor:= FColorGrad;
LightColor:= FColorLight;
DarkColor:= FColorDark;
BorderColor:= FColorBorder;
TextColor:= FColorText;
end;
bsOver: begin
FaceColor:= FOverColorFace;
GradColor:= FOverColorGrad;
LightColor:= FOverColorLight;
DarkColor:= FOverColorDark;
BorderColor:= FOverColorBorder;
TextColor:= FOverColorText;
end;
bsDown: begin
FaceColor:= FDownColorFace;
GradColor:= FDownColorGrad;
LightColor:= FDownColorLight;
DarkColor:= FDownColorDark;
BorderColor:= FDownColorBorder;
TextColor:= FDownColorText;
end;
end;
if not Enabled then begin
FaceColor:= FDisabledColorFace;
GradColor:= FDisabledColorGrad;
LightColor:= FDisabledColorLight;
DarkColor:= FDisabledColorDark;
BorderColor:= FDisabledColorBorder;
TextColor:= FDisabledColorText;
end;
with BtnBmp.Canvas do begin
Brush.Color:= FaceColor;
Brush.Style:= bsSolid;
Rectangle(0, 0, Width, Height);
end;
if FGradient then begin
GradientFillRect(BtnBmp.Canvas, Rect(0, 0, Width, Height), FaceColor, GradColor);
end;
BtnBmp.Canvas.Font:= Font;
BtnBmp.Canvas.Font.Color:= TextColor;
TextWidth:= BtnBmp.Canvas.TextWidth(Caption);
TextHeight:= BtnBmp.Canvas.TextHeight(Caption);
TextTop:= (Height - TextHeight) div 2;
TextLeft:= (Width - TextWidth) div 2;
if not Glyph.Empty then begin
GlyphLeft:= 0;
case FLayout of
blGlyphLeft: begin
GlyphTop:= (Height - FGlyph.Height) div 2;
GlyphLeft:= TextLeft - FGlyph.Width div 2;
inc(TextLeft, FGlyph.Width div 2);
if not (Caption = '') then begin
GlyphLeft:= GlyphLeft - FSpacing div 2 - FSpacing mod 2;
inc(TextLeft, FSpacing div 2);
end;
end;
blGlyphRight: begin
GlyphTop:= (Height - FGlyph.Height) div 2;
GlyphLeft:= TextLeft + TextWidth - FGlyph.Width div 2;
inc(TextLeft, - FGlyph.Width div 2);
if not (Caption = '') then begin
GlyphLeft:= GlyphLeft + FSpacing div 2 + FSpacing mod 2;
inc(TextLeft, - FSpacing div 2);
end;
end;
blGlyphTop: begin
GlyphLeft:= (Width - FGlyph.Width) div 2;
GlyphTop:= TextTop - FGlyph.Height div 2 - FGlyph.Height mod 2;
inc(TextTop, FGlyph.Height div 2);
if not (Caption = '') then begin
GlyphTop:= GlyphTop - FSpacing div 2 - FSpacing mod 2;
inc(TextTop, + FSpacing div 2);
end;
end;
blGlyphBottom: begin
GlyphLeft:= (Width - FGlyph.Width) div 2;
GlyphTop:= TextTop + TextHeight - Glyph.Height div 2;
inc(TextTop, - FGlyph.Height div 2);
if not (Caption = '') then begin
GlyphTop:= GlyphTop + FSpacing div 2 + FSpacing mod 2;
inc(TextTop, - FSpacing div 2);
end;
end;
end;
if FBtnState = bsDown then begin
inc(GlyphTop, 1);
inc(GlyphLeft, 1);
end;
FGlyph.TransparentColor:= FGlyph.Canvas.Pixels[0, 0];
FGlyph.Transparent:= FTransparentGlyph;
BtnBmp.Canvas.Draw(GlyphLeft, GlyphTop, FGlyph);
end;
if FBtnState = bsDown then begin
inc(TextTop);
inc(TextLeft);
end;
with CaptionRect do begin
Top:= TextTop;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -