Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 12 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 25 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 25 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 26 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 26 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 27 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 27 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 28 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 28 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 29 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 25 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 25 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 26 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 26 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 27 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 27 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 28 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 28 Deprecated: Function eregi() is deprecated in /home/codingr/sites/codingrus.ru/maincore.php on line 29 Перетаскивание окна без рамки
Прислано Kest на October 29 2008 14:27:24

---

Как перетаскивать окна без рамки (т. е. с BorderStyle = bsNone).
Предполагаемое решение: При нажатии кнопки мыши - если она находится на форме
отправлять Windows сообщение, что под мышкой - заголовок окна.

Ответ №1 (Winnukem): Когда-то давно я где-то нашел вот это.
Можно повесить и на событие image,
и label; тогда форма будет перетаскиваться за них. Вот код:

procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012;
begin
ReleaseCapture;
perform(WM_SysCommand, SC_DragMove, 0);
end;


Ответ №2 (Eugene V. Geraschenko): Вот у меня есть один способ, правда он рассчитан
на быстрые компы.
Нужно создать Timer с Enabled = False и Interval = на ваше усмотрение
(в зависимости от производительности), например 50.

procedure TfrmMenu.Timer1Timer(Sender: TObject);
begin
Top:= Mouse.CursorPos.Y - FormY;
Left:= Mouse.CursorPos.X - FormX;
end;

procedure TfrmMenu.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Timer1.Enabled:= True;
FormX:= X;
FormY:= Y;
end;

procedure TfrmMenu.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Timer1.Enabled:= False;
end;


Ответ №3 (Виталий Джангл):

private
procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(Handle, GWL_STYLE,
GETWINDOWLONG(Handle, GWL_STYLE) and (not WS_CAPTION));
Height := ClientHeight;
end;

procedure TForm1.WMNCHITTEST(var Msg: TMessage);
begin
inherited;
Msg.Result := HTCAPTION;
end;


P.S. от ведущего: Этот способ - мой выбор.
Я им пользуюсь уже давно, когда возникает необходимость.

Ответ №4 (Dr.IMP):

unit DragMain;
interf
uses SysUtils, WinTypes, WinProcs, Messages, Classes,
Graphics, Controls, Forms, Dialogs, StdCrtls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure ButtonClick(Sender: TObject);
private
procedure WMNCHitTest(var M: TWMNCHitTest);
message wm_NCCHitTest;
end;

var
Form1: TForm1;

implementation
{$R *.DFM}
procedure TForm1. WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;

end.
--------------------------------------------------------------------------------
procedure TForm1.MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012;
begin
ReleaseCapture;
perform(WM_SysCommand, SC_DragMove, 0);
end;


Ответ №5 (Vlad): Я делаю так:

interface
..............................................
public
procedure MoveAllPlace(var Msg:TMessage);message WM_NCHITTEST;
..............................................
implementation
..............................................
procedure TForm1.MoveAllPlace(var Msg:TMessage);
begin
inherited;
if Msg.Result=1 then Msg.Result:=2;
end;
..............................................


Ответ №6 (Fornit): Предложенное ведущим можно реализовать следующим образом
- включить в форму обработчик сообщения WM_NCHITTEST

procedure WMNCHitTest(var M: TWMNCHitTest); message WM_NCHITTEST;
...
procedure WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then
M.Result := htCaption;
end;


Ответ №7 (Желтов Антон): Я использую очень простой метод и не совсем возможно
корректный, но действенный. В примере image2 задний фон формы, и за нее можно таскать

procedure TfoAbout.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image2.OnMouseMove:=Image2MouseMove;
_x:=x;
_y:=y;
end;

procedure TfoAbout.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
left:=x-_x+left;
top:=y-_y+top;
end;

procedure TfoAbout.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
image2.OnMouseMove:=nil;
end;