Используя TControlBar, как я могу ограничить движение полос в один ряд?

Question

Я использую компонент TControlBar в моем текущем проекте, но у меня возникают проблемы с элементом управления, рисующим дополнительные строки при перемещении полос,

по сути, я хочу, чтобы ControlBar всегда имел только 1 строку фиксированной высоты, и где полосы не могут ее избежать во время перетаскивания.

Как мне этого добиться?

Answer 1

Я решил это несколько месяцев назад, по сути, извлекая свой собственный компонент из класса TPanel и внедряя решение для перетаскивания дочерних панелей, чтобы имитировать поведение, которое я хотел.

Это самый основной принцип, который я использовал для реализации желаемого эффекта:

var oldPos : TPoint;

procedure TMainForm.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);

begin

   if Button = mbLeft then
     if (Sender is TWinControl) then
     begin
      inReposition:=True;
      SetCapture(TWinControl(Sender).Handle);
      GetCursorPos(oldPos);
      TWinControl(Sender).BringToFront;
     end else
        ((Sender as TLabel).Parent as TQPanelSub).OnMouseDown((Sender as TLabel).Parent as TQPanelSub,Button,Shift,X,Y)


end;


procedure TMainForm.ControlMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
var
  newPos: TPoint;
  temp : integer;

begin

  if (Sender is TWinControl) then begin

    if inReposition then
    begin

      with TWinControl(Sender) do
      begin
        GetCursorPos(newPos);
        Screen.Cursor := crSize;
        (* Constrain to the container *)
        Top := 0;
        temp := Left - oldPos.X + newPos.X;
        if (temp >= 0) and (temp <= (Parent.Width - Width))
        then Left := temp;
        oldPos := newPos;
      end;

    end;

  end else
    ((Sender as TLabel).Parent as TQPanelSub).OnMouseMove((Sender as TLabel).Parent as TQPanelSub,Shift,X,Y);

end;

procedure TMainForm.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin

   if inReposition then
  begin
    Screen.Cursor := crDefault;
    ReleaseCapture;
    inReposition := False;
  end;

end;

Это просто основа, которую я хотел получить от TControlBar, которая представляет собой ужасно написанный компонент.

Answer 2

Вы можете сделать обходной путь для этого:

procedure TForm1.ControlBar1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var R:TRect;
    Pt:TPoint;

begin
  Pt:=ControlBar1.ClientToScreen(Point(0,Y));
  R.Left:=Pt.X;
  R.Top:=Pt.Y;
  R.Right:=Pt.X+ControlBar1.Width;
  R.Bottom:=Pt.Y;
  ClipCursor(@R);
end;

procedure TForm1.ControlBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ClipCursor(nil) ;
end;

При этом вы можете ограничить движение мыши, чтобы разрешить только вертикальное расположение полос.