alexa-tracking

Main Content

1024
1024
KASKUS
51
244
https://www.kaskus.co.id/thread/5326bcc120cb174e728b4645/delphi-screen-capture
[delphi] screen capture
Para mastah sekalian ... emoticon-Mewek

gw dapat potongan function screen capture seperti ini:

Code:

function TForm1.GetScreenShot: TBitmap;
var Desktop: HDC;
begin
Result := TBitmap.Create;
Desktop := GetDC(0);
try try Result.PixelFormat := pf32bit;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
Result.Modified := True;
finally
ReleaseDC(0, Desktop);
end;
except
Result.Free;
Result := nil;
end;
end;


Masalahnya ... kalo dilihat bisa, tapi di-save ke file gak bisa? emoticon-Bingung (S)

lihatnya:

image1.picture.bitmap := GetScreenShot; // yang ini tampil hasilnya

tapi kalo save:

image1.picture.bitmap.savetofile('nyobak.bmp'); // hasilnya cuma blank screen

kurangnya di mana ya? emoticon-Mewek

gw pake win7 pro ... apakah ada pengaruhnya? emoticon-Bingung (S)

Coba gini gan, ini copy paste doang dari sumber lain
Code:

procedure TForm1.Button1Click(Sender: TObject);
var DCDesk: HDC; // hDC of Desktop
bmp: TBitmap;
begin
{Create a bitmap}
bmp := TBitmap.Create;

{Set a bitmap sizes}
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;

{Get a desktop DC handle - handle of a display device context}
DCDesk := GetWindowDC(GetDesktopWindow);

{Copy to any canvas, here canvas of an image}
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
DCDesk, 0, 0, SRCCOPY);

{Save the bitmap}
bmp.SaveToFile('ScreenShot.bmp');

{Release desktop DC handle}
ReleaseDC(GetDesktopWindow, DCDesk);

{Release a bitmap}
bmp.Free;
end;
Quote:Original Posted By peyotpetot

image1.picture.bitmap := GetScreenShot; // yang ini tampil hasilnya

Delphi ane is a bit rusty, so the following may not be correct:
Fungsi GetScreenShot mengembalikan object TBitmap ke pemanggil fungsinya. Kalau agan memanggil fungsi itu melalui operasi assignment seperti di atas, image1.picture.bitmap hanya menerima pointer dari object tersebut (dan ada potensi memory leak di sini kalau agan tidak mem-free object tersebut). Itu mungkin sebabnya kalau agan save ga ada hasilnya. Gunakan method Assign kalau agan mau kopi bitmap.

Spoiler for Untested:

Quote:Original Posted By system69
Coba gini gan, ini copy paste doang dari sumber lain


Di TImage bisa tampil gan .. tapi giliran di-save jadinya blank hitam.

Quote:Original Posted By terge

Delphi ane is a bit rusty, so the following may not be correct:
Fungsi GetScreenShot mengembalikan object TBitmap ke pemanggil fungsinya. Kalau agan memanggil fungsi itu melalui operasi assignment seperti di atas, image1.picture.bitmap hanya menerima pointer dari object tersebut (dan ada potensi memory leak di sini kalau agan tidak mem-free object tersebut). Itu mungkin sebabnya kalau agan save ga ada hasilnya. Gunakan method Assign kalau agan mau kopi bitmap.



Tetap blank di hasil savetofile gan ... emoticon-Mewek

Gw pake win7 pro dan lazarus gan ... apa ada pengaruhnya ya? emoticon-Bingung (S)

Yang bikin bingung ... kalo dilihat pake TImage bisa gan ... cuma waktu disuruh savetofile malah jadi file sebesar 4 MB yang isinya hitam mulu ... emoticon-Cape d... (S)

Quote:Original Posted By peyotpetot
Para mastah sekalian ... emoticon-Mewek

gw dapat potongan function screen capture seperti ini:

Code:

function TForm1.GetScreenShot: TBitmap;
var Desktop: HDC;
begin
Result := TBitmap.Create;
Desktop := GetDC(0);
try try Result.PixelFormat := pf32bit;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
Result.Modified := True;
finally
ReleaseDC(0, Desktop);
end;
except
Result.Free;
Result := nil;
end;
end;


Masalahnya ... kalo dilihat bisa, tapi di-save ke file gak bisa? emoticon-Bingung (S)

lihatnya:

image1.picture.bitmap := GetScreenShot; // yang ini tampil hasilnya

tapi kalo save:

image1.picture.bitmap.savetofile('nyobak.bmp'); // hasilnya cuma blank screen

kurangnya di mana ya? emoticon-Mewek

gw pake win7 pro ... apakah ada pengaruhnya? emoticon-Bingung (S)



