Класс TWinControl и его наследники

type
  TmmEconomicButton = class(TButton)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

implementation

{ TmmEconomicButton }

procedure TmmEconomicButton.WndProc(var Message: TMessage);
begin

  if Message.Msg = CM_VISIBLECHANGED then
  begin
    if not (csDesigning in ComponentState) then
      if Visible then
        HandleNeeded
      else
        DestroyHandle;
  end;

  inherited WndProc(Message);

end;

Procedure TmyObject.WndProc(var Message:TMessage) 
begin
  Case Message.msg of
    WM_Paint:DoSomething;
    WM_Char:DoSomething;
  else 
    Inherited  wndProc(Mmessage)
  end
end;

unit ummMultiLineButton;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Windows;

type
  TMultyLineStyle = (mlSingle, mlMulti);

  TmmMultiLineButton = class(TButton)
  private
    FMultiLineStyle: TMultyLineStyle;
    procedure SetMultiLineStyle(const Value: TMultyLineStyle);
    { Private declarations }
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
  published
    { Published declarations }
    property MultiLineStyle:TMultyLineStyle
               read FMultiLineStyle write SetMultiLineStyle;
    property Width default 100;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Our components', [TmmMultiLineButton]);
end;

{ TmmMultiLineButton }

constructor TmmMultiLineButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMultiLineStyle:=mlMulti;
  Width:=100;
end;

procedure TmmMultiLineButton.CreateParams(var Params: TCreateParams);
begin
  inherited;
  if MultiLineStyle = mlMulti then
    Params.Style:=Params.Style or BS_MULTILINE;
end;

procedure TmmMultiLineButton.SetMultiLineStyle(
  const Value: TMultyLineStyle);
begin
  if FMultiLineStyle <> Value then
  begin
    FMultiLineStyle := Value;
    case FMultiLineStyle of
      mlSingle:
           SetWindowLong(Handle,GWL_STYLE,
               GetWindowLong(Handle,GWL_STYLE) and not BS_MULTILINE);
      mlMulti:
           SetWindowLong(Handle,GWL_STYLE,
               GetWindowLong(Handle,GWL_STYLE) or BS_MULTILINE);
    end;
    Invalidate;
  end;
end;

end.

destructor TWinControl.Destroy;
var
  I: Integer;
  Instance: TControl;
begin
  Destroying;
  if FDockSite then
  begin
    FDockSite := False;
    RegisterDockSite(Self, False);
  end;
  FDockManager := nil;
  FDockClients.Free;
  if Parent <> nil then RemoveFocus(True);
  if FHandle <> 0 then DestroyWindowHandle;
  I := ControlCount;
  while I <> 0 do
  begin
    Instance := Controls[I - 1];
    Remove(Instance);
    Instance.Destroy;
    I := ControlCount;
  end;
  FBrush.Free;
  if FObjectInstance <> nil
    then Classes.FreeObjectInstance(FObjectInstance);
  inherited Destroy;
end;

  constructor CreateParented(ParentWindow: HWnd);
    class function CreateParentedControl(ParentWindow: HWnd): TWinControl;

procedure TForm1.Button1Click(Sender: TObject);
var
  VButton: TButton;
begin
  VButton := TButton.Create(Self);
  InsertComponent(VButton);
  with VButton do
  begin
    ParentWindow:=GetDesktopWindow;
    Left:=100;
    Top:=100;
    Caption:=Кнопка на рабочем столе!';
    ShowWindow(Handle, SW_show);
  end;
end;

unit mmLeg;

interface

uses
  SysUtils, Classes, Controls, Graphics, Math, Windows;

type
  TmmLed = class(TCustomControl)
  private
    FOnColor,
    FOffColor,
    FDisabledColor  : TColor;
    FChecked: Boolean;
    FOnChecked: TNotifyEvent;
    procedure SetChecked(Value: Boolean);
    procedure SetOnColor(Value: TColor);
    procedure SetOffColor(Value: TColor);
    procedure SetDisabledColor(const Value: TColor);
  protected
    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; 
                        Shift: TShiftState; X, Y: Integer); override;
    procedure DoChecked; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Checked: Boolean read FChecked write SetChecked;
    property Enabled;
    property OnColor: TColor read FOnColor write SetOnColor 
              default clLime;
    property OffColor: TColor read FOffColor write SetOffColor 
             default clInactiveCaption;
    property DisabledColor: TColor
               read FDisabledColor write SetDisabledColor 
             default clGrayText;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Hint;
    property Visible;
    property TabStop;
    property TabOrder;
    property Height default 14;
    property Width default 40;
    property Caption;

    property OnClick;
    property OnEnter;
    property OnExit;
    property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
  end;

procedure Register;

implementation
{$R mmLed.dcr}
procedure Register;
begin
  RegisterComponents('Our components', [TmmLed]);
end;

constructor TmmLed.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  FOnColor := clLime;
  FOffColor := clInactiveCaption;
  FDisabledColor:=clGrayText;
  Width := 40;
  Height := 14;
  TabStop:=true;
end;

procedure TmmLed.Paint;
var MajorExtent, SpotRadius,
    midXY: Integer;
    LedColor: TColor;
