Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Окно которое перетаскивается не толькоза заголовок, Как сделать? что-то типа easy move 
:(
    Опции темы
Johnny_B
  Дата 31.7.2007, 00:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 30.7.2007
Где: Северодонецк

Репутация: нет
Всего: нет
Есть форма, на ней 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.


  

не подходит, так как невозможно нажимать кнопки, всю форму воспринимает как Каптион...
как быть? 
PM MAIL   Вверх
TForumUser
Дата 31.7.2007, 00:41 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 110
Регистрация: 7.7.2007

Репутация: 0
Всего: 0
если решать просто влоб, может получиться следующий код:
Код
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;


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

Это сообщение отредактировал(а) TForumUser - 31.7.2007, 00:43
--------------------
Экономте электроэнергию! Выключайте Num Lock!
PM MAIL ICQ   Вверх
Johnny_B
Дата 31.7.2007, 08:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 30.7.2007
Где: Северодонецк

Репутация: нет
Всего: нет
TForumUser, Спасибоsmile отлично работает - только мне надо было для формы покрытой полностью TImage, у неё тоже есть эти события поэтому я переписал их именно для этой картинки, все работает...
Единственное заметел, что перетаскивается с содержимым окна а не рамка, т.е. у меня в системе отключено перетаскивание с содержимым окна... думаю это из-а того что этот система работает только с Каптион.
PM MAIL   Вверх
THandle
Дата 31.7.2007, 19:41 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 50
Всего: 372
Я всегда когда надо использую вот такой код:

Код

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;
PM   Вверх
W1zArD
Дата 31.7.2007, 20:57 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 285
Регистрация: 29.1.2006

Репутация: нет
Всего: 3
на бработчике события OnMouseDown
Код

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


и таскай себе на здоровье
PM   Вверх
Johnny_B
Дата 1.8.2007, 16:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 30.7.2007
Где: Северодонецк

Репутация: нет
Всего: нет
А как таскать форму за Bevel, ведь у него нет событий?
Можно ли сделать что бы при клике на этот Бэвел, система думала что кликают на Форму или Имэйдж???
Спасибо за ответыsmile
PM MAIL   Вверх
bems
Дата 1.8.2007, 16:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 18
Всего: 88
смотри сообщение WM_HCHITTEST


--------------------
Обижено школьников: 8
PM MAIL   Вверх
pseud
Дата 1.8.2007, 16:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
на форме лежит 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 осталась кликабельна
надо копать



--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
bems
Дата 1.8.2007, 16:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 18
Всего: 88
pseud, а зачем PtInRect?

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


--------------------
Обижено школьников: 8
PM MAIL   Вверх
pseud
Дата 1.8.2007, 17:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
Цитата(bems @  1.8.2007,  16:59 Найти цитируемый пост)
а зачем PtInRect?


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


--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
bems
Дата 2.8.2007, 16:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 18
Всего: 88
Цитата(pseud @  1.8.2007,  17:07 Найти цитируемый пост)
попробуй сначала без этого кода 

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

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



--------------------
Обижено школьников: 8
PM MAIL   Вверх
pseud
Дата 3.8.2007, 14:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Экспёрт Тыдыщ
***


Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40
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;


Это сообщение отредактировал(а) pseud - 3.8.2007, 14:27


--------------------
Испытание чужого терпения можно считать успешным, если оно лопнуло...
PM MAIL   Вверх
bems
Дата 3.8.2007, 15:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 18
Всего: 88
я думаю что лучше так
Код

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

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

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


--------------------
Обижено школьников: 8
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0851 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.