image resize

[frost majere]

Kod: Tümünü seç

procedure TVideoForm.CaptureExecute(Sender: TObject);
var Jpeg:TJpegImage;
begin
Jpeg:=TJpegImage.Create;   Captured.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.Exename)+'Images\'+'Capture.Bmp');
Captured.Picture.Bitmap.Width := 640;
Captured.Picture.Bitmap.Height := 480;
Jpeg.Assign(Captured.Picture.Bitmap);
Jpeg.Compress; Jpeg.SaveToFile(ExtractFilePath(Application.Exename)+'Images\'+GetFileName);
Jpeg.Free;
end;

yukarida ki kodla 1024x1280 seklinde cekilmis resmi 640x480 e cevirmek icin yukaridaki kodu kullaniyorum fakat resim uzerinde bozulmalar oluyor veya resimin belli bir bolumu resize gibi oluyor.

kodda bir terslik var midir? yada izlenebilecek ba$ka bir yol..

te$ekkurler.

[mrmarman]

Selam...

- Başlangıç olarak bildirmek isterim, 1024 x 1280'lik bir image yükleyip bunu 640 x 480 olarak yeniden boyutlandırmak demek direkt kırpmak demektir.

- Bunu yapmayıp Canvas.CopyRect yapman gerekiyor. Bunu yaparken de oranlara dikkat etmek gerekiyor ki, oransal bozulma sıkıntısı yaşamayasın.

Hedef büyüklük olan
- 640X / 480Y oranı -> Y = (0.75)* X kadardır.

Kaynak resminin büyüklüğü olan
- 1024X / 1280Y orani -> Y = (1.25)* X kadardır.

- Yani resmi küçültürken 1:1 oranlı olarak bu işi yapamazsın. Önce bazı hesaplamalar yapmanız lazım. Eksik kısımları boşluk ekleyerek doldurmak lazım.

Y = (0.75)* X olduğuna göre 1280Y / 0.75 HedefOran = 1707X demektir.

- Bu hesaba göre Canvas'ın 1707x1280 olmalıydı ki 640x480 lik hedef boyuta 1:1 oranlı küçültme imkanın olsun.

- Şimdi basit bir hesap yapalım. Hedef 640x480 ve bunun oranı 0.75

- Ya 1024 olan X değerini bu orana uydurup, 1024*0.75 = 768 halde 1280 Y değerlik resmi Crop edip (kesip) kesilmiş kısmı kullanacaksın. Ya da makul çözüm olan, 1280/0.75'e bölüp elde edeceğin 1707 X değerinden hesaplayıp farkı boşluk olarak hesaba katacaksın.

- X:1024 Y:1280 için; hedef orantın olan 640 x 480'den yola çıkarak resmi aslında 384 x 480'e göre küçültme yaparsan oransal bozulma yaşamazsın. 640 - 384 = 256 px'lik de boşluğun olacak.

[frost majere]

Kod: Tümünü seç

procedure TVideoForm.makeResize(img:TImage);
var bitmap, resizedbitmap : tbitmap;
   newheight, newwidth : integer;
   stretchrect : trect;
begin
  bitmap := tbitmap.create;
  resizedbitmap := tbitmap.create;
  bitmap.Assign(img.Picture.Bitmap);
  if bitmap.Width <> bitmap.height then begin
     if bitmap.height > bitmap.width then begin
        newheight := 480;
        newwidth := (newheight * bitmap.width) div bitmap.height;
     end
     else begin
        newwidth := 640;
        newheight := (newwidth * bitmap.height) div bitmap.width;
     end;
   end
   else begin
        newheight := 480;
        newwidth := 640;
   end;
   stretchrect.left := 0;
   stretchrect.Top := 0;
   stretchrect.right := newwidth;
   stretchrect.bottom := newheight;
   resizedbitmap.Width := newwidth;
   resizedbitmap.height := newheight;
   resizedbitmap.Canvas.StretchDraw(stretchrect, bitmap);
   img.picture.bitmap := resizedbitmap;
end;

bu $ekilde hallettim[/quote]