Arsip: tanya grayscaling banyak 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;
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;
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
more 12 years ago
diandewi
saya sudah coba, tp kok masih ada yg eror ya, kira2 ada yg perlu ditambahin di uses?
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;
more 12 years ago
theodorusap
Oh ya, kalo pake ekstensi jpg, di uses tambahan jpg
Chers..
Boleh aja diubah asal bisa dikompile dan jalan.
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
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;
more ...
- Pages:
- 1
reply |
Report Obsolete
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 4 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 4 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 4 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 12 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 12 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 12 years ago
Random Topic
- Gimana sih buka komen artikel biar cepet....
by EkoIndri in Kritik & Saran more 18 years ago - ItemIndex di TComboBox
by Random in Hal umum tentang Pascal Indonesia more 17 years ago - simpan jpg
by lela in Tip n Trik Pemrograman more 18 years ago - gimana jumlahin bulan ditahun yg beda
by pp1979 in Tip n Trik Pemrograman more 15 years ago - Buka laci cash register dengan Delphi
by wati in Hal umum tentang Pascal Indonesia more 14 years ago - gimana bikin format 001 di fast report 3.xx
by oloan_ac in Reporting more 16 years ago - ada gak komponen sejenis Zeos buat database access???
by $tring in Hal umum tentang Pascal Indonesia more 15 years ago - Tab SHEET lebih menarik...
by akudana in Hal umum tentang Pascal Indonesia more 14 years ago - Cara nyimpen&menampilkan image dr mySQL
by rlina88 in MySQL more 17 years ago - ada yang tau component fclabel
by alvonz in OOT more 15 years ago