unit XPButton;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type

TShade = record
C: array[0..15] of TColor;
end;

type
TXPButton = class(TButton)
    private
    FBaseColor: TColor;
    FCanvas: TCanvas;
    IsFocused: Boolean;
    Shade: TShade;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
    procedure SetBaseColor(Value: TColor);
    function LoadShades(BaseColor: TColor): TShade;
    function ShadeColor(BaseColor: TColor; Offset: Integer): TColor;
    protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    published
    //property BaseColor: TColor read FBaseColor write SetBaseColor default $00777777;
    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;

implementation

procedure Register;
begin
    RegisterComponents('Liren.z', [TXPButton]);
end;

constructor TXPButton.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FCanvas := TCanvas.Create;
    FBaseColor := $00DDB9B9; //$00777777;
    ControlStyle := ControlStyle - [csDoubleClicks];
    Width := 85;
    Height := 30;
    Shade := LoadShades(FBaseColor);
end;

destructor TXPButton.Destroy;
begin
    inherited Destroy;
    FCanvas.Free;
end;
procedure TXPButton.CreateParams(var Params: TCreateParams);
begin
    inherited CreateParams(Params);
    with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TXPButton.CNDrawItem(var Message: TWMDrawItem);
begin
    DrawItem(Message.DrawItemStruct^);
end;

procedure TXPButton.CMFontChanged(var Message: TMessage);
begin
    inherited;
    Invalidate;
end;

procedure TXPButton.CMEnabledChanged(var Message: TMessage);
begin
    inherited;
    Invalidate;
end;

procedure TXPButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
    IsDown, IsDefault: Boolean;
    Rec, FocusRect: TRect;
    Flags: Longint;
    FilCol, BorCol, CapCol, T1, T2, B1, B2: TColor;
begin
    FCanvas.Handle := DrawItemStruct.hDC;
    Rec := ClientRect;
    with DrawItemStruct do begin
      IsDown := itemState and ODS_SELECTED <> 0;
      IsDefault := itemState and ODS_FOCUS <> 0;
    end;
    Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    if IsDown then Flags := Flags or DFCS_PUSHED;
    if (DrawItemStruct.itemState and ODS_DISABLED <> 0) then
    Flags := Flags or DFCS_INACTIVE;
    FCanvas.Font := Font;
    if Enabled then begin
      BorCol := Shade.C[0];
      if IsDown then begin
        T1 := Shade.C[4];
        T2 := Shade.C[5];
        B1 := Shade.C[7];
        B2 := Shade.C[8];
        FilCol := Shade.C[6];
        CapCol := Shade.C[15];
      end
      else begin
      T1 := Shade.C[13];
      T2 := Shade.C[15];
      B1 := Shade.C[10];
      B2 := Shade.C[7];
      FilCol := Shade.C[13];
      CapCol := Font.Color;
      end
  end
  else begin
  BorCol := Shade.C[8];
  CapCol := Shade.C[8];
  FilCol := Shade.C[13];
  end;
  with FCanvas do begin
  Pen.Style := psSolid;
  Brush := Parent.Brush;
  FillRect(ClientRect);
  Brush.Color := FilCol;
  Pen.Color := BorCol;
  InflateRect(Rec, -3, -3);
  RoundRect(Rec.Left, Rec.Top, Rec.Right, Rec.Bottom, 3, 3);
  if Enabled then begin
      Pen.Color := T1;
      MoveTo(Rec.Left + 1, Rec.Bottom - 3);
      LineTo(Rec.Left + 1, Rec.Top + 1);
      MoveTo(Rec.Left + 2, Rec.Top + 1);
      LineTo(Rec.Right - 2, Rec.Top + 1);
      Pen.Color := T2;
      MoveTo(Rec.Left + 2, Rec.Bottom - 4);
      LineTo(Rec.Left + 2, Rec.Top + 2);
      LineTo(Rec.Right - 3, Rec.Top + 2);
      Pen.Color := B1;
      MoveTo(Rec.Left + 3, Rec.Bottom - 3);
      LineTo(Rec.Right - 3, Rec.Bottom - 3);
      LineTo(Rec.Right - 3, Rec.Top + 2);
      Pen.Color := B2;
      MoveTo(Rec.Left + 3, Rec.Bottom - 2);
      LineTo(Rec.Right - 2, Rec.Bottom - 2);
      MoveTo(Rec.Right - 2, Rec.Bottom - 3);
      LineTo(Rec.Right - 2, Rec.Top + 2);

