將 BMP / JPG 檔縮放到你指定的大小及品質的 JPG 格式 |
|
|
|
Justmade
版主   發表：94 回覆：1934 積分：2030 註冊：2003-03-12 發送簡訊給我 |
這個功能可以將 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 發送簡訊給我 |
為方便大家, 加上了使用百份比的程式 使用基本上一樣，只是輸入沒了濶和高，多了百份比，以原尺寸按百份比縮放
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 發送簡訊給我 |
再發表一個功能更強大的版本 這個版本會保留原圖的長濶比例，檔縮放到你指定的大小框架。
比如說原圖是 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 發送簡訊給我 |
|
|
Justmade
版主 發表：94 回覆：1934 積分：2030 註冊：2003-03-12 發送簡訊給我 |
引言: 首先，謝謝你的熱心撰寫分享 另外有兩點意見 1. 判斷檔案型態最好不要直接判斷副檔名， 直接判斷檔頭應該會好一點， 否則，將會成程式發生錯誤我一向偏重簡單為主，而且也對判斷檔頭沒甚麼經驗。你可以修改一下然後另行發表來與大家分享嗎?若主要修改自這篇請貼出這篇的連結即可。 引言: 2. 當判斷非BMP與JPG後， 請勿直接exit跳出， 請在exit之前加上result.Assign(bmp); 否則在某些情況下將會發生錯誤。result 已經 Create 了, Assign 不 Assign 空的 Bmp 應沒分別，另在有錯誤的情況下發生錯誤是好的比偵察不到錯出何處要好。 |
|
akai
一般會員 發表：27 回覆：22 積分：9 註冊：2003-03-30 發送簡訊給我 |
這些是我後來改過的，檔頭部分我也是隨便改改，反正能用就好了。
另外我本來也是覺得不用再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 發送簡訊給我 |
發表時間：2003-03-27 23:56:52
IP:218.16.xxx.xxx 未訂閱
系統時間：2025-01-31 1:31:03
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |