Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.143.9.115] |
|
Сообщ.
#1
,
|
|
|
Всем привет
Нашел пример в сети, где изменяется один угол панели, правый нижний. var Moving :Boolean; Start, InitialSize :TPoint; implementation {$R *.DFM} procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then begin Moving := True; Start := Point(X,Y); InitialSize := Point(Panel1.Width, Panel1.Height); end end; procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then Panel1.Cursor := crSizeNwSe else Panel1.Cursor := crDefault; if Moving then begin Panel1.Width := InitialSize.X+(X-Start.X); Panel1.Height := InitialSize.Y+(Y-Start.Y); end end; procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Moving := False; end; Мне нужно сделать изменяемыми ещё три угла панели, "поведение как у формы", правда это будет панель. Попробовал экспериментировать с этим кодом, правда что-то не так. Соответствующие файлы прикрепляю к данной теме. unit Unit1; interface uses Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls; type TCornerPos = (LV,PV,PN,LN,None); // L -левый // P -правый // V -верхний // N -нижний // -> угол type TForm1 = class(TForm) Panel1: TPanel; procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; Moving :Boolean; Start, InitialSize :TPoint; PanelCorners:TCornerPos; implementation {$R *.dfm} procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // //(X in [0,Panel1.Width]) and (Y in [0,Panel1.Height]) // //Если точка находится в "левом верхнем углу" if PtInRect(Rect(0, 0, 10, 10), ScreenToClient(Point(X, Y))) then begin PanelCorners:= LV; Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» " end else begin // PanelCorners:= None; //не выбран угол Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка» end; //Если точка находится в "правом нижнем углу" if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then begin PanelCorners:= PN; //выбран угол "правый нижний" Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» " end else begin // PanelCorners:= None; //не выбран угол Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка» end; if Moving and (PanelCorners= PN) then //в движении меняем размеры панели ( «Ширины» , «Высоты» ) begin Panel1.Width := InitialSize.X+(X-Start.X); Panel1.Height := InitialSize.Y+(Y-Start.Y); end; if Moving and (PanelCorners= LV) then begin Panel1.Left:= Panel1.Left+(X-Start.X); panel1.Top:= panel1.Top+(Y-Start.Y); Panel1.Width:= Panel1.Width - (X-Start.X); Panel1.Height:= Panel1.Height - (Y-Start.Y) end; end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if PanelCorners= LV then begin Moving := True; // разрешаем движение Start := Point(X,Y);// даём текущую точку end; if PanelCorners= PN then begin Moving := True; // разрешаем движение Start := Point(X,Y);// даём текущую точку InitialSize := Point(Panel1.Width, Panel1.Height); //даём вторую точку "правый нижний угол" end end; procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Moving := False; //Запрет движения end; end. Прикреплённый файлtest_resize_by_mouse0.rar (186,78 Кбайт, скачиваний: 5) Прикреплённый файлtest_resize_by_mouse1.rar (187,63 Кбайт, скачиваний: 6) |
Сообщ.
#2
,
|
|
|
У вас когда мышь попадает в первый ЛВ-угол, то последующий код проверки на ПН-угол выкидывает успешный результат. Надо всё второе условие перенести в else первого:
//Если точка находится в "левом верхнем углу" if PtInRect(Rect(0, 0, 10, 10), Point(X, Y)) then begin PanelCorners:= LV; Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» " end else begin //Если точка находится в "правом нижнем углу" if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then begin PanelCorners:= PN; //выбран угол "правый нижний" Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» " end else begin // PanelCorners:= None; //не выбран угол Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка» end; end; if Moving and (PanelCorners= PN) then //в движении меняем размеры панели ( «Ширины» , «Высоты» ) |
Сообщ.
#3
,
|
|
|
Спасибо
|
Сообщ.
#4
,
|
|
|
Галочку/кнопку 'вопрос решён' не забывайте ставить.
|
Сообщ.
#5
,
|
|
|
Итак что получилось:
unit Unit1; interface uses Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls; type TCornerPos = (LV,PV,PN,LN,None); // L -левый // P -правый // V -верхний // N -нижний // -> угол type TForm1 = class(TForm) Panel1: TPanel; procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; f:boolean; mX,mY:integer; Moving :Boolean; Start, InitialSize :TPoint; PanelCorners:TCornerPos; implementation {$R *.dfm} procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // //(X in [0,Panel1.Width]) and (Y in [0,Panel1.Height]) //Если точка находится в "левом верхнем углу" if PtInRect(Rect(0, 0, 10, 10), Point(X, Y)) then // and not begin PanelCorners:= LV; //выбран угол левый верхний Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» " end else if PtInRect(Rect(Form1.Panel1.Width-10,0,Form1.Panel1.Width,10 ),Point(X, Y)) then begin PanelCorners:= PV; //выбран угол правый верхний Panel1.Cursor := crSizeNESW //меняем курсор на "изменение размера «тянуть» " end else if PtInRect(Rect(Form1.Panel1.Width-10,Form1.Panel1.Height-10,Form1.Panel1.Width,Form1.Panel1.Height ),Point(X, Y)) then begin PanelCorners:= PN; //выбран угол "правый нижний" Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» " end else if PtInRect(Rect(0,Form1.Panel1.Height-10,10,Form1.Panel1.Height ),Point(X, Y)) then begin PanelCorners:= LN; //выбран угол "левый нижний" Panel1.Cursor := crSizeNESW //меняем курсор на "изменение размера «тянуть» " end else begin PanelCorners:= None; //не выбрано Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка» end; if Moving and (PanelCorners= PN) then //в движении меняем размеры панели ( «Ширины» , «Высоты» ) begin Panel1.Width := InitialSize.X+(X-Start.X); Panel1.Height := InitialSize.Y+(Y-Start.Y); end else if Moving and (PanelCorners= LV) then //в движении меняем положение панели и сохраняем Правый нижний угол "неизменным" begin Panel1.Left:= Panel1.Left+(X-Start.X); panel1.Top:= panel1.Top+(Y-Start.Y); Panel1.Width:= Panel1.Width - (X-Start.X); Panel1.Height:= Panel1.Height - (Y-Start.Y) end; if Moving and (PanelCorners= PV) then begin panel1.Top:= panel1.Top+(Y-Start.Y); Panel1.Width:= Panel1.Width + (X-Start.X); Panel1.Height:= Panel1.Height - (Y-Start.Y)//компенсация движения угла end; if Moving and (PanelCorners= LN) then begin Panel1.Left:= Panel1.Left+(X-Start.X); Panel1.Height:= Panel1.Height + (Y-Start.Y); Panel1.Width:= Panel1.Width - (X-Start.X);//компенсация движения угла end; If f then begin Panel1.Left:=Panel1.Left-(mX-X); Panel1.Top:=Panel1.Top-(mY-Y) end; end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin If Button = mbRight then begin f:=true; mx:=X; my:=Y; end; if PanelCorners= LV then begin Moving := True; // разрешаем движение Start := Point(X,Y);// даём текущую точку end; if PanelCorners= PN then begin Moving := True; // разрешаем движение Start := Point(X,Y);// даём текущую точку InitialSize := Point(Panel1.Width, Panel1.Height); //даём вторую точку "правый нижний угол" end; if PanelCorners= PV then begin Moving := True; // разрешаем движение Start := Point(X,Y);// даём текущую точку end; if PanelCorners= LN then begin Moving := True; // разрешаем движение Start := Point(X,Y);// даём текущую точку end; end; procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Moving := False; //Запрет движения f:=false end; end. Вопрос такого плана: Если при нажатии "двигать" курсор мыши медленно, то работает, но, если немного "быстрее", то курсор "снова становиться стрелкой" и изменение размера прекращается Цитата Хм. Не то чтобы карета превращается в тыкву... |
Сообщ.
#6
,
|
|
|
1. Можно перед самой первой проверкой попадания смотреть: Moving или нет. Если уже идёт движение, то нечего анализировать на попадание в квадратик!
2. Но оказаться может так, что выведут размер за окно и там отпустят мышь... Против этого был изобретён механизм захвата SetCapture и всё такое. |