(Vi) Bentuk penangkapan area
Buat form1 baru, simpan sebagai capture1.pas. Atur empat properti dari Bordericons atribut ke false.
Borderstyle diatur ke BSNone, kursor diatur ke Crcross, FormStyle diatur ke fsstayontop.
Tambahkan variabel pribadi: fdragging: boolean;
Fungsi Form1: Dibuat saat meraih area, menghilang setelah mengambil gambar.
unit capture1;
antarmuka
penggunaan
Windows, pesan, sysutils, varian, kelas, grafik, kontrol, formulir,
Dialog;
jenis
Tform1 = class (tform)
Prosedur FormCreate (pengirim: Tobject);
Prosedur Formdestroy (pengirim: TOBJEK);
Prosedur FormPaint (Pengirim: Tobject);
Prosedur Formmousedown (Pengirim: Tobject; Tombol: Tmousebutton;
Shift: tshiftate; x, y: integer);
Prosedur FormMouseMove (Pengirim: Tobject; Shift: TshiftState; x,
Y: Integer);
Prosedur FormMouseUp (Pengirim: Tobject; Tombol: TMousebutton;
Shift: tshiftate; x, y: integer);
Pribadi
fdragging: boolean;
publik
Frect: Trect;
FBMP: tbitmap;
akhir;
var
Form1: tform1;
Pelaksanaan
{$ R *.dfm}
Prosedur TFORM1.FORMCREATE (Pengirim: Tobject);
VAR ADC: HDC; // Tabel Deskripsi Perangkat
Mulai
fbmp: = tbitmap.create;
fbmp.width: = screen.width;
fbmp.height: = screen.height;
ADC: = GetDC (0);
Bitblt (fbmp.canvas.handle, 0,0, screen.width, screen.height, adc, 0,0, srccopy);
Dirilis (0, ADC,);
SetBounds (0,0, screen.width, screen.height);
akhir;
Prosedur TFORM1.FORMDESTROY (Pengirim: TOBJEKS);
Mulai
fbmp.free;
akhir;
Prosedur TFORM1.FormPaint (pengirim: TOBJEK);
Mulai
Canvas.draw (0,0, fbmp);
akhir;
// Jika Anda menekan tombol kiri mouse, gunakan SetRect untuk mengatur Frect Rectangle sehingga hanya satu poin.
// Gambarlah persegi panjang ini dengan drawfocusrect
Prosedur TFORM1.FORMMOUSEDOWN (Pengirim: TOBJEK; Tombol: Tmousebutton;
Shift: tshiftate; x, y: integer);
Mulai
jika tombol = mbleft lalu mulai
fdragging: = true;
SetRect (Frect, x, y, x, y);
Canvas.drawfocusrect (frect);
akhir;
akhir;
// Saat mouse bergerak, tentukan apakah ada di gambar (tekan tombol kiri mouse), dan drawfocusrect mengatur ulang persegi panjang
// buat sudut kanan bawah posisi mouse saat ini, dan gambar persegi panjang saat memanggil drawfocusrect
Prosedur tform1.FormMouseMove (pengirim: Tobject; shift: tshiftate; x,
Y: Integer);
Mulai
Jika fdragging maka mulailah
Canvas.drawfocusrect (frect);
Frect.right: = x;
frect.bottom: = y;
Canvas.drawfocusrect (frect);
akhir;
akhir;
// menilai apakah itu ada di gambar (tekan tombol kiri mouse), saat mouse muncul,
// DrawFocusRect Reset persegi panjang
Prosedur TFORM1.FORMMOUSEUP (Pengirim: TOBJEKS; Tombol: TMousebutton;
Shift: tshiftate; x, y: integer);
Mulai
Jika fdragging maka mulailah
Canvas.drawfocusrect (frect);
fdragging: = false;
akhir;
ModalResult: = MROK; // Tutup formulir
akhir;
akhir.