xpbutton.~pas

用于将XML文件转化成关系数据库

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.