IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Масштабирование компонентов
сообщение
Сообщение #1


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Привет всем.

На форме имеются созданные вручную TImage'и. Каждому я вручную присвоил необходимые события. Собственно, нужно сделать возможность изменения размеров компонента, чтобы при подводе курсора к границе (но не к углу!) имаджа курсор менялся на обоюдоострую стрелочку, и можно было растягивать компонент. Вот что получилось:

Procedure TLine_Road.onMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xmouse:=x;ymouse:=y;
down:=true;
end;

Procedure TLine_Road.onMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
down:=false;
end;

Procedure TLine_Road.OnMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var m:TImage;
begin
m:=(sender as TImage);
if (x>m.left) and (x<m.left+m.width) and ((y=m.top) or (y=m.top+m.height)) then
begin
m.Cursor:=crSizeNS;
if down then begin
if y=m.top then begin
m.height:=m.height+(y-m.top);
m.Top:=y-1;
end;
end;
end else
if down then
begin
m.Cursor:=crDefault;
m.left:=m.left+(x-xmouse);
m.top:=m.top+(y-ymouse);
end;
end;


В процедуре OnMove я уже сделал перетаскивание компонента, работает. А вот чуть выше, в этой процедуре - попытка сделать ресайз, но там пробно только для верхней границы. Какое-то странное поведение: имадж создаётся на панели с координатами (1,1), уже с картинкой. Если его не двигать, то при подводе курсора к верхней границе, он, курсор, меняет, как и должно быть, форму, но ничего не меняет. А если имадж подвинуть ниже, то и вовсе курсор не меняется. Подвинули на исходную - меняется. Чертовщина, хотя сравнивал координаты - вроде правильно всё.

Сообщение отредактировано: Unconnected -


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






OnMove - это что? Какое сообщение обрабатывается?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


OnMouseMove, и с остальными так же.

И ещё, у имаджей свойства autosize и stretch стоят в true.

Сообщение отредактировано: Unconnected -


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






А собственно, с чего ты решил, что TImage.OnMouseMove дает тебе X, Y, как-то относящиеся к внешним компонентам? X, Y как раз изменяются 1 .. m.Width, 1 .. m.Height соответственно. Если мыша вне контрола - событие просто не наступает. Это по поводу твоего удивления
Цитата
А если имадж подвинуть ниже, то и вовсе курсор не меняется.
Теперь понятно, почему?

Я бы решал задачу вот так:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xmouse:=x;ymouse:=y;
down:=true;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
type
TMyStatus = (stMoving, stResizing);
var
m:TImage;
myStatus: TMyStatus;
begin
m:=(sender as TImage);

if (x >= 1) and (x <= m.Width) and ((y = 1) or (y = m.Height-1)) then
begin
m.Cursor:=crSizeNS;
myStatus := stResizing;
end
else
if PtInRect(Rect(2, 2, m.Width - 2, m.Height - 2), Point(X, Y)) then
begin
m.Cursor := crHandPoint; myStatus := stMoving;
end;

if down then
case myStatus of
stMoving:
begin
m.left:=m.left+(x-xmouse);
m.top:=m.top+(y-ymouse);
end;
stResizing:
begin
// Тут твои действия по ресайзу изображения...
end;
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
down := false;
end;
(для большей правдоподобности курсор устанавливается в Hand, когда можно перетаскивать изображение)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Код интересный, спасибо, повожусь с ним smile.gif


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Во дела. Ресайз не работал, пока я не отключил AutoSize! Но, когда я отключил AutoSize, то картинка сразу потолстела и стала некрасивой (у меня ещё strength включён). Можно ли это как-то обойти, не запрашивая размеры файла-картинки и не забивая их вручную в имадж при его создании?


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Proportional в True устанавливать не пробовал? smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


В итоге я сделал массивом из размеров, они мне ещё понадобятся.. Теперь с именно ресайзом косяк:

Procedure TLine_Road.OnMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
type
TMyStatus = (stMoving, stResizing);
var
m:TImage;
myStatus: TMyStatus;
begin
m:=(sender as TImage);
if (x > 1) and (x < m.Width) and ((y = 1) or (y = m.Height-1)) then
begin
m.Cursor:=crSizeNS;
myStatus:=stResizing;
end
else
if PtInRect(Rect(2,2,m.Width-2,m.Height-2),Point(X,Y)) then
begin
m.Cursor:=crHandPoint;
myStatus:=stMoving;
end;
if down then
case myStatus of
stMoving:
begin
m.left:=m.left+(x-xmouse);
m.top:=m.top+(y-ymouse);
end;
stResizing:
begin
m.height:=m.Height+1; //<-
end;
end;
end;


