Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль

Купить рекламу на форуме 15-35 тыс рублей в месяц

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

           Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
           И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - https://clck.ru/fCqwP

Ответ
 
Опции темы Поиск в этой теме
Старый 04.04.2009, 14:44   #1
odi_noki
Пользователь
 
Регистрация: 23.06.2008
Сообщений: 77
По умолчанию Рисовать поверх TImage

Нужно загрузить картинку на форму, чтобы потом пользователь мог ручками "векторизовать" ее - то есть обвести контуры с помощью мыши. Эти контуры удобнее прорисовывать в OnPaint, а картинку загружать 1 раз в TImage, чтобы не мерцала. Так вот - можно ли сделать так, чтобы линии прорисовывались поверх картинки?
odi_noki вне форума Ответить с цитированием
Старый 07.04.2009, 03:33   #2
Баламут
Баламучу слегка...
Участник клуба
 
Аватар для Баламут
 
Регистрация: 01.11.2006
Сообщений: 1,585
По умолчанию

В общем если не вдаваться в подробности, то примерно так:
Код:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    Image1.Canvas.Pixels[x,y] := clWhite;
end;
Но тут нужно иметь ввиду, что такой трюк сработает только если в TImage загружен bmp. С jpg такой номер не пройдет.
Баламут вне форума Ответить с цитированием
Старый 07.04.2009, 04:00   #3
DomiNick
Студент, не
Старожил
 
Аватар для DomiNick
 
Регистрация: 29.01.2009
Сообщений: 2,067
По умолчанию

Цитата:
можно ли сделать так, чтобы линии прорисовывались поверх картинки?
А они так по идее и должны прорисовываться...
Только, как уже отметил Баламут, с jpg-файлами глюк будет...

