Советы по Delphi

         

Перемещение формы не за заголовок I


Перетаскивание границ окна

Это описание одного из Борландовских советов:

В: Как я могу заставить форму перемещаться, щелкая и таская ее в области окна, исключая заголовок?

О: Простейший путь - "одурачить" окно, пусть оно думает, что его тастают за заголовок. Сделайте это с помощью системного сообщения wm_NCHitTest...

type
TForm1 = class(TForm)private{ Private-Deklarationen }public{ Public-Deklarationen }procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;end;
var
Form1: TForm1;
implementation
{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited
; { вызов унаследованного обработчика события }if M.Result = htClient then { кликнув в области окна? }M.Result := htCaption; { если так, то мы заставили Windows думать, }{ что щелчок был на заголовке окна. }end;

Перетаскивание окна с содержимым

После того, как я воспользовался вашим кодом, окно осталось на том же месте, таскался лишь его контур. Как изменить это так, чтобы при перетаскивании сохранялось содержимое окна (подобно win95 plus)?

Вот небольшой простой компонент, работающий по этому принципу...



Unit WinDrag;

interface

uses
windows, sysutils, classes, dsgnintf;

type
TWinDrag = class(TComponent)private{ Private Declarations }protected{ Protected Declarations }public{ Public Declarations }constructor Create(AOwner: TComponent); override;destructor Destroy; override;function GetDragFlag: boolean;procedure SetDragFlag(Status: Boolean);publishedProperty DragFlag: Boolean read GetDragFlag write SetDragFlag;end;

procedure Register;

implementation

constructor
TWinDrag.Create(AOwner: TComponent);
begin
inherited
Create(AOwner);DragFlag := GetDragFlag;end;

destructor TWinDrag.Destroy;
begin
inherited
Destroy;end;

function TWinDrag.GetDragFlag: boolean; var Value : Boolean; beginSystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @Value, 0);Result := Value;end;

procedure TWinDrag.SetDragFlag(Status: Boolean);
begin
SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, Integer(Status),POINTER(0), 0);
end;

procedure Register;
begin
RegisterComponents('Samples', [TWinDrag]);end;

end.
<
/p> Перетаскивание формы, удерживая компонент Label

Если вы хотите переместить форму, удерживая ее мышью, воспользуйтесь приведенным ниже кодом (при необходимости перетаскивания формы, удерживая ее за другие визуальные элементы управления, например, Label, используйте этот код в их соответствующих обработчиках события):

var
X1, Y1: Integer;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);begin
{Устанавливаем координаты старта}X1 := X;Y1 := Y;end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);begin
{Проверяем нажатие левой кнопки мыши}if HiWord(GetAsyncKeyState(VK_LBUTTON)) > 0 thenbeginForm1.Left := Form1.Left + X - X1;Form1.Top := Form1.Top + Y - Y1;end;end;
[000094]



пишет:

Я нашел более компактный способ перемещения формы не за заголовок. При этом можно обойтись обработкой только события OnMouseDown. Перетаскивать форму можно за любой элемент, который находится на ней. Для этого создайте обработчик OnMouseDown для элементов, за которые хотите перетаскивать форму (и/или для самой формы). Вот пример для Panel:

procedure TForm1.PanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);const
SC_DRAGMOVE : Longint = $F012;begin
if
Button <> mbRight thenbeginReleaseCapture;SendMessage(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);end;end;

Сергей Матвейчук. [000895]



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