Сделал экспериментально только для растягивания вниз. Так-то механизм я понял, но вот этот код работает только когда растягиваешь медленно-медленно...


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Хочешь, покажу тебе "уличную магию"? smile.gif

Выносишь тип и переменную за пределы обработчика события, и чуть-чуть перегруппируешь операторы в самом обработчике:
type
TMyStatus = (stMoving, stResizing);
var
myStatus: TMyStatus;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
m: timage;
begin
m := sender as TImage;
if not down then begin

if (x >= 1) and (x <= m.Width) and ((y = 1) or (y = m.Height - 1)) then
begin
m.Cursor:=crSizeNS;
myStatus := stResizing;
end
else
if PtInRect(Rect(2, 2, m.Width - 2, m.Height - 2), Point(X, Y)) then
begin
m.Cursor := crHandPoint; myStatus := stMoving;
end;

end
else begin

case myStatus of
stMoving:
begin
m.left:=m.left+(x-xmouse);
m.top:=m.top+(y-ymouse);
end;
stResizing:
begin
m.height:=m.Height+1; //<-
end;
end;

end;
end;
, и теперь оно работает (только на увеличение, однако; у тебя же независимо от направления движения мыши высота изображения увеличивается) при любой скорости перемещения мыши.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Уже лучше стало, уличная магия заключалась в " if not down then begin" (помимо глобализации типа и переменной)? smile.gif

Только вот со скоростью мышки всё равно не так получается. Если веду со средней скоростью - нормально, а чуть быстрее - курсор улетает с нижней границы. В принципе, ресайз и так состоится, но некрасиво как-то) небольшое видео прикрепил.


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Попробуй сделать так, чтоб мыша вылезла за пределы контрола вот с таким Case-ом:
    case myStatus of
stMoving:
begin
m.left:=m.left+(x-xmouse);
m.top:=m.top+(y-ymouse);
end;
stResizing:
begin
m.height:=m.Height + (y-ymouse); // <- раз
ymouse := y; // <-- два
end;
end;
smile.gif Удачи тебе ...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


вот такое тож работает, правда курсоры не делал

x1,y1,s:integer;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
x1:=x; y1:=y;
move:=true;
if x<5 then s:=1 else
if y<5 then s:=2 else
if x>(image1.Width-5) then s:=3;
if y>(image1.height-5)then s:=4;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=false;
s:=0;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if move then
case s of
1:begin
image1.Left:=image1.Left-(x1-x);
image1.width:=image1.width+(x1-x);
end;
2:begin
image1.top:=image1.top-(y1-y);
image1.height:=image1.height+(y1-y);
end;
3:begin
x1:=image1.Width;
image1.width:=image1.width-(x1-x);
end;
4:begin
y1:=image1.height;
image1.height:=image1.height-(y1-y);
end;
else
image1.Left:=image1.Left-(x1-x);
image1.top :=image1.top -(y1-y);
end;
end;



--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






Цитата
вот такое тож работает
Работать и работать правильно - это разные вещи... Твой код - работает...

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

Добавлено через 4 мин.
P.S. Кстати, а вот это:
Цитата
  else
image1.Left:=image1.Left-(x1-x);
image1.top :=image1.top -(y1-y);
к чему относится? Это был первый вопрос на засыпку. А второй - как ты думаешь, когда отработает изменение Image1.Top? При каких условиях?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Профи
****

Группа: Пользователи
Сообщений: 865
Пол: Мужской
Реальное имя: Вячеслав

Репутация: -  20  +


Набрал код Rian'а (ренейм? smile.gif ) и скачков не заметил. Правда, морагние есть небольшое smile.gif
Цитата
к чему относится
Методом трассировки выяснил, что этот код отвечает за перемещение имеджа при нажатии мыши в области, не включающую в себя рамку smile.gif
PtInRect(Rect(2, 2,  m.Width - 2, m.Height - 2), Point(X, Y))
Это "point in rect" ? т.е. область не влючая рамку (2 пикселя) ?