Может что-то вроде такого..?
Код:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Form1.Image1.Canvas.MoveTo(x,y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Form1.Image1.Canvas.LineTo(x,y);
end;
I am the First of Cyber Evolution...
I am the First to Program your Future...
DomiNick вне форума Ответить с цитированием
Старый 07.04.2009, 07:15   #4
Скандербег
Форумчанин
 
Регистрация: 04.04.2009
Сообщений: 438
По умолчанию

Хотелось бы обратить внимание на некоторые особенности.
В вопросе есть пара ложных утверждений (утверждения не соответствующие действительности).
"Эти контуры удобнее прорисовывать в OnPaint". Событие это генерирует Windows и зависеть от того когда оно придет в программу совсем даже неудобно, тем более, что событие относится к форме, а не к тому компоненту, на котором происходит рисование.
"а картинку загружать 1 раз в TImage, чтобы не мерцала".
Мерцание изображения зависит не только от того сколько раз загружена картинка, а от многих других условий. В частности, если картинка загружена в TImage, то она принадлежит свойству Picture, а не Canvas. От этого прорисовка картинки происходит каждый раз как только над Canvas TImage производятся какие-либо действия, из-за того что наличие таких свойств в TImage как Stretch, Autosize, Transparent заставляет Windows "подстраивать" находящееся в TImage изображение (хотя в этом нет необходимости, но это - Windows). Отсюда и мерцание.
Достаточно поместить картинку на Canvas TImage и мерцание при рисовании "обводки" прекратится.

Одно из решений:
Загрузить изображение на Canvas любого компонента, у которого есть свойство Canvas и события OnMouseDown, OnMouseUp и OnMouseMove (идеально по таким условиям подходит TPaintBox, в примере, правда, используется TImage).
Код:
procedure TForm1.FormCreate(Sender: TObject);
begin
  Im1X := -1;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Im1X := X;
  Im1Y := Y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Im1X := -1;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var R : TRect;
begin
  if Im1X > - 1 then begin
    Image1.Canvas.MoveTo(Im1X, Im1Y);
    Image1.Canvas.LineTo(X, Y);
    Im1X := X;
    Im1Y := Y;
  end;
end;
Im1X и Im1Y : Integer; объявленный в секции private.
Код работающий без мерцания, при условии, что изображение формата bitmap загружено на Canvas TImage, а не в его Picture.
Скандербег вне форума Ответить с цитированием
Старый 07.04.2009, 10:17   #5
Ntlegend
Форумчанин
 
Аватар для Ntlegend
 
Регистрация: 12.05.2007
Сообщений: 373
По умолчанию

дабы издавиться от ненужного мерцания достаточно лишь DoubleBuffered почтавить в True.
Перемен! - требуют наши сердца. Перемен! - требуют наши глаза.
В нашем смехе и в наших слезах, И в пульсации вен:
"Перемен!Мы ждем перемен!"
Ntlegend вне форума Ответить с цитированием
Старый 08.04.2009, 20:02   #6
odi_noki
Пользователь
 
Регистрация: 23.06.2008
Сообщений: 77
По умолчанию

Цитата:
Сообщение от Ntlegend Посмотреть сообщение
дабы издавиться от ненужного мерцания достаточно лишь DoubleBuffered почтавить в True.
Действительно, чтобы избавиться от мерцания, этого более чем достаточно. Что же касается рисования, то на канве компонента TImage я не рисую, потому как он хранит изображение неизменным, а мне нужно будет эти линии потом редактировать с помощью мыши. Проще сохранять данные о расположении линий в каких-то структурах и рисовать их всех в событии OnPaint. Потому я поместила поверх TImage TPaintBox, и рисую в его обработчике OnPaint.

Последний раз редактировалось odi_noki; 08.04.2009 в 20:18.
odi_noki вне форума Ответить с цитированием
Старый 08.04.2009, 22:46   #7
Niarb
Пользователь
 
Регистрация: 23.02.2009
Сообщений: 38
По умолчанию

целесообразней будет иметь два "холста". в одном хранить исходную картинку, а на втором рисовать необходимое. после объединять эти два рисунка и выводить на канву необходимого элемента
...
например:
Код:
procedure TForm1.FormCreate(Sender: TObject);
begin
   bm1:=TBitMap.Create;
   bm2:=TBitMap.Create;
   bm1.LoadFromFile('c:\123.bmp');
   bm2.Width:=bm1.Width;
   bm2.Height:=bm1.Height;
   bm2.Canvas.MoveTo(0,0);
   bm2.Canvas.LineTo(bm2.Width,bm2.Height);
   bm2.Canvas.MoveTo(bm2.Width,0);
   bm2.Canvas.LineTo(0,bm2.Height);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   canvas.CopyMode:=cmSrcCopy;
   canvas.CopyRect(bm1.Canvas.ClipRect,bm1.Canvas,bm1.Canvas.ClipRect);
   canvas.CopyMode:=cmSrcAnd;
   canvas.CopyRect(bm2.Canvas.ClipRect,bm2.Canvas,bm2.Canvas.ClipRect);
end;
...
а елси в дальнейшем тебе необходимо редактировать линиии или то что ты нарисовал... то, действительно, всё придется сохранять в определенную структуру... поищи "создание графического редактора"... есть много статей на эту тему
Чем меньше вы знаете, тем больше я ценен как специалист...
Niarb вне форума Ответить с цитированием
Старый 09.04.2009, 09:25   #8
odi_noki
Пользователь
 
Регистрация: 23.06.2008
Сообщений: 77
По умолчанию

Niarb,
идея ясна, но объясните, в чем ее эффективность по сравнению с прорисовкой на разных компонентах.
И еще - думаю, что нужно сделать и поддержку jpeg тоже...
odi_noki вне форума Ответить с цитированием
Старый 09.04.2009, 22:28   #9
Niarb
Пользователь
 
Регистрация: 23.02.2009
Сообщений: 38
По умолчанию

про эфективность... это в разы быстрее

про поддержку Jpeg

Код:
uses Jpeg;
...
var jp: TJPegImage;
   ...
   jp:=TJPegImage.Create;
   jp.LoadFromFile('c:\123.jpg'); //вместо bm1.LoadFromFile('c:\123.bmp');
   bm1.Assign(jp);
   ...
Чем меньше вы знаете, тем больше я ценен как специалист...
Niarb вне форума Ответить с цитированием
Старый 09.04.2009, 23:05   #10
odi_noki
Пользователь
 
Регистрация: 23.06.2008
Сообщений: 77
По умолчанию

Все хорошо, только вот качество выводимого на экран jpg оставляет желать лучшего. Цвета искажаются, пороги появляются. Может быть, какие-нибудь свойства TJpegImage помогут?
odi_noki вне форума Ответить с цитированием
Ответ

           Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
           Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
рисовать в design-time (Paint) NieL Общие вопросы Delphi 1 15.01.2009 16:55
Рисовать на видео Tmt Общие вопросы Delphi 5 07.02.2007 11:31