Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

как имитировать ресайз формы без клиентской области? [D7, WinXP]


maxsvt ©   (04.06.14 23:27

Есть форма с borderstyle bsnone. Хочу имитировать поведение неклиентской части формы. Конкретно проблема с изменением размера (то, что все мы делаем, когда меняем размер окна дергая за боковую полоску). Сделал просто и в лоб. На форме есть панель с align = alleft. На ней отрисовается скин (та самая полоска вместо виндовой). Если MouseDown на панели, запоминаю координаты нажатия. По MouseMove вычисляю delta. Затем смещаю окно (Left = Left+delta), затем уменьшаю размер на Width = Width-delta. Работает, но все это тормозит и моргает. И вообще, думаю это не правильная реализация и через одно место. Вот как полностью имитировать, что бы плавно и не мерцало?


Юрий Зотов ©   (04.06.14 23:39[1]

См. сообщение WM_HITTEST. Надо вернуть в его обработчике желаемый результат, а Windows сама сделает все остальное. И не надо ни панели, ни других извратов.


Юрий Зотов ©   (04.06.14 23:41[2]

Сорри, WM_NCHITTEST


Германн ©   (05.06.14 02:25[3]


> На ней отрисовается скин

Вот про это :) желательно подробнее. Что за скин и кто его отрисовывает?


Лакримакристи   (05.06.14 12:08[4]

Ну во-первых первое что проверять при мерцании в проекте VCL - чтоб стояло DoubleBuffered:=true;
Во вторых при своей отрисовке ни в коем случае не менять дефолтный align !
В принципе можно делать и как вы начали, но нужно чётко понимать как обрабатываются события окна, в каком порядке.

Или показывайте как у вас сделано, починим, или переделывайте так:

...
private { Private declarations }
procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
...

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


maxsvt ©   (05.06.14 20:09[5]

>См. сообщение WM_HITTEST. Надо вернуть в его обработчике желаемый >результат, а Windows сама сделает все остальное. И не надо ни панели, ни >других извратов
На панели у меня картинка, на нее скин накладывается. Панель с align = alLeft. Про WM_HITTEST как-то не подумал, как его в этом случае использовать. Спасибо. Кое-что попробовал, см. ниже
>Вот про это :) желательно подробнее. Что за скин и кто его отрисовывает
Я задачу максимально упростил. Сделал новый проект для теста. Со скинами все ok, просто 4 панели с разными align, на них картинки. Все нормально рисуется
>Ну во-первых первое что проверять при мерцании в проекте VCL - чтоб стояло
>DoubleBuffered:=true
Читал об этом. Включал - с DoubleBuffered все гораздо хуже. Даже у обычных окон. Отключил
>Во вторых при своей отрисовке ни в коем случае не менять дефолтный align
Извините, не совсем понял. Почему? Нормально отрисовывается
>Или показывайте как у вас сделано, починим, или переделывайте так
Понял, спасибо. Давайте абстрагируемся от картинок итд. Сделал новый проект. Форма с borderstyle bsnone. На ней панель. У нее align = alLeft (или без align, не важно в данном случае). Хочется хватать за панель и делать то, что делала боковая полоса в окне, до установки bsnone. Если на форме просто обрабатывать WM_NCHITTEST и ставить результат HtLeft, то получается изменять размер окна как надо за любую часть окна. Но не на самой панели. Пробую такой код, не работает


type
 TForm1 = class(TForm)
   Panel1: TPanel;
   procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
   function MouseOverPanel: boolean;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.MouseOverPanel: boolean;
var
 temp: TPoint;
begin
 Result := False;
 GetCursorPos(temp);
 temp := ScreenToClient(temp);
 if PtInRect(Panel1.ClientRect,temp) then
   Result := True;
end;

procedure TForm1.WMNCHITTEST(var Msg: TMessage);
begin
 if not MouseOverPanel then
   inherited
 else
   Msg.Result := HtLeft;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 SendMessage(Handle,WM_NCHITTEST,0,MakeLong(X,Y));
end;


Чувствую, что где-то жестко торможу :)


maxsvt ©   (05.06.14 20:24[6]

Получилось! Забыл, что когда-то отказался от WM_NCHITTEST по ряду причин

Так работает как надо. Все оказалось елементарно


type
 TForm1 = class(TForm)
   Panel1: TPanel;
   procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCHITTEST(var Msg: TMessage);
begin
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 ReleaseCapture;
 SendMessage(Handle,WM_SYSCOMMAND,$F001,0);
end


maxsvt ©   (05.06.14 23:02[7]

Блин, поторопился. Форма ресайзится, но теперь mouseclick не работает


maxsvt ©   (05.06.14 23:30[8]

"теперь mouseclick не работает"
на панели. блин, как не удобно, что нельзя редактировать сообщение


Юрий Зотов ©   (06.06.14 01:30[9]

> Если на форме просто обрабатывать WM_NCHITTEST
> и ставить результат HtLeft


Если мы хотим точно повторить стандартный ресайз формы, то результат надо ставить в зависимости от позиции курсора, а не всегда HTLEFT.

> то получается изменять размер окна как надо за любую часть окна.
> Но не на самой панели


Естественно, ведь когда мышь над панелью, то сообщение получает панель, а не форма.

============================

И о главном: зачем вообще нужна панель? Если только для того, чтобы на ней что-то там рисовать, то почему бы не рисовать на самой форме? Тогда исчезает и панель, и связанные с нею проблемы.


maxsvt ©   (06.06.14 19:26[10]

>Если мы хотим точно повторить стандартный ресайз формы, то результат надо
>ставить в зависимости от позиции курсора, а не всегда HTLEFT
Понимаю :) Я просто говорил только об эмуляции одной левой полоски
>И о главном: зачем вообще нужна панель
Да просто удобно пользоваться дефолтными алигнами. Особенно когда на форме куча вложенных и смежных панелей с разными align. Хотя может и правда плохой стиль
>почему бы не рисовать на самой форме
Ну есть если панель с align alclient, есть с altop итд. Можно конечно все руками пересчитывать, но удобно же, когда само)


maxsvt ©   (06.06.14 20:11[11]

Поборол. Фишка в том, что бы капчу мыши делать не сразу, а по небольшому смещению. Тогда и форма ресайзится и клик проходит. Изврат :) Сейчас все как надо

type
 TForm1 = class(TForm)
   Panel1: TPanel;
   procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormCreate(Sender: TObject);
   procedure Panel1Click(Sender: TObject);
 private
   FLeftResize: boolean;
   FDownPos: TPoint;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 FLeftResize := True;
 GetCursorPos(FDownPos);
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var
 temp: TPoint;
begin
 if not FLeftResize then exit;
 GetCursorPos(temp);
 if abs(temp.X-FDownPos.X) > 4 then
 begin
   try
     FDownPos.X := temp.X;
     ReleaseCapture;
     SendMessage(Handle,WM_SYSCOMMAND,$F001,0);
   finally
     FLeftResize := False;
   end;
 end;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 FLeftResize := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FLeftResize := False;
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
 caption := 'Ya';
end;

end


Юрий Зотов ©   (07.06.14 15:45[12]

> maxsvt ©   (06.06.14 19:26) [10]

На пустую форму с bsNone кладем панель. Убираем у нее все бордюры. Ставим ей Align=alRight и Left=4 - панель прижимаетеся вправо, а слева остаются 4 пикселя формы (а не панели!!!). Теперь ставим панели Align=alNone и Anchors по всем 4-м сторонам. Все остальные панели и контролы кладем уже не на форму, а на эту панель, с любыми привязками. В итоге получаем, что все ресайзится автоматически, а слева всегда остаются 4 пикселя формы (а не панели!!!).

У формы пишем обработчики WM_NCHITTEST и OnPaint. В OnPaint рисуем на этих 4-х пикселях (формы!!!) все, что хотим. В WM_NCHITTEST: если курсор на этих 4-х пикселях, то возвращаем HTLEFT, иначе HTCLIENT.

Вот, ИМХО, и вся проблема. Причем с минимальным кодом, без ручных резайзов и без использования недокументированных фич.


maxsvt ©   (10.06.14 23:33[13]

Юрий, спасибо за идею. Так будет тоже работать. onclick на той части формы не будет работать, но решить можно по аналогии с тем, как я выше написал. Только не понятно, как с курсором бороться, у меня свой, а вылезет стандартный на резайзе неклиентской части


Alexey Kryukov   (30.06.18 21:34[14]

Ну вы ребята тут нагородили городушек. Все намного проще:


type
 TForm1 = class(TForm)
 ...
 private
   FOldPanelWndProc: TWndMethod;
 protected
   procedure PanelWndProc(var Msg:TMessage);
...

procedure TForm1.FormCreate(Sender: TObject);
begin
 FOldPanelWndProc:=Panel1.WindowProc;
 Panel1.WindowProc := PanelWndProc;
end;
...
procedure TForm1.PanelWndProc(var Msg: TMessage);
begin
 FOldPanelWndProc(Msg);
 if Msg.Msg=WM_NCHitTest then
   Msg.Result := HTTRANSPARENT;
end;


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо