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

有關圖形縮圖的問題

答題得分者是:jow
cobraliu
中階會員


發表:15
回覆:75
積分:83
註冊:2007-11-22

發送簡訊給我
#1 引用回覆 回覆 發表時間:2007-11-22 17:47:01 IP:59.127.xxx.xxx 訂閱
希望是沒有違反版規,因沒有程式段,而是希望各位先進可以提供一些方法以供自已有方向。

主要是要達到說如有一個JPG圖要產生另一個縮圖
要達的效果是如為150KB可以縮圖變成5KB。

請問各先進有什麼元件可以達到這功能或寫法??
------
初學、初學、學了很久...還是在初學階段..Orz
jow
尊榮會員


發表:66
回覆:751
積分:1253
註冊:2002-03-13

發送簡訊給我
#2 引用回覆 回覆 發表時間:2007-11-22 18:09:23 IP:123.193.xxx.xxx 訂閱
土法煉鋼...

[code delphi]
procedure TForm1.BitBtn1Click(Sender: TObject);
var
fn: string;
b0, b1: TBitmap;
r: TRect;
begin
fn := 'D:\TEST_IN.BMP';
if FileExists(fn) then
begin
b0 := TBitmap.Create;
try
b0.LoadFromFile(fn);
b1 := TBitmap.Create;
try
b1.Width := b0.Width div 2;
b1.Height := b0.Height div 2;
r := Rect(0,0,b1.Width-1,b1.Height-1);
b1.Canvas.StretchDraw(r, b0);
b1.SaveToFile('D:\TEST_OUT.BMP');
finally
FreeAndNil(b1);
end;
finally
FreeAndNil(b0);
end;
end;
end;
[/code]
cobraliu
中階會員


發表:15
回覆:75
積分:83
註冊:2007-11-22

發送簡訊給我
#3 引用回覆 回覆 發表時間:2007-11-22 23:08:58 IP:220.143.xxx.xxx 訂閱

===================引 用 jow 文 章===================
土法煉鋼...

[code delphi]
procedure TForm1.BitBtn1Click(Sender: TObject);
var
fn: string;
b0, b1: TBitmap;
r: TRect;
begin
fn := 'D:\TEST_IN.BMP';
if FileExists(fn) then
begin
b0 := TBitmap.Create;
try
b0.LoadFromFile(fn);
b1 := TBitmap.Create;
try
b1.Width := b0.Width div 2;
b1.Height := b0.Height div 2;
r := Rect(0,0,b1.Width-1,b1.Height-1);
b1.Canvas.StretchDraw(r, b0);
b1.SaveToFile('D:\TEST_OUT.BMP');
finally
FreeAndNil(b1);
end;
finally
FreeAndNil(b0);
end;
end;
end;
[/code]

大大,可以再問個問題嗎
因TBitmap有Canvas.StretchDraw,但如果換成要轉Jpeg用TJPEGImage,它則沒有!
請問如果是轉JPEG的話應該用那一函數來重建呢??
謝謝
------
初學、初學、學了很久...還是在初學階段..Orz
jow
尊榮會員


發表:66
回覆:751
積分:1253
註冊:2002-03-13

發送簡訊給我
#4 引用回覆 回覆 發表時間:2007-11-22 23:41:11 IP:123.193.xxx.xxx 訂閱
新增 Save As 'TEST_OUT.JPEG'

將 b1 Assign 給 TJPEGImage,
然後存成檔案....

[code delphi]
procedure TForm1.BitBtn1Click(Sender: TObject);
var
fn: string;
r: TRect;
b0, b1: TBitmap;
j: TJPEGImage;
begin
fn := 'D:\TEST_IN.BMP';
if FileExists(fn) then
begin
b0 := TBitmap.Create;
try
b0.LoadFromFile(fn);
b1 := TBitmap.Create;
try
b1.Width := b0.Width div 3;
b1.Height := b0.Height div 3;
r := Rect(0,0,b1.Width-1,b1.Height-1);
b1.Canvas.StretchDraw(r, b0);
b1.SaveToFile('D:\TEST_OUT.BMP');
//新增的部分
j := TJPEGImage.Create;
try
j.Assign(b1);
j.SaveToFile('D:\TEST_OUT.JPEG');
finally
FreeAndNil(j);
end;

finally
FreeAndNil(b1);
end;
finally
FreeAndNil(b0);
end;
end;
end;

[/code]
編輯記錄
jow 重新編輯於 2007-11-22 23:41:51, 註解 無‧
cobraliu
中階會員


發表:15
回覆:75
積分:83
註冊:2007-11-22

發送簡訊給我
#5 引用回覆 回覆 發表時間:2007-11-23 07:09:56 IP:220.143.xxx.xxx 訂閱
感謝大大,我去試試...
------
初學、初學、學了很久...還是在初學階段..Orz
系統時間:2024-03-29 14:38:09
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!