BMP / JPG 檔縮放到你指定的大小及品質的 JPG 格式

這些是我後來改過的，檔頭部分我也是隨便改改，反正能用就好了。
另外我本來也是覺得不用再Assign，但是就是在某些情況會發生錯誤，如果我沒有遇到這問題，我不可能隨便回應的。因為正在趕東西，結果發覺Assign之後就解決了，所以也沒去探討是什麼樣的情況，還請見諒。
最後還是很感謝你分享這個Function哦。

unit JPGCtrl;

interface

uses
  graphics, jpeg, math,SysUtils,Types;

type
  DK1 = record
    Header : array[1..10] of char;         //檔頭
  end;

  function StretchImage(FileName : TFileName; Width, Height, Quality : Integer) : TJpegImage;
  function StretchImagePercent(FileName : TFileName; Percent, Quality : Integer) : TJpegImage;
  function StretchImageRatio(FileName : TFileName; Width, Height, Quality : Integer; Center : Boolean) : TJpegImage;
implementation

//這個功能可以將 BMP / JPG 檔縮放到你指定的大小及品質的 JPG 格式，你可以將之存檔，存在數據庫，甚至放進 TStream 通過 ISAPI 直接傳給使用者 Browser 作為顯示圖檔。
function StretchImage(FileName : TFileName; Width, Height, Quality : Integer) : TJpegImage;
var
  bmp, tempbmp : TBitmap;
  RT : TRect;
  F1: File of DK1;
  DKind1: DK1;
  sHeader:String;
begin
  result := TjpegImage.Create;
  bmp := TBitmap.Create;
  tempbmp := TBitmap.Create;
  bmp.Width := Width;
  bmp.Height := Height;
  RT.Left := 0;
  RT.Top := 0;
  RT.Right := Width - 1;
  RT.Bottom := Height - 1;
  try
    AssignFile(F1,FileName);
    Reset(F1);
    Seek(F1,0);
    read(F1,DKind1);
    sHeader:=DKind1.Header;
    CloseFile(F1);
//    if Uppercase(ExtractFileExt(FileName)) = '.JPG' then
    if sHeader=#$FF#$D8#$FF#$E0#$00#$10#$4A#$46#$49#$46 then
    begin
      result.LoadFromFile(FileName);
      bmp.Canvas.StretchDraw(RT,result);
    end
//    else if Uppercase(ExtractFileExt(FileName)) = '.BMP' then
    else if sHeader=#$42#$4D#$A6#$42#$00#$00#$00#$00#$00#$00 then
    begin
      tempbmp.LoadFromFile(FileName);
      bmp.Canvas.StretchDraw(RT,tempbmp);
    end
    else
    begin
      result.Assign(bmp);
      exit;
    end;
    result.CompressionQuality := Quality;
    result.Assign(bmp);
  finally
    tempbmp.Free;
    bmp.Free;
  end;
end;

//使用基本上一樣，只是輸入沒了寬和高，多了百份比，以原尺寸按百份比縮放
function StretchImagePercent(FileName : TFileName; Percent, Quality : Integer) : TJpegImage;
var
  bmp, tempbmp : TBitmap;
  RT : TRect;
  F1: File of DK1;
  DKind1: DK1;
  sHeader,sType:String;
begin
  result := TjpegImage.Create;
  bmp := TBitmap.Create;
  tempbmp := TBitmap.Create;
  try
    AssignFile(F1,FileName);
    Reset(F1);
    Seek(F1,0);
    read(F1,DKind1);
    sHeader:=DKind1.Header;
    CloseFile(F1);
//    if Uppercase(ExtractFileExt(FileName)) = '.JPG' then
    if sHeader=#$FF#$D8#$FF#$E0#$00#$10#$4A#$46#$49#$46 then
    begin
      sType:='.JPG';
      result.LoadFromFile(FileName);
      bmp.Width := Round(result.Width * Percent / 100);
      bmp.Height := Round(result.Height * Percent / 100);
    end
