這是一個TButton上外加了一個LED(用TShape顯示)的元件,操作大致ok,現在的問題是如下文的紅文部份,在都没
設事件下按Button後其上的Shape顯示不出來,若按下時改變AsBool則正常喔!好奇怪喔!!

unit MyLedButton;

interface

uses StdCtrls, Graphics, ExtCtrls, Classes, SysUtils, Types, Windows, Messages;

type
TMyLedButton = class(TButton)
private
FAsBool: Boolean;
FLayout: TTextLayout;
FON: TColor;
FOFF: TColor;
procedure LedResize;
procedure SetAsBool(const Value: Boolean);
procedure SetLayout(const Value: TTextLayout);
procedure SetON(const Value: TColor);
procedure SetOFF(const Value: TColor);
protected
led: TShape;
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure repaint; override;
published
property AsBool: Boolean read FAsBool write SetAsBool; True時show On的顏色,反之則OFF !
property Layout: TTextLayout read FLayout write SetLayout;
property on: TColor read FON write SetON;
property OFF: TColor read FOFF write SetOFF;
end;

procedure Register;

implementation

{--------------------------------------------------------------------------------------------------}

procedure Register;
begin
RegisterComponents('myVCL', [TMyLedButton]);
end; {Register}

constructor TMyLedButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

led := nil;

FAsBool := False;
FON := clLIME;
FOFF := clGreen;
// if not (csDesigning in ComponentState) then
FLayout := tlCenter;
end;

destructor TMyLedButton.Destroy;
begin
if led <> nil then
FreeandNil(led);

inherited;
end;

procedure TMyLedButton.LedResize;
begin
if led <> nil then
begin
if FLayout = tlTop then
led.Top := ClientHeight - 11
else
led.Top := 5;
led.Left := 4;
led.Width := ClientWidth - 9;
led.Height := 6;
end;
end;

procedure TMyLedButton.repaint;
begin
// TODO -cMM: TMyLedButton.repaint default body inserted
inherited;

if led <> nil then
led.Refresh;
end;

procedure TMyLedButton.SetAsBool(const Value: Boolean);
begin
if FAsBool <> Value then
begin
FAsBool := Value;
if FLayout <> tlCenter then
begin
if led <> nil then
begin
if FAsBool then
led.Brush.Color := FON
else
led.Brush.Color := FOFF;

led.Refresh;
end;
end;
end;
end;

procedure TMyLedButton.SetLayout(const Value: TTextLayout);
var
defstyle: dWord;
begin
if FLayout <> Value then
begin
FLayout := Value;
//
defstyle := GetWindowLong(Handle, GWL_STYLE) and (not BS_TOP) and (not BS_BOTTOM) and (not BS_CENTER);

if FLayout = tlCenter then
begin
SetWindowLong(Handle, GWL_STYLE, defstyle or BS_CENTER);
if led <> nil then
begin
led.Free;
led := nil;
end;
end
else
begin
if FLayout = tlTop then
SetWindowLong(Handle, GWL_STYLE, defstyle or BS_TOP)
else
SetWindowLong(Handle, GWL_STYLE, defstyle or BS_BOTTOM);
//
if led = nil then
begin
led := TShape.Create(self);
led.Parent := self;
LedResize;
led.Brush.Color := FOFF;
led.BringToFront;
led.Tag := Width Height;
end;
end;
Refresh;
end;
end;

procedure TMyLedButton.SetOFF(const Value: TColor);
begin
if FOFF <> Value then
begin
FOFF := Value;
if led <> nil then
begin
led.Brush.Color := FOFF;
led.Refresh;
end;
end;
end;

procedure TMyLedButton.SetON(const Value: TColor);
begin
if FON <> Value then
begin
FON := Value;
if led <> nil then
begin
led.Brush.Color := FON;
led.Refresh;
end;
end;
end;

procedure TMyLedButton.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: 事件有反應但程式碼也執行了但就是Show不出來!!
begin
if led <> nil then
begin
led.BringToFront;
led.Refresh;
end;
end;
WM_SIZE:
begin
if led <> nil then
begin
if led.tag <> (Width Height) then
begin
self.LedResize;
led.Tag := Width Height;
end;
end;
end;
end;

inherited WndProc(Message);
end;

end.