全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:10688
推到 Plurk!
推到 Facebook!

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

 
Justmade
版主


發表:94
回覆:1934
積分:2030
註冊:2003-03-12

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-03-27 23:56:52 IP:218.16.xxx.xxx 未訂閱
這個功能可以將 BMP / JPG 檔縮放到你指定的大小及品質的 JPG 格式,你可以將之存檔,存在數據庫,甚至放進 TStream 通過 ISAPI 直接傳給使用者 Browser 作為顯示圖檔。    你亦可稍作修改變成以原尺寸作百份比縮放    輸入參數為 FileName : 檔案的名稱連路徑 Width : 輸出濶度 Height : 輸出高度 Quality : 輸出JPEG質量 (0最差 - 100最好)     回傳參數為 TJpegImage 格式 (兼容 TGraphic)    
use graphics, jpeg    function StretchImage(FileName : TFileName; Width, Height, Quality : Integer) : TJpegImage;
var
  bmp, tempbmp : TBitmap;
  RT : TRect;
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
    if Uppercase(ExtractFileExt(FileName)) = '.JPG' then
    begin
      result.LoadFromFile(FileName);
      bmp.Canvas.StretchDraw(RT,result);
    end
    else if Uppercase(ExtractFileExt(FileName)) = '.BMP' then
    begin
      tempbmp.LoadFromFile(FileName);
      bmp.Canvas.StretchDraw(RT,tempbmp);
    end
    else
      exit;
    result.CompressionQuality := Quality;
    result.Assign(bmp);
  finally
    tempbmp.Free;
    bmp.Free;
  end;
end;
使用例子 (要放一個 TImage (Image1) 到 Form1):
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Graphic := StretchImage('C:\MyPicture.jpg',300,300,50);
end;
修改 : 加上紅色部份會穩定一點 發表人 - Justmade 於 2003/03/28 00:33:43
Justmade
版主


發表:94
回覆:1934
積分:2030
註冊:2003-03-12

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-03-28 00:23:16 IP:218.16.xxx.xxx 未訂閱
為方便大家, 加上了使用百份比的程式     使用基本上一樣,只是輸入沒了濶和高,多了百份比,以原尺寸按百份比縮放    
function StretchImagePercent(FileName : TFileName; Percent, Quality : Integer) : TJpegImage;
var
  bmp, tempbmp : TBitmap;
  RT : TRect;
begin
  result := TjpegImage.Create;
  bmp := TBitmap.Create;
  tempbmp := TBitmap.Create;
  try
    if Uppercase(ExtractFileExt(FileName)) = '.JPG' then
    begin
      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
    begin
      tempbmp.LoadFromFile(FileName);
      bmp.Width := Round(tempbmp.Width * Percent / 100);
      bmp.Height := Round(tempbmp.Height * Percent / 100);
    end
    else
      exit;
    RT.Left := 0;
    RT.Top := 0;
    RT.Right := bmp.Width - 1;
    RT.Bottom := bmp.Height - 1;
    if Uppercase(ExtractFileExt(FileName)) = '.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;
修改 : 加上紅色部份會穩定一點 發表人 - Justmade 於 2003/03/28 00:36:04
Justmade
版主


發表:94
回覆:1934
積分:2030
註冊:2003-03-12

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-03-28 09:49:20 IP:218.16.xxx.xxx 未訂閱
再發表一個功能更強大的版本    這個版本會保留原圖的長濶比例,檔縮放到你指定的大小框架。 比如說原圖是 600 X 600 的,而你的預設圖像尺寸是 300 X 200 那使用第一個功能縮小後圖像會由四方變長方拉長了。但若使用這個功能,圖像便會縮成 200 X 200,保留比例又剛好放得進你的預設圖像框架。    這功能亦多了一個參數,去決定圖像的輸出位置及大小    Center : 決定若圖像比例與指定的大小框架不符時,按計算的大小放在左上角還是置中。若參數是 True,則自動將圖像置中,輸出圖像大小一定按你指定的 Width, Height,其他空位填白。若 False,則輸出圖像按計算後的尺寸為準,不留白邊。    
uses graphics, jpeg, math    function StretchImageRatio(FileName : TFileName; Width, Height, Quality : Integer; Center : Boolean) : TJpegImage;
var
  bmp, tempbmp : TBitmap;
  RT : TRect;
  Ratio : Double;
  NewW, NewH : Integer;
begin
  result := TjpegImage.Create;
  bmp := TBitmap.Create;
  tempbmp := TBitmap.Create;
  try
    if Uppercase(ExtractFileExt(FileName)) = '.JPG' then
    begin
      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
    begin
      tempbmp.LoadFromFile(FileName);
      Ratio := Min(Width / tempbmp.Width, Height / tempbmp.Height);
      NewW := Round(tempbmp.Width * Ratio);
      NewH := Round(tempbmp.Height * Ratio);
    end
    else
      exit;
    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 Uppercase(ExtractFileExt(FileName)) = '.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;
akai
一般會員


發表:27
回覆:22
積分:9
註冊:2003-03-30

發送簡訊給我
#4 引用回覆 回覆 發表時間:2003-06-12 10:36:51 IP:202.39.xxx.xxx 未訂閱
首先,謝謝你的熱心撰寫分享 另外有兩點意見 1. 判斷檔案型態最好不要直接判斷副檔名, 直接判斷檔頭應該會好一點, 否則,將會成程式發生錯誤 2. 當判斷非BMP與JPG後, 請勿直接exit跳出, 請在exit之前加上result.Assign(bmp); 否則在某些情況下將會發生錯誤。
Justmade
版主


發表:94
回覆:1934
積分:2030
註冊:2003-03-12

發送簡訊給我
#5 引用回覆 回覆 發表時間:2003-06-12 15:07:52 IP:218.16.xxx.xxx 未訂閱
引言: 首先,謝謝你的熱心撰寫分享 另外有兩點意見 1. 判斷檔案型態最好不要直接判斷副檔名, 直接判斷檔頭應該會好一點, 否則,將會成程式發生錯誤
我一向偏重簡單為主,而且也對判斷檔頭沒甚麼經驗。你可以修改一下然後另行發表來與大家分享嗎?若主要修改自這篇請貼出這篇的連結即可。
引言: 2. 當判斷非BMP與JPG後, 請勿直接exit跳出, 請在exit之前加上result.Assign(bmp); 否則在某些情況下將會發生錯誤。
result 已經 Create 了, Assign 不 Assign 空的 Bmp 應沒分別,另在有錯誤的情況下發生錯誤是好的比偵察不到錯出何處要好。
akai
一般會員


發表:27
回覆:22
積分:9
註冊:2003-03-30

發送簡訊給我
#6 引用回覆 回覆 發表時間:2003-06-12 19:24:03 IP:61.222.xxx.xxx 未訂閱
這些是我後來改過的,檔頭部分我也是隨便改改,反正能用就好了。 另外我本來也是覺得不用再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.
 
mitchellhu
一般會員


發表:23
回覆:53
積分:15
註冊:2007-06-12

發送簡訊給我
#7 引用回覆 回覆 發表時間:2010-03-16 14:55:21 IP:123.204.xxx.xxx 訂閱
感謝版大 提供的function,正好解決了我的需求,太感激了。
系統時間:2024-03-29 15:05:54
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!