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

📄 xibutton.pas

📁 Xi control is a component for delphi. its have alot of feature like customizable button, gradient s
💻 PAS
📖 第 1 页 / 共 3 页
字号:
{================================================================

    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 + -