Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > Окно которое перетаскивается не толькоза заголовок


Автор: Johnny_B 31.7.2007, 00:17
Есть форма, на ней Image, speedbutton, panel. edit etc.
Нужно что бы можно было окно таскать за всё кроме панелей и кнопок, а также других изображений, т.е. конкретно что бы окно можно было таскать за конкретный Image (он закрывает всю форму)...

нашел вот это:
Код

Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле?
A: Нужно обрабатывать сообщение WM_NCHITTEST:
TForm1 = class(TForm)
...
private
...
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
...
end;
...
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { вызов унаследованного обработчика }
if M.Result = htClient then { Мышь сидит на окне? }
M.Result := htCaption; { Если да - то пусть Windows думает, что }
{ мышь на caption bar }
end;
...
Окно можно сделать вообще без caption.


  

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

Автор: TForumUser 31.7.2007, 00:41
если решать просто влоб, может получиться следующий код:
Код
implementation

{$R *.dfm}

var
 ox, oy: integer;
 flag: boolean;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 flag := true ;
 ox := x;
 oy := y;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 flag := false;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if flag then
 begin
  form1.Top := form1.Top - (oy - y);
  form1.Left := form1.Left - (ox - x);
 end;
end;

initialization
 flag := false;


ПЫСЫ. Возможно, можно проверять, нажата ли клавиша мыши другим способом, просто я его не знаю. В таком случае такой код будет выглядеть немного меньше)

Автор: Johnny_B 31.7.2007, 08:01
TForumUser, Спасибоsmile отлично работает - только мне надо было для формы покрытой полностью TImage, у неё тоже есть эти события поэтому я переписал их именно для этой картинки, все работает...
Единственное заметел, что перетаскивается с содержимым окна а не рамка, т.е. у меня в системе отключено перетаскивание с содержимым окна... думаю это из-а того что этот система работает только с Каптион.

Автор: THandle 31.7.2007, 19:41
Я всегда когда надо использую вот такой код:

Код

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button = mbLeft then
 begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND,$F012,0);
 end;
end;

Автор: W1zArD 31.7.2007, 20:57
на бработчике события OnMouseDown
Код

...
begin
ReleaseCapture;
SendMessage(handle, WM_SYSCOMMAND, $f012, 0);
end;
...


и таскай себе на здоровье

Автор: Johnny_B 1.8.2007, 16:12
А как таскать форму за Bevel, ведь у него нет событий?
Можно ли сделать что бы при клике на этот Бэвел, система думала что кликают на Форму или Имэйдж???
Спасибо за ответыsmile

Автор: bems 1.8.2007, 16:23
смотри сообщение WM_HCHITTEST

Автор: pseud 1.8.2007, 16:38
на форме лежит 2 кнопки и 2 лабела
в результате:
  - тягать можно за тело формы
  - шапка формы продолжает выполнять функции шапки
  - кнопка 1 и лабел 1 остаются кликабельны
  - кнопка 2 и лабел 2 - тягательны
  
Код

  private
    procedure wmNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;


procedure TForm1.wmNCHitTest(var Msg: TWMNCHitTest);
var
  P: TPoint;
  C: TControl;
begin
  inherited;

  P.X := Msg.XPos;
  P.Y := Msg.YPos;

  if not PtInRect(Self.ClientRect, Self.ScreenToClient(P)) then
    Exit;

  C := FindDragTarget(P, True);
  if (C <> Button1)
  and (C <> Label1) then
    Msg.Result := HTCAPTION;
end;


Добавлено через 3 минуты и 10 секунд

маленький недочет - кнопка 2 осталась кликабельна
надо копать

Автор: bems 1.8.2007, 16:59
pseud, а зачем PtInRect?

мона ж унаследованній обработчик візвать и проверять его результат?

Автор: pseud 1.8.2007, 17:07
Цитата(bems @  1.8.2007,  16:59 Найти цитируемый пост)
а зачем PtInRect?


чтобы шапка формы оставалась шапкой
попробуй сначала без этого кода - получишь:
  - нет доступа к кнопкам min, max, close
  - нет доступа к бордюрам

Автор: bems 2.8.2007, 16:58
Цитата(pseud @  1.8.2007,  17:07 Найти цитируемый пост)
попробуй сначала без этого кода 

ну я ж говорю
Цитата(bems @  1.8.2007,  16:59 Найти цитируемый пост)
унаследованній обработчик візвать и проверять его результат
например если унаследованый обработчик вернул HTCLIENT то заменить результат на HTCAPTION а в противном случае оставлять как есть.

Тем более что ты в своем примере и так вызываешь унаследованый обработчик а значит определение принадлежности точки уже было сделано. А вызовом PtInRect ты делаешь двойную работу

Автор: pseud 3.8.2007, 14:26
bems, 
наверно ты имеешь ввиду, что код должен быть такой:
Код

procedure TForm1.wmNCHitTest(var Msg: TWMNCHitTest);
var
  P: TPoint;
  C: TControl;
begin
  inherited;

  if  Msg.Result <> HTCLIENT then
    Exit;

  P.X := Msg.XPos;
  P.Y := Msg.YPos;

  C := FindDragTarget(P, True);
  if (C <> Button1)
  and (C <> Label1) then
    Msg.Result := HTCAPTION;
end;

Автор: bems 3.8.2007, 15:39
я думаю что лучше так
Код

procedure TForm1.wmNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  if  Msg.Result = HTCLIENT then msg.Result:=HTCAPTION;
end;
при этом перетаскивается и за неоконные компоненты. А оконные кликаются.

Если нужен лейбл за который нельзя таскать то просто можно заменить его на статиктекст или положить на панель

Добавлено через 2 минуты и 28 секунд
претаскивания за границы и другие элементы можно добиться проверяя результат встроенной обработки на другие предопределенные значения HTXXXXXXXXXX. они есть в хелпе

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)