Delphi 3. Библиотека программиста

Плавающие панели инструментов


Дневник №16 (3 апреля): Я всегда любил программы с панелями инструментов, свободно перемещаемыми по экрану. Такие панели особенно удобны

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

В поисках основы для «плавающей» панели инструментов я перебрал различные компоненты, поставляемые вместе с Delphi. Наверное, можно было бы воспользоваться дополнительной формой, но я не стремился к экзотическим решениям. Меня вполне устроило бы нечто, перемещаемое в пределах клиентской области главной формы.

Обычный компонент TPanel прекрасно подходил на эту роль, за исключением одного: панели нельзя перемещать во время выполнения. Однако небольшое исследование показало, что они способны обрабатывать события мыши. После нескольких неудачных попыток у меня получилась демонстрационная программа, приведенная в листинге16.7.
Листинг 16.7. Исходный текст программы с плавающей панелью инструментов

{——————————————————————————————————————————————————————} { Демонстрационная программа } { для работы с плавающими панелями инструментов. } { TOOLMAIN.PAS : Главная форма } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Приложение, демонстрирующее возможность применения } { перемещаемых объектов TPanel в качестве плавающих } { панелей инструментов. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 30/4/97 } {——————————————————————————————————————————————————————} unit ToolMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl, ExtCtrls, Buttons; type TDirection = (otHorizontal, otVertical); TForm1 = class(TForm) Toolbar: TPanel; ExitSB: TSpeedButton; ZoomInSB: TSpeedButton; ZoomOutSB: TSpeedButton; ControlPanel: TPanel; GranRBGroup: TRadioGroup; MarginRBGroup: TRadioGroup; OrientRBGroup: TRadioGroup; ExitBtn: TButton; LEDSB: TSpeedButton; procedure ExitBtnClick(Sender: TObject); procedure ToolbarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ToolbarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ToolbarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure GranRBGroupClick(Sender: TObject); procedure MarginRBGroupClick(Sender: TObject); procedure ExitSBClick(Sender: TObject); procedure OrientRBGroupClick(Sender: TObject); private DraggingPanel : Boolean; DragStartX : Integer; DragStartY : Integer; GridSize : Integer; MarginSize : Integer; procedure OrientToolBar(Direction : TDirection); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end;

procedure TForm1.ToolbarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin DraggingPanel := True; DragStartX := X; DragStartY := Y; end; end; procedure TForm1.ToolbarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin DraggingPanel := False; end; procedure TForm1.ToolbarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var DeltaX : Integer; DeltaY : Integer; SafetyMargin : Integer; begin if DraggingPanel then with Toolbar do begin DeltaX := X - DragStartX; DeltaY := Y - DragStartY; if GridSize > MarginSize then SafetyMargin := GridSize else SafetyMargin := MarginSize; if (abs(DeltaX) > GridSize - 1) then if DeltaX > 0 then begin if (ControlPanel.Left - Left) > SafetyMargin then Left := Left + DeltaX else Left := ControlPanel.Left - SafetyMargin; end else begin if (Left + Width) > SafetyMargin then Left := Left + DeltaX else Left := SafetyMargin - Width; end; if (abs(DeltaY) > GridSize - 1) then if DeltaY > 0 then begin if (Form1.ClientHeight - Top) > SafetyMargin then Top := Top + DeltaY else Top := Form1.ClientHeight - SafetyMargin; end else begin if Top + Height > SafetyMargin then Top := Top + DeltaY else Top := SafetyMargin - Height; end; end; { with } end; procedure TForm1.FormCreate(Sender: TObject); begin GranRBGroup.ItemIndex := 0; MarginRBGroup.ItemIndex :=0; OrientRBGroup.ItemIndex := 0; end; procedure TForm1.GranRBGroupClick(Sender: TObject); begin case GranRBGroup.ItemIndex of 0 : GridSize := 1; 1 : GridSize := 10; 2 : GridSize := 20; end; { case } end; procedure TForm1.MarginRBGroupClick(Sender: TObject); begin case MarginRBGroup.ItemIndex of 0 : MarginSize := 5; 1 : MarginSize := 10; 2 : MarginSize := 15; end; { case } end; procedure TForm1.ExitSBClick(Sender: TObject); begin Close; end; procedure TForm1.OrientRBGroupClick(Sender: TObject); begin case OrientRBGroup.ItemIndex of 0 : OrientToolBar(otHorizontal); 1 : OrientToolBar(otVertical); end; { case } end; procedure TForm1.OrientToolbar(Direction : TDirection); begin with Toolbar do begin Left := 20; Top := 20; case Direction of otHorizontal : begin Width := (4 * ExitSB.Width) + 20;; Height := ExitSB.Height + 10; ExitSB.Top := 6; ZoomInSB.Top := 6; ZoomOutSB.Top := 6; LEDSB.Top := 6; ExitSB.Left := 11; ZoomInSB.Left := ExitSB.Left + ExitSB.Width; ZoomOutSB.Left := ZoomInSB.Left + ZoomInSB.Width; LEDSB.Left := ZoomOutSB.Left + ZoomOutSB.Width; end; otVertical : begin Width := ExitSB.Width + 10; Height := (4 * ExitSB.Height) + 20; ExitSB.Left := 6; ZoomInSB.Left := 6; ZoomOutSB.Left := 6; LEDSB.Left := 6; ExitSB.Top := 11; ZoomInSB.Top := ExitSB.Top + ExitSB.Height; ZoomOutSB.Top := ZoomInSB.Top + ZoomInSB.Height; LEDSB.Top := ZoomOutSB.Top + ZoomOutSB.Height; end; end; { case } end; { with } end; end.

Как видно из листинга, панель должна обрабатывать три события мыши — OnMouseDown, OnMouseMove и OnMouseUp. Обработчик OnMouseDown проверяет, была ли нажата левая кнопка мыши. Если это так, он запоминает исходное положение курсора и устанавливает флаг статуса в состояние, которое обозначает перетаскивание.

Обработчик OnMouseMove выглядит сложнее — в основном потому, что ему приходится следить, чтобы панель не вышла за пределы клиентской области и не потерялась из вида. Обработчик ToolbarMouseMove вычисляет разность между исходным и текущим положениями мыши и прибавляет ее к первоначаль ным значениям свойств Left и Top панели, чтобы переместить ее в новое место. Я предусмотрел возможность перемещения панели с шагом в 1, 10 или 20 пикселей. Внешне это выглядит похожим на перемещение компонентов в режиме конструирования Delphi при включенной привязке к сетке. Кроме того, я позаботился о том, чтобы участок панели всегда можно было захватить мышью, даже если пользователь по неосторожности уведет ее слишком далеко.

Обработчик OnMouseUp выглядит тривиально; все, что от него требуется — сбросить флаг статуса.

?ис. 16.5. Плавающая панель инструментов

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

На рис. 16.5 показано, как выглядит эта программа во время выполнения. Перетаскивать панель оказывается довольно занятно, к тому же первая кнопка на ней выполняет полезную функцию — завершает работу программы.

Конец записи (3 апреля).



Содержание раздела