Масштабирование картинок?

[McLion]

Всем привет,

хочу масштабировать картинки. В Delphi делал это вот так (используя библиотеку ScaleImage.pas), но получалось только с форматом JPG или BMP а хотелось бы еще прозрачный PNG. Не подскажите как этого достичь?

Код: Выделить всё

procedure TForm2.PictureBitBtnClick(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    srcpic := OpenPictureDialog1.FileName;

    dest := ChangeFileExt(ExtractFilePath(ParamStr(0)), 'temp\temp.jpg');
    ScaleOneImage(srcpic, dest, 200, 200, 92, True);
    srcpic := 'pic-new';

    PictureImage.Picture.LoadFromFile(dest);
  end;
end;


[Mirage]

Например, использовать Vampyre Imaging
Она это вроде как умеет.

[SSerge]

Хорошо сказано, масштабировать...

Вот такое вот тоже в принципе маштабирует. Причем, стандартными средствами. Image1:TImage.
PNG стандартные средства вроде как тоже читают.
Но, подозреваю, что понадобится потом еще и в файл сохранить, не так ли?

Код: Выделить всё

procedure TForm1.LoadAndShowJpeg(fname:string);
Var JPEG:TJPEGImage;
function IsShrinked:string;
begin
  result:='';
  if (Image1.Width<Image1.Picture.Width) or
     (Image1.Height<Image1.Picture.Height) then result:=' (Scaled)';
end;
begin
  FileName.Caption:=fname;
  JPEG:=TJPEGImage.Create;
  try
    JPEG.LoadFromFile(fname);
    Image1.Picture.Assign(JPEG);
    Image1.Height:=Image1.Picture.Height;
    Image1.Width:=Image1.Picture.Width;
    if Image1.Height>(Form1.Height-80) then Image1.Height:=Form1.Height-80;
    if Image1.Width>(Form1.Width-15) then Image1.Width:=Form1.Width-15;
    Label1.Caption:=Label1.Caption+' '+IntToStr(Image1.Picture.Width)+'x'+IntToStr(Image1.Picture.Height)+IsShrinked;
    Image1.Show;
  finally
    JPEG.Free;
  end;
end;                 


[McLion]

Вот такое вот тоже в принципе маштабирует. Причем, стандартными средствами. Image1:TImage.

Проверил только что, но твой код не масштабирует, а просто вырезает часть картинки... хм...

[SSerge]

McLion, аж заинтриговал.
Специально пересобрал, може лет за пять что изменилось... Таки масштабирует, как и раньше.
Image1.Show; - вот это делалось? Если это не сделать, действительно от большой картинки будет уголок.

[McLion]

Image1.Show; конечно делалось, и так режет только часть угла. Еще заметил программа какая-то заторможенная если большое фото взять.

[daesher]

Делал я как-то программу, вот её фрагмент (подчищенный от мелочей)

Код: Выделить всё

procedure TForm1.BtnStartClick(Sender: TObject);
var
  s: String;
  j: TJpegImage;
  j1:TJPEGImage;
  w: Integer;
  h: Integer;
  i: Integer;
  p: TPicture;
  ii: TLazIntfImage;
begin
  //....
    s:='img.jpg'//Имя файла;
    if not FileExistsUTF8(s) then exit;
    j:=TJPEGImage.Create;
    j.LoadFromFile(s);
    if not assigned(j) then Continue;
    w:=round(j.Width/FSEProp.Value);
    h:=round(j.Height/FSEProp.Value);
    j1:=TJPEGImage.Create;
    j1.CompressionQuality:=seQual.Value;
    j1.Width:=w;
    j1.Height:=h;
    j1.Canvas.StretchDraw(Rect(0,0,w,h),j);
    j1.SaveToFile(s);
    j1.Free;
    j.Free;
end;