Как в Image.Picture.Bitmap загрузить и отмаштабировать bmp jpg pnp картинки?

[Sibedir]

У меня небольшой вопрос: А зачем вы именно в Bitmap грузите? Это не есть гут. Ведь если большой jpg в bmp залить, то он станет действительно большим, а если сразу в Picture, то нет.

Как подогнать под размер Image сразу не скажешь, тут надо с каждым форматом отдельно бороться.

[XerSon]

Сообщение от Sibedir

У меня небольшой вопрос: А зачем вы именно в Bitmap грузите? Это не есть гут. Ведь если большой jpg в bmp залить, то он станет действительно большим, а если сразу в Picture, то нет.

Так как юзаю некий юнит, и в нем есть некие функции по выводу текста, наложению водяного знака, и т д, так вот в нём все организовано для Bitmap

[Аватар]

Я же давал код, только замени последнюю строчку

вместо
Image.Height:=ClientHeight-Image.Top;
вставь
if Image.Height>ClientHeight-Image.Top then Image.Height:=ClientHeight-Image.Top;

[XerSon]

Сообщение от Аватар

Я же давал код, только замени последнюю строчку

вместо
Image.Height:=ClientHeight-Image.Top;
вставь
if Image.Height>ClientHeight-Image.Top then Image.Height:=ClientHeight-Image.Top;

Я его не проигнорировал, но картинка не правильно маштабируется под клиентскую область Image

Привожу тест проект ниже:

[Sibedir]

2 Аватар
Да не, ТС нужно отмасштабировать именно картинку, а не Image (Чтобы память не жрала).

2 XerSon
Вот, кажись нашел

    try
      Pic.LoadFromFile (OpenPictureDialog1.FileName);
      BM := TBitmap.Create;
      BM.Assign (Pic.Graphic);
      Pic.Free;

      k := Max (BM.Height/Image1.Height, BM.Width/Image1.Width);
      r1 := Rect (0, 0, BM.Width, BM.Height);
      r2 := Rect (0, 0, Round (BM.Width / k), Round (BM.Height / k));

      with Image1.Picture.Bitmap do begin
        Width := r2.Right;
        Height := r2.Bottom;
        SetStretchBltMode(Canvas.Handle, HALFTONE);
        StretchBlt(Canvas.Handle, 0, 0, Width, Height, BM.Canvas.Handle, 0, 0, BM.Width, BM.Height, SRCCOPY);
      end;
      BM.Free;

[grafgrial]

думаю это тебе нужно было?

      function FitBestSize(Img: Timage): TImageSizeParams;
      var
        h, w, i, x, y: Integer;
        K, b, a: Double;
      begin
        if Img = nil then
          exit;
        try
          Result := ClearImageSizeParams;
          Img.AutoSize := True;
          Img.AutoSize := False;
          GetImageSizeParams(Img, tsBefore);
          h := img.picture.Height;
          w := img.picture.Width;
          i := 0;
          repeat
            x := img.Parent.clientwidth - w;
            y := img.Parent.clientheight - h;
            i := i + 1;
            k := w / h;
            if y < x then
            begin
              b := y;
              h := h + Round(b);
              a := H * k - W;
              w := w + Round(a);
            end;
            if y >= x then
            begin
              a := x;
              w := w + Round(a);
              b := (w / k) - H;
              h := h + Round(b);
            end;
          until (w < img.Parent.width) or (h < img.Parent.height) or (i >= 2);
          img.Stretch := true;
          img.Width := w;
          img.height := h;
          Result := GetImageSizeParams(Img, tsAfter);
        except
        end;
      end;
//
вызвать так
FitBestSize(Form1.Image1);

[XerSon]

Сообщение от grafgrial

думаю это тебе нужно было?

TImageSizeParams; // [DCC Error] E2003 Undeclared identifier: 'TImageSizeParams'

ругается компилятор!

[Sibedir]

ругается компилятор!

http://www.delphisources.ru/pages/fa...age_funcs.html

Вот переделал. Теперь масштабирует правильно в обе стороны

var
  Pic: TPicture;
  k: Real;
  r1, r2: TRect;
begin
  if OpenPictureDialog.Execute then
  begin
    Pic := TPicture.Create;
    with Image.Picture.Bitmap do
    try
      Pic.LoadFromFile (OpenPictureDialog.FileName);
      Assign (Pic.Graphic);
      Pic.Free;

      k := Max (Height/Image.Height, Width/Image.Width);
      r1 := Rect (0, 0, Width, Height);
      r2 := Rect (0, 0, Round (Width / k), Round (Height / k));

      SetStretchBltMode (Canvas.Handle, HALFTONE);
      if k < 1 then begin
        Width := r2.Right;
        Height := r2.Bottom;
        StretchBlt (Canvas.Handle, 0, 0, r2.Right, r2.Bottom, Canvas.Handle, 0, 0, r1.Right, r1.Bottom, SRCCOPY);
      end
      else begin
        StretchBlt (Canvas.Handle, 0, 0, r2.Right, r2.Bottom, Canvas.Handle, 0, 0, r1.Right, r1.Bottom, SRCCOPY);
        Width := r2.Right;
        Height := r2.Bottom;
      end;
    except
      on E: EInvalidGraphic do
        ShowMessage('Ошибка загрузки');
      on E: EConvertError do
        ShowMessage('Ошибка конвертирования');
    else
      ShowMessage('Прочие ошибки: ' + #13 + Exception(ExceptObject).Message);
    end;
  end;
end;

[XerSon]

Сообщение от Sibedir

http://www.delphisources.ru/pages/fa...age_funcs.html

Не корректно работает функция, расширяя клиентскую область Image

var
  Pic: TPicture;
begin
  if OpenPictureDialog.Execute then
  begin
    Pic := TPicture.Create;
    try
      try
        Pic.LoadFromFile(OpenPictureDialog.FileName);
        Image.Picture.Bitmap.Assign(Pic.Graphic);
        FitBestSize(Image);
        //Image.Repaint;
      finally
        Pic.Free;
      end;
    except
      on E: EInvalidGraphic do
        ShowMessage('Ошибка загрузки');
      on E: EConvertError do
        ShowMessage('Ошибка конвертирования');
    else
      ShowMessage('Прочие ошибки: ' + #13 + Exception(ExceptObject).Message);
    end;
  end;
end;

[Sibedir]

В чем конкретно некорректность?