Masih belajar juga, tapi kalo begini bisa gan:

Code:


procedure TForm1.Button1Click(Sender: TObject);
begin
self.SaveScreenShot('D:\Test.bmp');
end;

procedure TForm1.SaveScreenShot(aFilename:string);
var
ScreenDC: HDC;
bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.SetSize(Screen.Width, Screen.Height);
ScreenDC := GetDC(0);
try
self.Hide;
bmp.LoadFromDevice(ScreenDC);
self.Show;
finally
ReleaseDC(0, ScreenDC);
end;
bmp.SaveToFile(aFilename);
finally
bmp.Free;
end;
end;

Thx gan .. emoticon-Shakehand2
gw sudah bisa tadi dengan menambahkan coretan di kanvas sebelum transfer dari layar.

Quote:Original Posted By peyotpetot


Di TImage bisa tampil gan .. tapi giliran di-save jadinya blank hitam.



Tetap blank di hasil savetofile gan ... emoticon-Mewek

Gw pake win7 pro dan lazarus gan ... apa ada pengaruhnya ya? emoticon-Bingung (S)

Yang bikin bingung ... kalo dilihat pake TImage bisa gan ... cuma waktu disuruh savetofile malah jadi file sebesar 4 MB yang isinya hitam mulu ... emoticon-Cape d... (S)


Ane tes pake Delphi 2007 bisa gan. Kodingan agan juga bisa, walaupun memory leak. Lazarus keknya yang bermasalah.
Quote:Original Posted By terge

Ane tes pake Delphi 2007 bisa gan. Kodingan agan juga bisa, walaupun memory leak. Lazarus keknya yang bermasalah.


Iya gan .. gw kemarin penasaran kenapa kok gak bisa, terus gw coba-coba gambar garis, pengen tahu jadinya seperti apa .. lha kok jadi keluar gambar screenshot-nya .. jadi akhirnya gw tambahkan gambar satu titik doang sebelum BitBlt, dan ternyata memang, gak tahu kenapa, canvas-nya harus dipancing seperti itu emoticon-Cape d... (S)

Ada memory leak ya gan? Cara periksanya bagaimana?


Dari kodingan seharusnya kan sudah kelihatan kalau ada potensi memory leak. Fungsi GetScreenShot meng-create object TBitmap yang kemudian di-passing balik ke pemanggil fungsi. Kalau fungsi ini cuma dipanggil sekali selama program berjalan ga ada masalah kalau tidak di-free objectnya. Yang jadi masalah kalau fungsi ini dipanggil lebih dari sekali. Contohnya agan buat tombol "Capture Screen" yang setiap dipencet memanggil fungsi ini. Coba agan jalankan program seperti itu dan jalankan juga Task Manager atau Process Explorer, kemudian agan pencet tombol itu berulang kali, agan akan lihat memory program membengkak sampai akhirnya crash kalau sudah melebihi limit process address space (2 GB untuk program 32 bit) atau Windows jadi hang karena commit charge sudah melampaui commit limit, whichever is smaller.
Oh .. yang itu ... Potongan programnya memang kurang lengkap meng-copy-nya gan ... di program pemanggilnya memang sudah dicantumkan kok untuk free bitmap yang di-pass balik itu setelah selesai dipake.

BTW, yang gw kurang mengerti, jika ..

a := GetScreenShot;
image1.picture.bitmap.assign(a);

bla bla

a.free;

Apakah free-nya cukup seperti itu?
Atau image1.picture.bitmap juga harus di-free?
Oh begitu. Ane sih curiganya karena agan memanggil fungsi GetScreenShot melalui proses assignment
Code:
image1.picture.bitmap := GetScreenShot;

Sebab kalau seperti itu, saat agan free objectnya seperti ini:
Code:
image1.picture.bitmap.free;

gambar screenshotnya kan jadi dihapus dari form.

Ya, free-nya cukup seperti itu. image1.picture.bitmap hanya mengkopi isi dari object a dengan method assign, tidak mereferensi object a. Coba agan baca ini.
Quote:Original Posted By terge
Oh begitu. Ane sih curiganya karena agan memanggil fungsi GetScreenShot melalui proses assignment
Code:
image1.picture.bitmap := GetScreenShot;

Sebab kalau seperti itu, saat agan free objectnya seperti ini:
Code:
image1.picture.bitmap.free;

gambar screenshotnya kan jadi dihapus dari form.

Ya, free-nya cukup seperti itu. image1.picture.bitmap hanya mengkopi isi dari object a dengan method assign, tidak mereferensi object a. Coba agan baca ini.


OK gan ... jadi tenang pikiran gw .. emoticon-Ngakak (S)