Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 13.03.2017, 20:17
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию Копирование из TImage в TPaintBox

Здравствуйте!
Столкнулась вот с какой проблемой: загружаю картинку размера 736х600 в TImage, размером 500х500 (Proportional и Stretch - true). Если картинка прямоугольная, то она занимает не весь квадрат TImage, при этом изображение не обрезается и его пропорции сохраняются.
Далее мне нужно скопировать то, что я вижу в TImage, на канву TPaintBox размера 500х500 (т.е. получить рядом две совершенно одинаковые картинки). Так вот, именно этого я сделать не в состоянии - что я ни пробую, результат всё время один и тот же - в PaintBox отображается только часть исходного изображения, размером 500х500.
Как мне заставить программу полностью копировать именно то, что я ВИЖУ на TImage, а не то, что туда впихнули ?
Заранее спасибо всем откликнувшимся!
Ответить с цитированием
  #2  
Старый 13.03.2017, 21:20
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

1. Можно попробовать попросить TImage отрисоваться на канве PaintBox'а.
2. Написать математику переразмеривания и StretchDraw. Сама математика достаточно простая:
- если ширина картинки меньше доступной ширины и высота картинки меньше доступной высоты, то нам ничего переразмеривать не надо.
- иначе. Считаем отношение Image/PaintBox для ширин и высот. Берем наименьшее значение. Новая ширина - Image.Width*K, новая высота - Image.Height*K (тут не размеры самого контрола, а реальные размеры картинки). Ну и Top & Left вычисляются как:
Код:
Top := (Paintbox.Height - NewHeight) div 2;
Left := (Paintbox.Width - NewWidth) div 2;
Ну а дальше все это скармливаем в StretchDraw.

Вычисление размеров:
Код:
function GetImageDrawRect(ImageWidth, ImageHeight, CanvasWidth, CanvasHeight : Integer) : TRect;
var
  K : Double;
  DrawWidth, DrawHeight : Integer;
begin
  If (ImageWidth < CanvasWidth) And (ImageHeight < CanvasHeight) 
    Then K := 1
    Else K := Min(CanvasWidth / ImageWidth, CanvasHeight / ImageHeight);
    
  DrawWidth := Round(ImageWidth * K);
  DrawHeight := Round(ImageHeight * K);
  
  Result.Left := (CanvasWidth - DrawWidth) div 2;
  Result.Right := Result.Left + DrawWidth;
  Result.Top := (CanvasHeight - DrawHeight) div 2;
  Result.Bottom := Result.Top + DrawHeight;
end;

Пример использования:
Код:
var
  R : TRect;
begin
  If Assigned(Image1.Picture.Graphics) Then
    begin
      R := GetImageDrawRect(Image1.Picture.Graphics.Width,Image1.Picture.Graphics.Height,PaintBox1.Width,PaintBox1.Height);
      PaintBox1.Canvas.StretchDraw(R,Image1.Picture.Graphics);
    end;
end;

ЗЫ. Не проверял, мог где-то и опечататься или что забыть... ну и в uses соотв модули может потребоваться добавить.

Последний раз редактировалось lmikle, 13.03.2017 в 21:34.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
vikk (14.03.2017)
  #3  
Старый 14.03.2017, 11:50
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию

Imikle, сразу низко поклонюсь Вам и пойду проверять-разбираться. С благодарностью.
Ответить с цитированием
  #4  
Старый 14.03.2017, 12:20
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию

Из очепяток: Graphics нужно заменить на Graphic
Для картинок, бОльших по размеру, чем размер компонента, сработало в смысле размера и пропорций(ещё передвину по канве в левый верхний угол, будет то, что надо), для меньших - подрехтую. Когда сделаю, выложу сюда - вдруг кому пригодится. Ещё раз спасибо за содействие!
Ответить с цитированием
  #5  
Старый 14.03.2017, 12:41
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию

Вот как в итоге изменилась функция получения прямоугольника рисования картинки:

Код:
function GetImageDrawRect(ImageWidth, ImageHeight, CanvasWidth, CanvasHeight : Integer) : TRect;
var
  K : Double;
  DrawWidth, DrawHeight : Integer;
begin
  K := Min(CanvasWidth / ImageWidth, CanvasHeight / ImageHeight); //коэффициент сжатия/растяжения
  DrawWidth := Round(ImageWidth * K);
  DrawHeight := Round(ImageHeight * K);

  Result.Left := 0;
  Result.Right := Result.Left + DrawWidth;
  Result.Top := 0;
  Result.Bottom := Result.Top + DrawHeight;
end;

Помещает картинку любого размера в левый верхний угол, растягивая/сжимая максимум из её длины и ширины до размеров квадрата, в котором рисуем. Проверено, мин нет
Ответить с цитированием
  #6  
Старый 14.03.2017, 12:42
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

Чтобы максимально облегчить себе жизнь нужно смотреть кто является провайдером для Graphic. Мне повезло - у меня DevExpress:

Код:
  if Image1.Picture.Graphic is TdxSmartImage then
    TdxSmartImage(Image1.Picture.Graphic).Scale(Image1.ClientWidth, Image1.Picture.Width);
  PaintBox1.Canvas.Draw(0, 0, Image1.Picture.Graphic);
И все! Естественно проверено.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Этот пользователь сказал Спасибо NumLock за это полезное сообщение:
vikk (14.03.2017)
  #7  
Старый 14.03.2017, 12:44
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию

Вот как в итоге изменилась функция получения прямоугольника рисования картинки:

Код:
function GetImageDrawRect(ImageWidth, ImageHeight, CanvasWidth, CanvasHeight : Integer) : TRect;
var
  K : Double;
  DrawWidth, DrawHeight : Integer;
begin
  K := Min(CanvasWidth / ImageWidth, CanvasHeight / ImageHeight); //коэффициент сжатия/растяжения
  DrawWidth := Round(ImageWidth * K);
  DrawHeight := Round(ImageHeight * K);

  Result.Left := 0;
  Result.Right := Result.Left + DrawWidth;
  Result.Top := 0;
  Result.Bottom := Result.Top + DrawHeight;
end;

Помещает картинку любого размера в левый верхний угол канвы компонента(у меня это PaintBox), растягивая/сжимая максимум из её длины и ширины до размеров компонента, в котором рисуем. Проверено, мин нет
Ответить с цитированием
  #8  
Старый 14.03.2017, 12:52
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию

Цитата:
Сообщение от NumLock
Чтобы максимально облегчить себе жизнь нужно смотреть кто является провайдером для Graphic. Мне повезло - у меня DevExpress:

Код:
  if Image1.Picture.Graphic is TdxSmartImage then
    TdxSmartImage(Image1.Picture.Graphic).Scale(Image1.ClientWidth, Image1.Picture.Width);
  PaintBox1.Canvas.Draw(0, 0, Image1.Picture.Graphic);
И все! Естественно проверено.

Оно, конечно, верно (наверное). Но только для того, у кого установлен TdxSmartImage. В DevExpress, который установлен у меня, такого не наблюдается Поэтому Вам тоже большое спасибо (и кусочек халвы) за отклик, но беру его на вооружение для будущих свершений, а пока использую тот, что любезно предоставил Imikle.
Ответить с цитированием
  #9  
Старый 14.03.2017, 12:53
vikk vikk вне форума
Начинающий
 
Регистрация: 01.10.2010
Сообщения: 132
Репутация: 10
По умолчанию

Тему можно закрыть.
Ответить с цитированием
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 22:41.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter