Arsip: tanya grayscaling banyak image

 
user image
more 12 years ago

diandewi

haloo....mohon bantuannya... saya ingin melalukan grayscaling image yang ada dalam satu folder. misalnya saya punya folder X yang didalamnya ada 10 image. gimana ya caranya agar sekali klik buttonnya bisa memproses 10 image yang ada dalam folder tersebut. dibawah sudah sya cantumin sourcecode select directori ama proses grayscale, tp grayscale 1 image saja. apa yang perlu saya tambahain dalam source code tersebut? mohon bantuan ya...thx
 procedure TFormAdmin.Button1Click(Sender: TObject);

begin
if SelectDirectory('Select Directory','', s)then
Edit1.Text  := s; //nama dorektori atau foldernya
end;
procedure TFormAdmin.Button2Click(Sender: TObject);
 
    begin
    Image2.Left := Image1.Left+Image1.Picture.Width+5;
    Image2.Width := Image1.Picture.Width;
    for x:= 0 to Image1.Picture.Width-1 do
    for y:= 0 to Image1.Picture.Height-1 do
      begin
        Scanner := Image1.Canvas.Pixels[x, y];
        _r:= GetRValue(Scanner);
        _g:= GetGValue(Scanner);
        _b:= GetBValue(Scanner);
        Rata2 := (_r + _g + _b) div 3;
        Scanner := RGB(Rata2, Rata2, Rata2);
        Image2.Canvas.Pixels[x, y]:= Scanner;
      end;
      Image2.Visible := True;
      Image2.Repaint;
      Image2.Refresh;
      Image2.Picture.SaveToFile('picture/baru'+IntToStr(urutan)+'.bmp');
  ShowMessage('Selesai!!!');
  end;
  end;
user image
more 12 years ago

theodorusap

Bisa coba yang ini :
//Rutin Grayscale
procedure BitmapGrayscale(const Bitmap: TBitmap);
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Alpha: Byte;
  end;
var
  X: Integer;
  Y: Integer;
  Gray: Byte;
  Pixel: PPixelRec;
begin
  Bitmap.PixelFormat:=pf32bit;
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    Pixel := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := Round((0.299  Pixel.R) + (0.587   Pixel.G) + (0.114  Pixel.B));
      Pixel.R := Gray;
      Pixel.G := Gray;
      Pixel.B := Gray;
      Inc(Pixel);
    end;
  end;
end;
//Rutin Grayscale folder
Procedure GrayScaleFolder(Folder:String; Log:Tstrings);
var
  P:TPicture;
  F:TSearchRec;
  BMP:TBitmap;
  Attr:Integer;
  Path:String;
begin
  P:=TPicture.Create;
  BMP:=TBitmap.Create;
  try
    Attr:=faAnyFile or faReadOnly or faHidden or faSysFile;
    Path:=IncludeTrailingPathDelimiter(Folder);
    if FindFirst(Path+' .jpg',attr,F)=0 then
    begin
      Log.Add('Mulai proses Geryscale....');
      repeat
        if (F.Attr and Attr) = f.Attr then
        begin
          P.LoadFromFile(Path+f.Name);
          BMP.Assign(P.Graphic);
          BitmapGrayscale(BMP);
          P.Graphic.Assign(BMP);
          if ForceDirectories(Path+'Baru') then begin
            P.SaveToFile(Path+'Baru'+f.Name);
            Log.Add('File '+Path+'Baru'+f.Name+' selesai ')
          end;
        end;
      until FindNext(f) <> 0;
      FindClose(f);
    end;
  finally
    P.free;
    BMP.Free;
  end;
end;
//dipanggil di sini
procedure TFormAdmin.Button1Click(Sender: TObject); 
begin 
  if SelectDirectory('Select Directory','', s)then 
  Edit1.Text  := s; //nama dorektori atau foldernya 
  GrayScaleFolder(s,Memo1.lines); // tambahkan Memo1 buat ngeliat prosesnya
end;
user image
more 12 years ago

theodorusap

catatan, bagian yang ini : if FindFirst(Path+'.jpg',attr,F)=0 then <-- file berkestensi jpg. Kalau filenya berekstensi .bpm, ubah saja if FindFirst(Path+' .bmp',attr,F)=0 then
user image
more 12 years ago

diandewi

saya sudah coba, tp kok masih ada yg eror ya, kira2 ada yg perlu ditambahin di uses?
user image
more 12 years ago

diandewi

saya ubah jd kayak gini bisa gak?
 procedure TFormAdmin.Button1Click(Sender: TObject);
//Temp:= TTemporary.Create ;
begin
if SelectDirectory('Select Directory','', s)then
Edit1.Text  := s; //name directory image
GrayScaleFolder(s,Memo1.lines);
end;
procedure TFormAdmin.Button2Click(Sender: TObject);
type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Alpha: Byte;
  end;
var
  X: Integer;
  Y: Integer;
  Gray: Byte;
  Pixel: PPixelRec;
   P:TPicture;
  F:TSearchRec;
  BMP:TBitmap;
  Attr:Integer;
  Path:String;
begin
  Bitmap.PixelFormat :=pf32bit;
  for Y := 0 to (Bitmap.Height - 1) do
  begin
    Pixel := Bitmap.ScanLine[Y];
    for X := 0 to (Bitmap.Width - 1) do
    begin
      Gray := Round((0.299  Pixel.R) + (0.587   Pixel.G) + (0.114  Pixel.B));
      Pixel.R := Gray;
      Pixel.G := Gray;
      Pixel.B := Gray;
      Inc(Pixel);
    end;
  end;
  begin
  P:=TPicture.Create;
  BMP:=TBitmap.Create;
  try
    Attr:=faAnyFile or faReadOnly or faHidden or faSysFile;
    Path:=IncludeTrailingPathDelimiter(s);
    if FindFirst(Path+' .bmp',attr,F)=0 then
    begin
      Log.Add('Mulai proses Geryscale....');
      repeat
        if (F.Attr and Attr) = f.Attr then
        begin
          P.LoadFromFile(Path+f.Name);
          BMP.Assign(P.Graphic);
          BitmapGrayscale(BMP);
          P.Graphic.Assign(BMP);
          if ForceDirectories(Path+'Baru') then begin
            P.SaveToFile(Path+'Baru'+f.Name);
            Log.Add('File '+Path+'Baru'+f.Name+' selesai ')
          end;
        end;
      until FindNext(f) <> 0;
      FindClose(f);
    end;
  finally
    P.free;
    BMP.Free;
  end;
end;
end;
user image
more 12 years ago

theodorusap

Oh ya, kalo pake ekstensi jpg, di uses tambahan jpg Chers.. Boleh aja diubah asal bisa dikompile dan jalan.
user image
more 12 years ago

diandewi

saya make BMP gan.. tp tetep error kyk gini, udah sya cb benerin tp ga bisa. mohon koreksinya... [DCC Error] admin.pas(110): E2003 Undeclared identifier: 'Log' [DCC Error] admin.pas(116): E2003 Undeclared identifier: 'BitmapGrayscale' [DCC Error] admin.pas(120): E2066 Missing operator or semicolon
user image
more 12 years ago

theodorusap

Semua pesan error yang muncul itu karena source yang kemaren diubah. Pilihan Pertama : Gunakan source kemarin tanpa diubah :
implementation
uses JPEG;
{$R .dfm}
//Procedure BitmapGrayscale, letakan persis setelah implementation dan {$R  .dfm}
//Jangan masukan dalam Button click atau apapun
procedure BitmapGrayscale(const Bitmap: TBitmap); 
type 
  PPixelRec = ^TPixelRec; 
  TPixelRec = packed record 
    B: Byte; 
    G: Byte; 
    R: Byte; 
    Alpha: Byte; 
  end; 
var 
  X: Integer; 
  Y: Integer; 
  Gray: Byte; 
  Pixel: PPixelRec; 
begin 
  Bitmap.PixelFormat:=pf32bit; 
  for Y := 0 to (Bitmap.Height - 1) do 
  begin 
    Pixel := Bitmap.ScanLine[Y]; 
    for X := 0 to (Bitmap.Width - 1) do 
    begin 
      Gray := Round((0.299  Pixel.R) + (0.587   Pixel.G) + (0.114  Pixel.B)); 
      Pixel.R := Gray; 
      Pixel.G := Gray; 
      Pixel.B := Gray; 
      Inc(Pixel); 
    end; 
  end; 
end; 
//Procedure GrayScaleFolder, letakan persis setelah Procedure BitmapGrayscale
//Jangan masukan dalam Button click atau apapun
Procedure GrayScaleFolder(Folder:String; Log:Tstrings); 
var 
  P:TPicture; 
  F:TSearchRec; 
  BMP:TBitmap; 
  Attr:Integer; 
  Path:String; 
begin 
  P:=TPicture.Create; 
  BMP:=TBitmap.Create; 
  try 
    Attr:=faAnyFile or faReadOnly or faHidden or faSysFile; 
    Path:=IncludeTrailingPathDelimiter(Folder); 
    if FindFirst(Path+' .jpg',attr,F)=0 then 
    begin 
      Log.Add('Mulai proses Geryscale....'); 
      repeat 
        if (F.Attr and Attr) = f.Attr then 
        begin 
          P.LoadFromFile(Path+f.Name); 
          BMP.Assign(P.Graphic); 
          BitmapGrayscale(BMP); 
          P.Graphic.Assign(BMP); 
          if ForceDirectories(Path+'Baru') then begin 
            P.SaveToFile(Path+'Baru'+f.Name); 
            Log.Add('File '+Path+'Baru'+f.Name+' selesai ') 
          end; 
        end; 
      until FindNext(f) <> 0; 
      FindClose(f); 
    end; 
  finally 
    P.free; 
    BMP.Free; 
  end; 
end; 
//dipanggil di sini 
//ingat, procedure BitmapGrayscale dan GrayScaleFolder diletakan di luar button click
procedure TFormAdmin.Button1Click(Sender: TObject); 
begin 
  if SelectDirectory('Select Directory','', s)then 
  begin
    Edit1.Text  := s; //nama dorektori atau foldernya 
    GrayScaleFolder(s,Memo1.lines); // tambahkan Memo1 buat ngeliat prosesnya 
  end;
end;[/code:1:4d4b0479a2]
Coba dulu code di atas tanpa perubahan.
Kalo sudah sukses baru diubah.
Soalnya perubahan yang kamu buat membingungkan
Pilihan kedua :
Kalo kamu mau semua source di atas masuk dalam 1 button click (misalnya button 1 click), maka sourcenya kira-kira seperti ini :
[code:1:4d4b0479a2]procedure TFormAdmin.Button1Click(Sender: TObject);
const
  Exts:Array[0..2] of String = ('.jpg',' .jpeg','.bmp');
type 
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Alpha: Byte;
  end;
var
  //variabel untuk mengolah gambar
  P:TPicture;
  BMP:TBitmap;
  F:TSearchRec;
  //variabel untuk proses pencarian file di folder
  Folder,Path,NamaFile,FileTarget:String;
  Attr,ExtNo:Integer;
  //Variabel untuk proses grayscale
  X: Integer; 
  Y: Integer; 
  Gray: Byte; 
  Pixel: PPixelRec;
begin
  P:=TPicture.Create;  //P digunakan untk membaca BMP dan JPG. kalau BMP hanya bisa baca BMP
  BMP:=TBitmap.Create;
  try
    //Pilih Directory
    if SelectDirectory('Pilih Folder','',Folder) then
    begin
      Folder:=IncludeTrailingPathDelimiter(Folder);
      Attr:=faAnyFile or faReadOnly or faSysFile or faHidden;
      //looping, baca semua ekstensi (jpg dan bmp)
      For ExtNo:=low(Exts) to high(Exts) do begin
        Path:=Folder+Exts[ExtNo];
        //Cari File Pertama.
        if FindFirst(Path,Attr,F)=0 then
        begin
          Repeat
             //set nama file
             NamaFile:=Folder+F.Name;
             try
               //baca file simpan ke P
               P.LoadFromFile(NamaFile);
               //Copy data gambar ke Format DIB (Bitmap) 
               BMP.Assign(P.Graphic);
               //Start Grayscale Bitmap
               BMP.PixelFormat:=pf32bit;
               For Y:=0 to BMP.Height-1 do
               begin
                 pixel:=BMP.ScanLine[Y];
                 For X:=0 to BMP.Width-1 do
                 begin
                   Gray := Round((0.299   Pixel.R) + (0.587  Pixel.G) + (0.114   Pixel.B)); 
                   Pixel.R := Gray;
                   Pixel.G := Gray;
                   Pixel.B := Gray; 
                   Inc(Pixel); 
                 end;
               end;
               //Hasil grayscale BMP pindahkan kembali ke Picture
               //untuk disimpan ke format aslinya (JPG atau BMP)
               P.Graphic.Assign(BMP);
               //Pastikan apakah folder baru sudah ada
               if ForceDirectories(Folder+'Baru') then
               begin
                 //nama file hasil grayscale
                 FileTarget:=Folder+'Baru'+F.Name;
                 P.SaveToFile(FileTarget);
                 //Tampilkan status berhasil di memo1
                 Memo1.Lines.Add('Grayscale file '+NamaFile+' Berhasil, disimpan sebagai '+FileTarget);
               end;
             except
               //Tampilkan status gagal di memo1
               Memo1.Lines.Add('Grayscale file '+NamaFile+' gagal.');
             end;
             Application.ProcessMessages;
          Until FindNext(F)<>0;
          FindClose(F);
        end;
      end;
    end;
  finally
    BMP.Free;
    P.Free;
  end;
end;
user image
more 12 years ago

diandewi

codenya uda mau.... :) makasi ya bantuannya...
more ...
  • Pages:
  • 1
Share to
Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com