Наложение маски на компонент

procedure SetZ (AControl: TControl; AZ: Integer);
// Позиционирует контрол по Z
var
  Pos: HWND;
begin
  AControl.ComponentIndex := AZ;

  if (AControl is TWinControl) then
  with TWinControl(AControl) do begin
    if AZ = 0 then
      Pos := HWND_BOTTOM
    else
      if AZ >= Parent.ComponentCount — 1 then
        Pos := HWND_TOP
      else
        Pos := TWinControl(Parent.Components[AZ-1]).Handle;

    SetWindowPos(Handle, Pos, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  end;
end;

procedure ControlMask (AControl: TControl; ARect: PRect);
// Если ARect=nil, то сущ-ая маска просто удалится
var
  p: TMaskControl;
  b: Boolean;
begin
  if AControl.Parent is TMaskControl then begin // Если на контрол уже наложена маска, то ее нужно снять перед наложением новой
    p := (AControl.Parent as TMaskControl);
    AControl.Left := AControl.Left + p.Left; // позиционируем (смещаем) контрол по X
    AControl.Top  := AControl.Top  + p.Top ; // позиционируем (смещаем) контрол по Y
    if AControl is TWinControl then // если контрол — это TWinControl
      b := TWinControl (AControl).Focused // запоминаем состояние фокуса контрола
    else
      b := False;
    AControl.Parent := p.Parent; // переносим его на нового родителя
    if b then TWinControl (AControl).SetFocus; // устанавливаем фокус контрола
    SetZ (AControl, p.ComponentIndex); // позиционируем контрол по Z
    if AControl is TWinControl then // если контрол — это TWinControl
      TWinControl (AControl).TabOrder := p.TabOrder; // назначаем ему TabOrder
    p.Free; // уничтожаем панель-маску
  end;

  if ARect <> nil then begin // Если нужно наложить маску
    p := TMaskControl.Create (Application); // cоздаем новую маску
    p.BoundsRect := ARect^; // позиционируем её
    if AControl is TWinControl then // если контрол — это TWinControl
      b := TWinControl (AControl).Focused // запоминаем состояние фокуса контрола
    else
      b := False;
    p.Parent := AControl.Parent; // переносим на родителя
    if AControl is TWinControl then // если контрол — это TWinControl
      p.TabOrder := TWinControl (AControl).TabOrder; // назначаем маске TabOrder
    p.TabStop := False; // не останавливаемся на маске по Tab
    SetZ (p, AControl.ComponentIndex); // позиционируем маску по Z

    with AControl do begin
      Parent := p; // переносим контрол на маску
      if b then TWinControl (AControl).SetFocus; // устанавливаем фокус контрола
      Left := Left — ARect.Left; // позиционируем (смещаем) его по X
      Top  := Top  — ARect.Top ; // позиционируем (смещаем) его по Y

      if Left > 0 then begin // Обрезаем маску слева
        p.Left  := p.Left  + Left;
        p.Width := p.Width — Left;
        Left := 0;
      end;

      if Top > 0 then begin // Обрезаем маску сверху
        p.Top    := p.Top    + Top;
        p.Height := p.Height — Top;
        Top := 0;
      end;

      if (Left + Width) < p.Width then begin // Обрезаем маску справа
        p.Width := Left + Width;
      end;

      if (Top + Height) < p.Height then begin // Обрезаем маску снизу
        p.Height := Top + Height;
      end;
    end;
  end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
  c: TControl;
begin
  if Sender is TControl then begin
    c := (Sender as TControl);
    if c.Parent is TMaskControl then // Если на контрол уже наложена маска
      ControlMask (c, nil) // то снимает её
    else begin // иначе
      r := Rect (50, 20, 200, 30);
      ControlMask (c, @r) // накладываем маску
    end;
  end;
end;Syhi-подсветка кода