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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 22.03.2020, 23:33   #1
LexGam
Пользователь
 
Регистрация: 13.11.2012
Сообщений: 11
По умолчанию Рисование на картинке мышью

Всем привет.

Возникла необходимость рисовать на картинке в компоненте TImage.
У Image1 установлено свойство Stretch и Proportional в true.

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

Код:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Image1.Canvas do begin
   Pen.Color:= clNavy;
   Pen.Width:= 10;
   MoveTo(X, Y);
 end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then Image1.Canvas.LineTo(X, Y);
end;
Проблема возникает тогда, когда в компонент Image1 загружается какая-то картинка, реальный размер которой не равен размеру Image1. Благодаря установленным свойствам она подгоняется под размеры компонента, но при этом линии перестают рисоваться в том месте где находится курсор и той тощиной, которая была установлена. К примеру рисую в центре Image, а на картинке рисуется сбоку.

Я понял, что при загрузке картинки и рисовании на ней нужно посылать не координаты курсора над компонентом Image а координаты как бы курсора над картинкой, но как это сделать, не пойму.

Прошу помощи.
LexGam вне форума Ответить с цитированием
Старый 22.03.2020, 23:57   #2
LexGam
Пользователь
 
Регистрация: 13.11.2012
Сообщений: 11
По умолчанию

В принципе, можно сделать так, но это работает только при Proportional=false. Всётаки как это правильно сделать?

Код:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  XX,YY:double;
begin
  XX:=Image1.Picture.Width/Image1.Width;
  YY:=Image1.Picture.Height/Image1.Height;

  with Image1.Canvas do begin
   Pen.Color:= clNavy;
   Pen.Width:= 10;
   MoveTo(Round(X*XX), Round(Y*YY));
 end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  XX,YY:double;
begin
  XX:=Image1.Picture.Width/Image1.Width;
  YY:=Image1.Picture.Height/Image1.Height;

  if ssLeft in Shift then Image1.Canvas.LineTo(Round(X*XX), Round(Y*YY));

  Label1.Caption:=IntToStr(X);
  Label2.Caption:=IntToStr(Y);
end;
И ещё один вопрос. Если у Image свойство Proportional или AutoSize установлено в True, при рисовании на картинке она начинает жёстко мигать. Как от этого избавиться?

Последний раз редактировалось LexGam; 23.03.2020 в 00:42.
LexGam вне форума Ответить с цитированием
Старый 24.03.2020, 13:30   #3
LexGam
Пользователь
 
Регистрация: 13.11.2012
Сообщений: 11
По умолчанию

Почему нет ответов, неужели никто не сталкивался?
LexGam вне форума Ответить с цитированием
Старый 03.02.2022, 18:30   #4
jester81
Новичок
Джуниор
 
Регистрация: 03.02.2022
Сообщений: 1
По умолчанию

Получилось.
Пользуйтесь.
Код:

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var xx,yy:real;
    a,b :real;
begin
     if Shift = [ssRight] then
          begin
             a:= ((Form1.Image2.Picture.Width)/Form1.Image2.Width);
             b:= ((Form1.Image2.Picture.Height)/Form1.Image2.Height);

            if a<=b then
            begin
                  xx:= x*b;
                  yy:= y*b;
            end else
            begin
                  xx:= x*a;
                  yy:= y*a;

            end;

          Image2.Canvas.Pen.Color:=clRed;
          Image2.Canvas.Pen.Width:=8;
           Image2.Picture.Bitmap.Canvas.MoveTo(Trunc(xx),Trunc(yy));
           Image2.Picture.Bitmap.Canvas.LineTo(Trunc(xx),Trunc(yy));
     end;
end;
jester81 вне форума Ответить с цитированием
Ответ

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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Рисование мышью saylar_06 Общие вопросы Delphi 16 06.06.2014 08:26
Рисование на добавленной *.bmp картинке zverozavr Помощь студентам 0 21.06.2013 03:08
рисование мышью с использованием BitBlt Iosimo Win Api 17 10.04.2012 14:54
Рисование текста средствами php на картинке alexborovnikov PHP 2 14.11.2010 23:39
Как легче всего нарисовать на картинке курсор и использовать инверсивное рисование? TwiX Мультимедиа в Delphi 0 04.03.2010 20:28