Добавлено через 2 мин.
Цитата
Хочешь, покажу тебе "уличную магию"?
Не-не-не, только не это, Дэвид Блэйн lol.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


Цитата(Client @ 24.02.2010 15:43) *

Набрал код Rian'а (ренейм? smile.gif ) и скачков не заметил. Правда, морагние есть небольшое smile.gif

моргание убирается через
doublebufferd:=true;

yes2.gif ренейм) не может же первый придуманный ник быть вечным....

Добавлено через 12 мин.
Цитата(volvo @ 24.02.2010 14:06) *

Работать и работать правильно - это разные вещи... Твой код - работает...

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

Добавлено через 4 мин.
P.S. Кстати, а вот это:
к чему относится? Это был первый вопрос на засыпку. А второй - как ты думаешь, когда отработает изменение Image1.Top? При каких условиях?

убегает с космической скоростью?... не заметил....

последняя проверка перемещает всю картинку

image1.top отработает если y<5 и... есть флаг нажатия

ЗЫ. я уже боюсь чего это volvo опять загадает blink.gif


Прикрепленные файлы
Прикрепленный файл  resize.rar ( 220.31 килобайт ) Кол-во скачиваний: 93


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






Цитата
скачков не заметил
Я про скачки не говорил я говорил про непропорционально высокую по сравнению со скоростью перемещения мыши скорость:
Прикрепленный файл  resize.zip ( 712.12 килобайт ) Кол-во скачиваний: 214


Видео в формате XViD, если что... Это что, мне только кажется, или так и должно быть? Тогда я больше в эту тему не захожу, вы скажите, если я тут мешаю ...

Добавлено через 1 мин.
Цитата
последняя проверка перемещает всю картинку
Последняя проверка записана некорректно - Else относится только к ПРЕДпоследней проверке, если ты не заметил. Операторных скобок не было замечено в твоем коде. Или это опять я не прав, а у тебя все шоколадно?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


Цитата(volvo @ 24.02.2010 17:02) *

Это что, мне только кажется, или так и должно быть? Тогда я больше в эту тему не захожу, вы скажите, если я тут мешаю ...

не не не ни в коем случае!

может в свойствах картинки что-то другое?
но у меня код таскает, все как положено: все границы и вся картинка
Else относится к case а что не так?

Сообщение отредактировано: Rian -


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Профи
****

Группа: Пользователи
Сообщений: 865
Пол: Мужской
Реальное имя: Вячеслав

Репутация: -  20  +


Цитата
если я тут мешаю
Ну с чего такие мысли? тебе тут все рады

Сообщение отредактировано: Client -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Если кому интересно, вот немного модифицированный код volvo, немного расширена область "рамки" для ресайза, и разделение на ресайз вверх и вниз (право-лево мне не надо):

TMyStatus = (stMoving, stResizing);
var
myStatus: TMyStatus;
up,downer:boolean;

Procedure TLine_Road.OnMouseLeave(Sender: TObject);
begin
down:=false;downer:=false;up:=false;
(sender as TImage).Cursor:=crDefault;
end;

Procedure TLine_Road.onMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xmouse:=x;ymouse:=y;
down:=true;
end;

Procedure TLine_Road.onMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
down:=false;
end;

procedure TLine_Road.onMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
m: timage;
buf:integer;
begin
m:=sender as TImage;
if not down then begin
if (x>=1) and (x <= m.Width) and ((y <= 3) or (y >= m.Height - 3)) then
begin
m.Cursor:=crSizeNS;
myStatus := stResizing;
if y<=3 then begin
up:=true;
downer:=false;
end else if (y>=m.height-3) then begin
up:=false;
downer:=true;
end;
end
else
if PtInRect(Rect(4, 4, m.Width -4, m.Height - 4), Point(X, Y)) then
begin
m.Cursor := crHandPoint; myStatus := stMoving;
end;
end
else
begin
case myStatus of
stMoving:
begin
m.left:=m.left+(x-xmouse);
m.top:=m.top+(y-ymouse);
end;
stResizing:
begin
buf:=m.top;
if downer then begin
m.height:=m.Height+(y-ymouse);
ymouse:=y;
end else begin
m.top:=m.top-(ymouse-y);
m.height:=m.height+(ymouse-y);
end;
end;
end;
end;
end;
sorry за мой английский)

Сообщение отредактировано: Unconnected -


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Гость






да кстати а чем видео делаете?
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.11.2020 2:16
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name