Graphics32: çok sayıda görüntüyü yeniden boyutlandırma

Question

3/24/2016 Ben 76 ve yazdığımda bunun mantıklı olduğunu düşündüm, ama herkes gibi ben de ne sorduğumdan emin değilim. İşte ben interneti yıkmaktan (güzel değil) bir araya geldiğim şey. Bu neredeyse çalışır, eksik olan tek şey Aspect oranını koruyor. Uzun boylu resimlerin şişman görünmesini sağlıyor. 40 yıllık programlamada, muhtemelen iki saatlik toplam kodlama grafikleri vardı. :)

procedure TfrmTools.Shrink(aFn : String; Wid,Ht : Integer); 
var 
    Bmp : TBitmap; // These three are created 
    Jpg : TJpegImage; // and Freed globally 
    Dst : TBitmap32; // to save some bit-thrashing 
begin 
    try 
    Src.Bitmap.LoadFromFile(aFn); // Src = TImage32 
    Dst:=TBitmap32.Create; 
    Dst.SetSize(Wid,Ht); 
    Src.Bitmap.DrawTo(Dst,Dst.BoundsRect); 
    bmp:=TBitmap.Create; 
    jpg:=TJPEGImage.Create; 
    bmp.Assign(Dst); 
    jpg.Assign(bmp); 
    jpg.SaveToFile('D:\Test1280x720.jpg'); // Just testing 
    finally 
    Bmp.Free; // As above 
    Jpg.Free; // As above 
    Dst.Free; // As above 
    end; 
end; 

3/23/2016

burada iyi ruhundan tavsiye aldı ve Graphis32 ile biti mermi ve yaptım sevindim, ama bir duvara vurdu. Bir veritabanında yaklaşık 1200 imge var ve her şey görüntüleme, kaydetme vb. Için iyi gidiyor.

Görüntülerin bazıları 6 ila 9 MB arasındadır ve yalnızca görüntülenebilecekleri kadar büyük saklanmaları gerekmez PC ekranında. Onları 1920 x 1080 gibi istenen bir boyuta indirmek ve H x W oranını korumak istiyorum. Görüntülerin 1920 x 1080'den daha küçük olup olmadığını azaltmak istemiyorum.

Çok fazla arama, deneme ve hata yaptım ve bugüne kadar sadece hata yaptım. Kullanıcı elle çalışırken çalışırken ölçeklendirme ve/veya rotasyondan sonra Tasarruf parçasına sahibim. Ama tüm veri tabanını taramak ve boyuttaki boyutları değiştirmek istiyorum.

Bir kod parçacığı harika olurdu.

Answer 1

Sadece bir dosya adları listesiyle yinelenmeli ve her birinde yeniden boyutlandırma kodunuzu gerçekleştirmelisiniz. Basit bir başlangıç ​​olarak ...

function TForm1.ResizeImage(const Filename: String): String; 
begin 
    Result:= ''; 
    try 

    //Your resizing code here 

    except 
    on e: Exception do begin 
     Result:= e.Message; 
    end; 
    end; 
end; 

procedure TForm1.ResizeAllImages(const List: TStringList); 
var 
    X: Integer; 
    R: String; 
begin 
    for X := 0 to List.Count - 1 do begin 
    R:= ResizeImage(List[X]); 
    if R <> '' then begin 
     //Report error in a memo control 
     Memo1.Lines.Add(List[X]); 
     Memo1.Lines.Add(R); 
     Memo1.Lines.Add(''); 
    end; 
    end; 
end; 

Yük sonra TStringList ve içine dosya adları listesi bu dize listesinde geçen ResizeAllImages diyoruz. İstisnaları da rapor etmek iyi bir fikirdir, bu yüzden çok basit hata raporları da ekledim. Bu konuda, örneğin bir ilerleme çubuğu uygulamak gibi, kesinlikle genişletmek isteyeceksiniz. Bu bir üretim ortamı içinse, örneğin dağıtmayı veya satmayı planladığınız bir şey içinse, bu tür görevler için ayrı bir iş parçacığı kullanmayı düşünmek istersiniz.

Ayrıca, mevcut resimlerin üzerine yazmamaya da kesinlikle tavsiye ederim. Bir çeşit çıkış dizini uygulayın ve yeni yeniden boyutlandırılan görüntüleri oraya kaydedin.

Answer 2

Bu yanıt, büyük resimleri yeniden boyutlandırırken, kalan sorunun eksik en boy oranı olduğunu belirttiğiniz düzenlemeye göre düzenlediğiniz 3/24/2016 işaretini temel alır. maksimum genişlik ve yükseklik olan Wid, Ht: integer iki argüman varsayarsak aşağıdaki yorumlarla işaretli değişiklikleri önermek uygulamak için:

procedure TfrmTools.Shrink(aFn : String; Wid,Ht : Integer); 
var 
    Bmp : TBitmap; // These three are created 
    Jpg : TJpegImage; // and Freed globally 
    Dst : TBitmap32; // to save some bit-thrashing 
    DstWidth, DstHeight: integer; // Add 
    AspRatio: single;    // Add 
begin 
    Bmp := nil; // not related to your question, see comment in text 
    Jpg := nil; // -"- 
    Dst := nil; // -"- 
    try 
    Src.Bitmap.LoadFromFile(aFn); // Src = TImage32 

    // Add following lines 
    DstWidth := Src.Width; 
    DstHeight := Src.Height; 
    AspRatio := Src.Width/Src.Height; 

    if (DstWidth > Wid) then 
    begin 
    DstWidth := Wid; 
    DstHeight := round(DstWidth/AspRatio); 
    end; 

    if (DstHeight > Ht) then 
    begin 
    DstHeight := Ht; 
    DstWidth := round(DstHeight * AspRatio); 
    end; 
    // end of added lines 

    Dst:=TBitmap32.Create; 
// Dst.SetSize(Wid,Ht); // Replace parameters 
    Dst.SetSize(DstWidth,DstHeight); 
    Src.Bitmap.DrawTo(Dst,Dst.BoundsRect); 
    bmp:=TBitmap.Create; 
    jpg:=TJPEGImage.Create; 
    bmp.Assign(Dst); 
    jpg.Assign(bmp); 
    jpg.SaveToFile('D:\Test1280x720.jpg'); // Just testing 
    finally 
    Bmp.Free; // As above 
    Jpg.Free; // As above 
    Dst.Free; // As above 
    end; 
end; 

Bmp, Jpg ve Dst değişkenler başlatılmamış ile Free için nihai aramaları engellemek için try önce nilled gerekmektedir hafıza referansları. Bu, üç nesnenin oluşturulmasından önce herhangi bir kod oluşturulduğunda oluşabilir.