|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Копирование из TImage в TPaintBox
Здравствуйте!
Столкнулась вот с какой проблемой: загружаю картинку размера 736х600 в TImage, размером 500х500 (Proportional и Stretch - true). Если картинка прямоугольная, то она занимает не весь квадрат TImage, при этом изображение не обрезается и его пропорции сохраняются. Далее мне нужно скопировать то, что я вижу в TImage, на канву TPaintBox размера 500х500 (т.е. получить рядом две совершенно одинаковые картинки). Так вот, именно этого я сделать не в состоянии - что я ни пробую, результат всё время один и тот же - в PaintBox отображается только часть исходного изображения, размером 500х500. Как мне заставить программу полностью копировать именно то, что я ВИЖУ на TImage, а не то, что туда впихнули ? Заранее спасибо всем откликнувшимся! |
#2
|
|||
|
|||
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; Вычисление размеров: Код:
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
|
|||
|
|||
Imikle, сразу низко поклонюсь Вам и пойду проверять-разбираться. С благодарностью.
|
#4
|
|||
|
|||
Из очепяток: Graphics нужно заменить на Graphic
Для картинок, бОльших по размеру, чем размер компонента, сработало в смысле размера и пропорций(ещё передвину по канве в левый верхний угол, будет то, что надо), для меньших - подрехтую. Когда сделаю, выложу сюда - вдруг кому пригодится. Ещё раз спасибо за содействие! |
#5
|
|||
|
|||
Вот как в итоге изменилась функция получения прямоугольника рисования картинки:
Код:
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
|
||||
|
||||
Чтобы максимально облегчить себе жизнь нужно смотреть кто является провайдером для 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
|
|||
|
|||
Вот как в итоге изменилась функция получения прямоугольника рисования картинки:
Код:
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
|
|||
|
|||
Цитата:
Оно, конечно, верно (наверное). Но только для того, у кого установлен TdxSmartImage. В DevExpress, который установлен у меня, такого не наблюдается Поэтому Вам тоже большое спасибо (и кусочек халвы) за отклик, но беру его на вооружение для будущих свершений, а пока использую тот, что любезно предоставил Imikle. |
#9
|
|||
|
|||
Тему можно закрыть.
|