Mega Code Archive
Neoturk forum - bmp dosyasini otomatik kucultmek
<![CDATA[
"
15 Aralık 2005 13:31
bmp dosyasini otomatik kucultmek
delphide herhangi bir bmp dosyasını alıp istediğim pixel boyutlarında
küçültüp tekrar kayıt ettirmek istiyorum nasıl yapabilirim.
kc_Ak
"
*******************************************
aşağıdaki kodlarla yapabilirsin ancak aynı şeyi jpeg türü dosyalar
içinde yapmak istersen http://b-yaz.blogspot.com
adresinde gerekli kodları bulabilirsin. kolay gelsin
procedure ResimBoyutlandir(Yol:string; KaydedilecekYol:string; yukseklik:integer; genislik:integer);
var
bmp : TBitmap;
bmp1 : TBitmap;
XRect : TRect;
begin
bmp := TBitmap.Create;
bmp1 := TBitmap.Create;
bmp.LoadFromFile(Yol);
bmp1.Height := yukseklik;
bmp1.Width := genislik;
XRect := Rect(0, 0, genislik, yukseklik);
bmp1.Canvas.StretchDraw(XRect,bmp);
bmp1.SaveToFile(KaydedilecekYol);
bmp.Free;
bmp1.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ResimBoyutlandir('c:\resim.bmp','d:\baskaresim.bmp',600,600);
end;
dijital_k
*******************************************
dijital_k arkadaşımıza teşekkürler.......
koda yorum eklemek istiyorum,
istenilen pixel boyutlarında resmi küçültme istediğine karşın
yukarıdaki kod örneği doğrudur, ancak, yatay ve dikey genişlik otomatik
olarak oranlanmadığı için, orjinal resme duyarlı bir orantılama yapmaz.
verilecek olan sayılar, orjinal resmin ebat-boyutu ile doğru orantılı
olmak zorundadır, daha sağlıklı olur düşüncesindeyim.
kodu şu şekilde değiştiriyorum:
procedure ResimBoyutlandir(Yol,KaydedilecekYol:string; oran:real);
var
orjinal : TBitmap;
yeni : TBitmap;
XRect : TRect;
y,g:integer;
begin
orjinal := TBitmap.Create;
yeni := TBitmap.Create;
orjinal.LoadFromFile(Yol);
y:=trunc(orjinal.Height*oran);g:=trunc(orjinal.Width*oran);
yeni.Height :=y;
yeni.Width :=g;
XRect := Rect(0, 0, g, y);
yeni.Canvas.StretchDraw(XRect,orjinal);
yeni.SaveToFile(KaydedilecekYol);
yeni.Free;
orjinal.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ResimBoyutlandir('C:\deneme.bmp','c:\deneme_oran_0-8.bmp',0.8);//0.8 kat
ResimBoyutlandir('C:\deneme.bmp','c:\deneme_oran_1-0.bmp',1);//1 kat
ResimBoyutlandir('C:\deneme.bmp','c:\deneme_oran_1-5.bmp',1.5);//1.5 kat
end;
kolay gelsin.........
saygılarımla_
neoturk_
]]>