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
AI Forward

🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now:
https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 4 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 5 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
- DbLookupCombo
by IdrisZZ in Tip n Trik Pemrograman more 16 years ago - macro di word
by xerion in Tip n Trik Pemrograman more 18 years ago - Bagaimana Cara Membuat File .Ini
by babypigs in Bedah Kasus more 17 years ago - IndexFieldNames hilang ketika database connection di refresh
by bayzap in Hal umum tentang Pascal Indonesia more 17 years ago - Size Kaos Biar Nga Trouble
by saysansay in Hal umum tentang Pascal Indonesia more 18 years ago - problem bikin Chat jaringan
by p2bf in Hal umum tentang Pascal Indonesia more 18 years ago - Cara Form di klik X tidak tertutup/keluar
by onsir in MySQL more 17 years ago - generate key tab
by ndak_ngudeng in Hal umum tentang Pascal Indonesia more 18 years ago - Mendeklarasikan Tanggal dan Konstanta Lainnya
by umarbakri in MsSQL more 18 years ago - [HELP] security Table MyIsam ..
by rehmoe in MySQL more 17 years ago