begin

  MajorExtent := Min(Width, Height);
  midXY := MajorExtent div 2;
  Canvas.Font:=Font;

  if Enabled then
  begin
    if FChecked then
      LedColor := FOnColor
    else
      LedColor := FOffColor;
  end else
    LedColor:=FDisabledColor;

  if Visible or (csDesigning in ComponentState) then
    with Canvas do
    begin
      Brush.Color:=clBtnFace;
      Brush.Style:=bsSolid;
      FillRect(ClientRect);

      Brush.Color := LedColor;
      Pen.Color := clBtnShadow;
      Ellipse(0, 0, MajorExtent, MajorExtent);

      SpotRadius := Max(1, MajorExtent div 4);
      Pen.Color := clBtnHighlight;
      Brush.Color := clBtnHighlight;
      Ellipse(midXY - SpotRadius, midXY - SpotRadius,
              midXY, midXY);

      Brush.Style:=bsClear;
      if Enabled then
         Font.Color:=clBtnText
      else
         Font.Color:=clGrayText;
      TextRect(Clientrect, MajorExtent,
               midXY - (TextHeight(Caption) div 2), Caption);

      Brush.Color:=clBtnFace;
      if Focused then
        DrawFocusRect(ClientRect); // визуализация получения фокуса
    end;
end;

procedure TmmLed.SetDisabledColor(const Value: TColor);
begin
  if Value <> FDisabledColor then
  begin
    FDisabledColor := Value;
    Refresh;
  end;
end;


procedure TmmLed.SetChecked(Value: Boolean);
begin
  if Value <> FChecked then
  begin
    FChecked := Value;
    DoChecked;
    Refresh;
  end;
end;

procedure TmmLed.SetOnColor(Value: TColor);
begin
  if Value <> FOnColor then
  begin
    FOnColor := Value;
    Refresh;
  end;
end;

procedure TmmLed.SetOffColor;
begin
  if Value <> FOffColor then
  begin
    FOffColor := Value;
    Refresh;
  end;
end;

procedure TmmLed.DoEnter;
begin
  inherited;
  Refresh;
end;

procedure TmmLed.DoExit;
begin
  inherited;
  Refresh;
end;

procedure TmmLed.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_RETURN then
    Checked:=not Checked;
end;

procedure TmmLed.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
  function LedClicked:boolean;
  begin
    Result:=((X <= Min(Width, Height)) and (Y <= Min(Width, Height)));
  end;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Focused or LedClicked then
    Checked:=not Checked;
  
end;

procedure TmmLed.DoChecked;
begin
  if Assigned(FOnChecked) then
    FOnChecked(Self);
end;

end.

unit mmCheckPanel;
interface
uses Windows, ExtCtrls, Classes, Graphics, Controls, StdCtrls;
type

  TmmCheckPanel = class(TPanel)
  private
    FCheckBox: TCheckBox;
    FCheckCaption: string;
    FOnCheck: TNotifyEvent;
    function GetChecked: Boolean;
    procedure SetChecked(const Value: Boolean);
    procedure SetCheckCaption(const Value: string);
    procedure SetOnCheck(const Value: TNotifyEvent);
    function GetCheckCaption: string;
  protected
    procedure Paint; override;
    procedure DoChecked(Sender: TObject); virtual;
    procedure DisableControls(const Disable: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Checked: Boolean read GetChecked write SetChecked;
    property Caption: string read GetCheckCaption write SetCheckCaption;
    property OnCheck: TNotifyEvent read FOnCheck write SetOnCheck;
  end;

procedure Register;

implementation
procedure Register;
begin
  RegisterComponents('Our components', [TmmCheckPanel]);
end;
{ TmmCheckPanel }

constructor TmmCheckPanel.Create(AOwner: TComponent);
begin
  inherited;
  inherited Caption := ' ';
  FCheckCaption := 'Включить';
  FCheckBox := TCheckBox.Create(self);
  with FCheckBox do
    begin
      Checked := True;
      OnClick := DoChecked;
      Left := 5;
      Parent := Self;
      Caption := FCheckCaption;
    end;

end;

procedure TmmCheckPanel.DisableControls(const Disable: Boolean);
var
  i: Integer;
begin
  for i := 0 to ControlCount - 1 do // собственно код отключения контролов
    if Controls[i] <> FCheckBox then
      Controls[i].Enabled := Disable;

end;

procedure TmmCheckPanel.DoChecked(Sender: TObject);
begin
  DisableControls(FCheckBox.Checked);
  if Assigned(FOnCheck) then
    FOnCheck(Self);
end;

function TmmCheckPanel.GetCheckCaption: string;
begin
  Result := FCheckCaption;
end;

function TmmCheckPanel.GetChecked: Boolean;
begin
  Result := FCheckBox.checked;
end;

procedure TmmCheckPanel.Paint;
const
  Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  Rect: TRect;
  TopColor, BottomColor: TColor;
  FontHeight: Integer;
  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then
      TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then
      BottomColor := clBtnHighlight;
  end;

begin
  Rect := GetClientRect;

  Rect.Top := FCheckBox.Height div 2;

  if BevelOuter <> bvNone then
    begin
      AdjustColors(BevelOuter);
      Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
    end;
  Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
    begin
      AdjustColors(BevelInner);
      Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
    end;
  with Canvas do
    begin
      Brush.Color := Color;
      FillRect(Rect);
      Brush.Style := bsClear;
      Font := Self.Font;
      FontHeight := TextHeight('W');
    end;
  FCheckBox.Caption := FCheckCaption;
  FCheckBox.Width := GetSystemMetrics(SM_CXVSCROLL) +
                     Canvas.TextWidth(FCheckCaption) + 5;
 end;

procedure TmmCheckPanel.SetCheckCaption(const Value: string);
begin
  FCheckCaption := Value;
  InValidate;
end;

procedure TmmCheckPanel.SetChecked(const Value: Boolean);
begin
  FCheckBox.Checked := Value;
  DisableControls(FCheckBox.Checked);
  InValidate;
end;

procedure TmmCheckPanel.SetOnCheck(const Value: TNotifyEvent);
begin
  FOnCheck := Value;
end;

end.