{ Make pixel-perfect modifications }
      if IsDown then begin
          Pixels[Rec.Left + 2, Rec.Top + 2] := T1;
          Pixels[Rec.Left + 3, Rec.Top + 3] := T2;
          Pixels[Rec.Left + 2, Rec.Bottom - 2] := B1;
          Pixels[Rec.Right - 2, Rec.Top + 2] := B1;
          Pixels[Rec.Right - 3, Rec.Bottom - 3] := B2;
          Pixels[Rec.Right - 4, Rec.Bottom - 4] := B1;
      end
      else begin
          Pixels[Rec.Left + 1, Rec.Top + 2] := Shade.C[11];
          Pixels[Rec.Left + 2, Rec.Top + 1] := Shade.C[11];
          Pixels[Rec.Left + 3, Rec.Top + 3] := T2;
          Pixels[Rec.Left + 1, Rec.Bottom - 3] := Shade.C[11];
          Pixels[Rec.Left + 2, Rec.Bottom - 2] := Shade.C[11];
          Pixels[Rec.Right - 3, Rec.Top + 1] := Shade.C[11];
          Pixels[Rec.Right - 2, Rec.Top + 2] := Shade.C[11];
          Pixels[Rec.Right - 4, Rec.Bottom - 4] := B1;
          Pixels[Rec.Right - 3, Rec.Bottom - 3] := B2;
      end;
  end;
  InflateRect(Rec, -8, -4);
  Font.Color := CapCol;
  Rec.Top := Rec.Top - 1;
  DrawText(Handle, PChar(Caption), Length(Caption), Rec,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  if Enabled then begin
    FocusRect := Rect(6, 6, width - 6, height - 6);
    if IsFocused then
    DrawFocusRect(FocusRect);
  end;
end;
  FCanvas.Handle := 0;
end;

procedure TXPButton.SetButtonStyle(ADefault: Boolean);
begin
    if (ADefault <> IsFocused) then begin
    IsFocused := ADefault;
    Invalidate;
    end;
end;

procedure TXPButton.SetBaseColor(Value: TColor);
begin
    if (Value <> FBaseColor) then begin
    FBaseColor := Value;
    Shade := LoadShades(FBaseColor);
    Repaint;
    end;
end;

function TXPButton.LoadShades(BaseColor: TColor): TShade;
var
    Index: Integer;
begin
    for Index := 0 to 7 do
    Result.C[Index] := ShadeColor(BaseColor, -(7 - Index) * 17);
    for Index := 8 to 15 do
    Result.C[Index] := ShadeColor(BaseColor, (Index - 7) * 17);
end;

function TXPButton.ShadeColor(BaseColor: TColor; Offset: Integer): TColor;
var
    Red, Green, Blue: Integer;
begin
    Red := (BaseColor and $FF) + Offset;
    Green := ((BaseColor and $FF00) div 256) + Offset;
    Blue := ((BaseColor and $FF0000) div 65536) + Offset;
    if (Red > $FF) then Red := $FF;
    if (Red < $00) then Red := $00;
    if (Green > $FF) then Green := $FF;
    if (Green < $00) then Green := $00;
    if (Blue > $FF) then Blue := $FF;
    if (Blue < $00) then Blue := $00;
    Result := (Blue * 65536) + (Green * 256) + Red;
end;

end.