Исходный текст программы
{——————————————————————————————————————————————————————} { Демонстрационная программа } { для работы с плавающими панелями инструментов. } { 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 выглядит тривиально; все, что от него требуется — сбросить флаг статуса.
