Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2008.06.22;
Скачать: CL | DM;

Вниз

scale JPEG как в PhotoShop   Найти похожие ветки 

 
arreke ©   (2008-05-25 12:36) [0]

Такая процедура не даёт нужного результата,


procedure TForm1.Button1Click(Sender: TObject);
var
 bmp: TBItmap;
 jpg: TJpegImage;
 scale: Double;
begin
 if opendialog1.execute then begin
   jpg:= TJpegImage.Create;
   try
     jpg.Loadfromfile( opendialog1.filename );
     if jpg.Height > jpg.Width then
       scale := 50 / jpg.Height
     else
       scale := 50 / jpg.Width;
       bmp:= Tbitmap.Create;
       try
         {Create thumbnail bitmap, keep pictures aspect ratio}
         bmp.Width := Round( jpg.Width * scale );
         bmp.Height:= Round( jpg.Height * scale );
         bmp.Canvas.StretchDraw( bmp.Canvas.Cliprect, jpg );
         {Draw thumbnail as control}
         Self.Canvas.Draw( 100, 10, bmp );
         {Convert back to JPEG and save to file}
         jpg.Assign( bmp );
         jpg.SaveToFile(ChangeFileext( opendialog1.filename, "_thumb.JPG" ));
       finally
         bmp.free;
       end;
     finally
       jpg.free;
   end;
end;


Рисунок уменьшается, но размер больше и качество намного хуже чем "Save for web" в Photoshop.
Как это исправить? Очень на вас надеюсь, вы уже ни раз меня выручали, надеюсь на вашу помошь и в этот раз.


 
TIF ©   (2008-05-25 15:30) [1]

Удалено модератором


 
Умище   (2008-05-25 15:44) [2]

procedure StretchJPG(const FilePathSrc,FilePathDest: String; aW,aH: Integer);
var
  Src, Dest: TBitmap;
  j: TJPEGImage;
  Degree: Double;
begin
  Src:= TBitmap.Create;
  Dest:= TBitmap.Create;
  j:= TJPEGImage.Create;

  try
    j.LoadFromFile(FilePathSrc);
    Src.Assign(j);
    Dest.Assign(Src);
    if (Dest.Width<=aW) and (Dest.Height<=aH) then Exit;
    Degree := Src.Height/aH;
    if Trunc(Src.Width/Degree)>aW then Degree := Src.Width/aW;
 
    Dest.Width:= Trunc(Src.Width/Degree);
    Dest.Height:= Trunc(Src.Height/Degree);
 
    SetStretchBltMode(Dest.Canvas.Handle, HALFTONE);
    StretchBlt(Dest.Canvas.Handle, 0, 0, Dest.Width, Dest.Height,
               Src.Canvas.Handle, 0, 0,  Src.Width, Src.Height, SRCCOPY);
    j.Assign(Dest);
    j.SaveToFile(FilePathDest);
  finally
    Src.Free;
    Dest.Free;
    j.Free;
  end;
end;


 
arreke ©   (2008-05-25 17:13) [3]

Спасибо, то что нужно.
MegaRespect.



Страницы: 1 вся ветка

Текущий архив: 2008.06.22;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.017 c
2-1211991044
rena
2008-05-28 20:10
2008.06.22
выход из процедуры


1-1194606499
misha_gr
2007-11-09 14:08
2008.06.22
ParamStr()


3-1200551154
saNat
2008-01-17 09:25
2008.06.22
Ошибка в запросе с парметром: DBQuery: Field Table_a2 not found


15-1210238925
@!!ex
2008-05-08 13:28
2008.06.22
Кто не прав.


2-1211959348
DmT
2008-05-28 11:22
2008.06.22
Терминал на канве