Zmiana rozmiaru wszystkich bitmap z zadanego folderu

Witam,

po kliknięciu Buttona pojawia się lista z folderami. Po wyborze folderu, do zmiennej path przypisana jest jego ścieżka. Mam pytanie: jak zmienić rozmiar wszystkich obrazków .bmp, które znajdują się w wybranym folderze na rozmiar np. 200x200?

Aktualny kod:

procedure TForm1.Button1Click(Sender: TObject);
var
  bitmap : Tbitmap;
  path : string;
begin
  if selectdirectorydialog1.Execute=true then
  ShowMessage(path:=selectdirectorydialog1.FileName);
  //bitmap.width:= 200;
  //bitmap.height:= 200;
end; 

Pozdrawiam.

Jeśli potrzebujesz wszystkie bitmapy przeskalować (rozciągnąć/dopasować do nowych rozmiarów), to utwórz sobie pomocniczą bitmapę, nadaj jej odpowiedni PixelFormat (standardowo bitmapy są 24-bitowe, więc ustaw pf24bit), ustaw rozmiar bitmapy na 200x200, np. metodą SetSize (a jeśli nie masz takiej to za pomocą Width i Height); Następnie w pętli ładuj grafiki z plików do drugiego obiektu klasy TBitmap i rysuj na tej małej za pomocą metody StretchDraw;

Jeżeli potrzebujesz tylko przyciąć grafiki to ładuj je w pętli do obiektu, zmieniaj Width i Height i zapisuj z powrotem na dysk;

PS: Do wyszukania grafik w wybranym katalogu skorzystaj z funkcji FindFirst i FindNext.

"w pętli ładuj grafiki z plików" - no wlasnie mam z tym problem :P Generalnie nigdy nie pracowałam na obrazach i trochę obce są mi te wszystkie komendy, które przywołujesz :P Jak zaladować obraz z folderu?

"w pętli ładuj grafiki z plików" - no wlasnie mam z tym problem

Poniżej masz przykładowe wyszukiwanie plików *.bmp (sprawdzane pod Delphi7):

uses
  SysUtils;

const
  SOURCE_PATH     = 'C:\';
  FILES_EXTENSION = '*.bmp';
var
  srBitmap: TSearchRec;
begin
  if FindFirst(SOURCE_PATH + FILES_EXTENSION, faAnyFile, srBitmap) = 0 then
  try
    repeat
      // w polu srBitmap.Name jest nazwa znalezionego pliku (bez ścieżki)
    until FindNext(srBitmap) <> 0;
  finally
    FindClose(srBitmap);
  end;

  ReadLn;
end.

Jak zaladować obraz z folderu?

Służy do tego metoda LoadFromFile - do zapisu metoda SaveToFile; Tylko pamiętaj o tym, żeby obiekty najpierw tworzyć, a dopiero później coś na nich wykonywać; Czyli:

var
  bmpInput: TBitmap;

{..}

bmpInput := TBitmap.Create();
try
  // tutaj używasz obiektu
finally
  bmpInput.Free
end;

czy to jakoś tak ma wyglądać?:)

procedure TForm1.Button1Click(Sender: TObject);
const
  SOURCE_PATH     = 'C:\';
  FILES_EXTENSION = '*.bmp';
var
  bmpInput,bitmap: TBitmap;
  srBitmap : TSearchRec;
  path : string;
  x,y : integer;
begin
  x := StrToInt(Edit1.Text);
  y := StrToInt(Edit2.Text);

  if selectdirectorydialog1.Execute=true then
     path := selectdirectorydialog1.FileName;

  if FindFirst(path, faAnyFile, srBitmap) = 0 then
  try
    repeat
      begin
        bmpInput := TBitmap.Create();
        try
        bmpInput.PixelFormat:= pf24bit;
        bmpInput.SetSize(x,y);
        finally
        bmpInput.Free
        end;
      end;
    until FindNext(srBitmap) <> 0;
  finally
    FindClose(srBitmap);
  end;

end;

Co mam wstawić pod //repeat? Zmianę rozmiaru obrazka?

Ładowanie obrazka z pliku, bo w tej pętli w polu srBitmap.Name masz nazwę znalezionego pliku; W tej pętli także wykonujesz zmianę rozmiaru załadowanej bitmapy i zapis do tego samego pliku; Pętla Repeat będzie się wykonywać dopóty, dopóki znaleziono kolejny plik;

Zobacz na poniższy przykład:

uses
  SysUtils, Graphics, FileCtrl;

const
  SEARCH_MASK    = '*.bmp';
  BITMAPS_WIDTH  = 200;
  BITMAPS_HEIGHT = 200;
var
  srBitmap: TSearchRec;
  bmpInput: TBitmap;
  strDirectory: String;
begin
  if SelectDirectory('Select directory with bitmaps:', '', strDirectory) then
  begin
    strDirectory := IncludeTrailingPathDelimiter(strDirectory);

    bmpInput := TBitmap.Create();
    try
      if FindFirst(strDirectory + SEARCH_MASK, faAnyFile, srBitmap) = 0 then
      try
        repeat
          bmpInput.LoadFromFile(strDirectory + srBitmap.Name);

          bmpInput.Width  := BITMAPS_WIDTH;
          bmpInput.Height := BITMAPS_HEIGHT;

          bmpInput.SaveToFile(strDirectory + srBitmap.Name);
        until FindNext(srBitmap) <> 0;

        WriteLn('Bitmaps successfully processed');
      finally
        FindClose(srBitmap);
      end
      else
        WriteLn('No bitmaps found...');
    finally
      bmpInput.Free();
    end;
  end
  else
    WriteLn('Operation canceled...');

  ReadLn;
