Показать сообщение отдельно
  #2  
Старый 13.03.2017, 21:20
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,015
Версия 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 соотв модули может потребоваться добавить.
Ответить с цитированием