//    else if Uppercase(ExtractFileExt(FileName)) = '.BMP' then
    else if sHeader=#$42#$4D#$A6#$42#$00#$00#$00#$00#$00#$00 then
    begin
      sType:='.BMP';
      tempbmp.LoadFromFile(FileName);
      bmp.Width := Round(tempbmp.Width * Percent / 100);
      bmp.Height := Round(tempbmp.Height * Percent / 100);
    end
    else
    begin
      result.Assign(bmp);
      exit;
    end;
    RT.Left := 0;
    RT.Top := 0;
    RT.Right := bmp.Width - 1;
    RT.Bottom := bmp.Height - 1;
    if sType = '.JPG' then
      bmp.Canvas.StretchDraw(RT,result)
    else
      bmp.Canvas.StretchDraw(RT,tempbmp);
    result.CompressionQuality := Quality;
    result.Assign(bmp);
  finally
    tempbmp.Free;
    bmp.Free;
  end;
end;

//這個版本會保留原圖的長?比例，檔縮放到你指定的大小框架。
//比如說原圖是 600 X 600 的，而你的預設圖像尺寸是 300 X 200 那使用第一個功能縮小後圖像會由四方變長方拉長了。但若使用這個功能，圖像便會縮成 200 X 200，保留比例又剛好放得進你的預設圖像框架。
//這功能亦多了一個參數，去決定圖像的輸出位置及大小
//Center : 決定若圖像比例與指定的大小框架不符時，按計算的大小放在左上角還是置中。若參數是 True，則自動將圖像置中，輸出圖像大小一定按你指定的 Width, Height，其他空位填白。若 False，則輸出圖像按計算後的尺寸為準，不留白邊。

function StretchImageRatio(FileName : TFileName; Width, Height, Quality : Integer; Center : Boolean) : TJpegImage;
var
  bmp, tempbmp : TBitmap;
  RT : TRect;
  Ratio : Double;
  NewW, NewH : Integer;
  F1: File of DK1;
  DKind1: DK1;
  sHeader,sType:String;
begin
  result := TjpegImage.Create;
  bmp := TBitmap.Create;
  tempbmp := TBitmap.Create;
  try
    AssignFile(F1,FileName);
    Reset(F1);
    Seek(F1,0);
    read(F1,DKind1);
    sHeader:=DKind1.Header;
    CloseFile(F1);
//    if Uppercase(ExtractFileExt(FileName)) = '.JPG' then
    if sHeader=#$FF#$D8#$FF#$E0#$00#$10#$4A#$46#$49#$46 then
    begin
      sType:='.JPG';
      result.LoadFromFile(FileName);
      Ratio := Min(Width / result.Width, Height / result.Height);
      NewW := Round(result.Width * Ratio);
      NewH := Round(result.Height * Ratio);
    end
//    else if Uppercase(ExtractFileExt(FileName)) = '.BMP' then
    else if sHeader=#$42#$4D#$A6#$42#$00#$00#$00#$00#$00#$00 then
    begin
      sType:='.BMP';
      tempbmp.LoadFromFile(FileName);
      Ratio := Min(Width / tempbmp.Width, Height / tempbmp.Height);
      NewW := Round(tempbmp.Width * Ratio);
      NewH := Round(tempbmp.Height * Ratio);
    end
    else
    begin
      result.Assign(bmp);
      exit;
    end;
    if Center then
    begin
      bmp.Width := Width;
      bmp.Height := Height;
      RT.Left := Floor(Abs(Width-NewW)/2);
      RT.Top := Floor(Abs(Height-NewH)/2);
      RT.Right := RT.Left + NewW;
      RT.Bottom := RT.Top + NewH;
    end
    else
    begin
      bmp.Width := NewW;
      bmp.Height := NewH;
      RT.Left := 0;
      RT.Top := 0;
      RT.Right := bmp.Width - 1;
      RT.Bottom := bmp.Height - 1;
    end;
    if sType = '.JPG' then
      bmp.Canvas.StretchDraw(RT,result)
    else
      bmp.Canvas.StretchDraw(RT,tempbmp);
    result.CompressionQuality := Quality;
    result.Assign(bmp);
  finally
    tempbmp.Free;
    bmp.Free;
  end;
end;

end.