end.

Najpierw za pomocą SelectDirectory pobierany jest katalog; Jeżeli użytkownik jakiś wybierze to za pomocą funkcji IncludeTrailingPathDelimiter dodawany jest brakujący znak \ na koniec ścieżki (jeśli jest wymagany); Następnie tworzony jest obiekt bitmapy - on posłuży nam do ładowania i obróbki obrazu; Wystarczy go raz stworzyć a nie za każdym razem w pętli, dlatego że metoda LoadFromFile kasuje poprzednią zawartość obiektu i ładuje z pliku nową; Kolejnym krokiem jest załadowanie obrazu z pliku, zmiana jego rozmiaru i zapisanie z powrotem na dysku, używając zmiennej ze ścieżką bazową i pola srBitmap.Name z samą nazwą znalezionego pliku; Na koniec wyszukiwanie zostaje zakończone za pomocą procedury FindClose i wyświetlony zostaje komunikat;

W swojej wersji Delphi nie mam czegoś takiego jak SelectDirectoryDialog, więc posłużyłem się funkcją SelectDirectory; Tak samo u mnie klasa TBitmap nie posiada metody SetSize, więc ustawiłem ręcznie Width i Height; Dlatego też użyj swojego dialogu i swojej metody do zmiany rozmiaru bitmap.

Dzięki za pomoc :) Zorientowałam się ze nie dałam nawet nigdzie LoadFromFile ani SaveToFile, ale nawet nie zdazyłam poinformować bo już Tówj kod czekał na forum :D

Skorzystałam z Twojego kodu, właściwie zmieniając tylko drobnostki :)

Wstawiłam tu i ówdzie ShowMessage aby zerknac co wchodzi w zmienne. I faktycznie wszystko jest w porzadku: strDirectory zwraca ścieżkę folderu, a srBitmap.Name po kolei nazwy plików. Na koniec zostaje wyświetlony komunikat 'Zmieniono wielkosc obrazów.' czyli wszystko jak być należy. :) Jednak jak wchodzę do wybranego katalogu ze zdjęciami, to wielkości obrazów są nieruszone :( Jak to możliwe? :(

Kod:

procedure TForm1.Button1Click(Sender: TObject);
const
  SEARCH_MASK    = '*.bmp';
var
  srBitmap: TSearchRec;
  bmpInput: TBitmap;
  strDirectory: String;
  x,y:integer;
begin
  x := StrToInt(Edit1.Text);
  y := StrToInt(Edit2.Text);
  if SelectDirectory('Wybierz folder z obrazami .bmp:', '', strDirectory) then
  begin
    //ShowMessage(strDirectory);
    strDirectory := IncludeTrailingPathDelimiter(strDirectory);

    bmpInput := TBitmap.Create();
    try
      if FindFirst(strDirectory + SEARCH_MASK, faAnyFile, srBitmap) = 0 then
      try
        repeat
          //ShowMessage(srBitmap.Name);
          bmpInput.LoadFromFile(strDirectory + srBitmap.Name);
          bmpInput.Width  := x;
          bmpInput.Height := y;
          bmpInput.SaveToFile(strDirectory + srBitmap.Name);
        until FindNext(srBitmap) <> 0;

        ShowMessage('Zmieniono wielkosc obrazów.');
      finally
        FindClose(srBitmap);
      end
      else
        ShowMessage('Nie znaleziono obrazów.');
    finally
      bmpInput.Free();
    end;
  end
  else
    ShowMessage('Operacja anulowana.');

end;


end.

Jeżeli używasz nowszego systemu niż WinXP to aplikacja musi działać z prawami administratora, aby mogła modyfikować pliki znajdujące się w dowolnym miejscu na dysku; Uprawnienia aplikacji najpewniej ustala się we właściwościach projektu, ale sprawdź jak to wygląda w Twoim IDE i użyj opcji requireAdministrator.

Tak, to pewnie o to chodzi, bo wybieram katalog z dysku C://. Tylko gdzie to teraz zmienić:(

Nie napisałaś z której wersji Delphi korzystasz.

Korzystam z Lazarusa 1.0.2 :D Ale hmm jak wybieram folder z dysku D:\ to też nie zmienia mi wielkości obrazów. :(

Ehh... @madzieq - skoro korzystasz z Lazarusa to dlaczego ustawiłaś tag delphi...?

Po pierwsze zaktualizuj Lazarusa do bieżącej wersji 1.4 - możesz go pobrać stąd; Jak już zainstalujesz środowisko to otwórz projekt, wciśnij kombinację Shift+Ctrl+F11 i na głównej zakładce opcji (Project Options\Application) masz comboboxa zatytułowanego Execution Level - wybierz opcję require administrator (requireAdministrator).

Jak zmieniłam to wyskakuje mi z kolei błąd odpluskwiacza (the debugger could not run the application) i w ogole nie chce nawet rozpocząc kompilacji -.- I jakieś takie cudo:

The GDB command:
"-exec-run"
returned the error:
",msg="Error creating process

Ale to tylko jak otwieram przez Lazarusa. A jak otwieram program przez plik wykonywalny .exe to faktycznie pyta o uprawnienia administratora (ja się oczywiscie zgadzam) :D no ale dalej tych obrazów nie zmienia:(

To jest jak widać znany problem - http://forum.lazarus.freepascal.org/index.php?topic=25441.0

W chwili obecnej korzystam z Lazarusa 1.2.6 i z nim nie miałem problemów na 64-bitowym Windows7; Pobierz Lazarus 1.2.6 32-bit i na nim spróbuj przebudować i przekompilować swój projekt - powinno wszystko śmigać.