3) زحف الشكل أو السيطرة على صورة
احصل على صورة أو صورة تحكم ، أي لاستخدام نموذج جديد 2 ، راجع "مثال برمجة اعتراض الصور Delphi (7)"
أضف capture2 في استخدامات تطبيق الوحدة الرئيسية.
[Capture Windows أو Controls] حدث إجراء للحصول على نموذج أو تحكم
الإجراء tmainform.cptwindowsexecute (المرسل: tobject) ؛
var p: toply ؛
يبدأ
INC (Capturenum ، 1) ؛
application.minimize ؛
التأخير (500) ؛
اسم الملف: = 'capture'+inttoStr (capturenum) ؛
اسم الملف: = DefaultDirectory+اسم الملف ؛
مع tform2.create (التطبيق) do
يحاول
إذا showmodal = mrok ثم
يبدأ
CreateMdichild (اسم الملف ، صحيح) ؛
statusbar.simpletext: = اسم الملف ؛
التأخير (500) ؛
abitmap: = tbitmap.create ؛
getCursorpos (p) ؛
المقابض: = windowfrompoint (p) ؛
abitmap: = capturewindowimage (مقابض) ؛
child.image1.picture.bitmap: = abitMap ؛
child.clientwidth: = child.image1.picture.width ؛
child.clientheight: = child.image1.picture.height ؛
child.horzscrollbar.range: = child.image1.picture.width ؛
child.vertscrollbar.range: = child.image1.picture.height ؛
child.image1.hint: = 'الارتفاع:'+inttostr (child.image1.picture.height)+'pixels'
+"العرض:"+inttoStr (child.image1.picture.width)+'pixels' ؛
abitmap.free ؛
نهاية؛
أخيراً
حر؛
Application.Restore ؛
نهاية؛
نهاية؛
4) زحف صور أيقونة
احصل على صورة أيقونة ، أي استخدام نموذج جديد 3 ، راجع "مثال برمجة اعتراض الصور Delphi (8)"
أضف capture3 في استخدامات تنفيذ الوحدة الرئيسية.
أضف العملية الخاصة Captatericon في الوحدة الرئيسية:
الإجراء tmainform.captureicon ؛
يبدأ
مع tform3.create (التطبيق) do
يحاول
إذا كان showmodal = mrok ثم
مع FRECT تبدأ
إذا (يمين> يسار) و (أسفل> أعلى) ثم ابدأ
التأخير (300) ؛
abitmap: = tbitmap.create ؛
abitmap.assign (CaptureScreenRect (FRECT)) ؛
child.image1.picture.bitmap: = abitMap ؛
child.horzscrollbar.range: = child.image1.picture.width ؛
child.vertscrollbar.range: = child.image1.picture.height ؛
abitmap.free ؛
نهاية أخرى تبدأ
messagedlg ('خطأ في اختيار الحدود ، حاول مرة أخرى! "، mtinformation ، [mbok] ، 0) ؛
الطفل.
form3.free ؛
مخرج؛
نهاية؛
نهاية؛
أخيراً
حر؛
نهاية؛
نهاية؛
[أيقونة الالتقاط] حدث عمل لصور التقاط الأيقونات
الإجراء tmainform.cpticonexecute (المرسل: tobject) ؛
يبدأ
application.minimize ؛
التأخير (400) ؛
INC (Capturenum ، 1) ؛
اسم الملف: = 'capture'+inttoStr (capturenum) ؛
اسم الملف: = DefaultDirectory+اسم الملف ؛
CreateMdichild (اسم الملف ، صحيح) ؛
statusbar.simpletext: = اسم الملف ؛
captricticon ؛
child.clientwidth: = child.image1.picture.width ؛
child.clientheight: = child.image1.picture.height ؛
child.horzscrollbar.range: = child.image1.picture.width ؛
child.vertscrollbar.range: = child.image1.picture.height ؛
child.image1.hint: = 'الارتفاع:'+inttostr (child.image1.picture.height)+'pixels'
+"العرض:"+inttoStr (child.image1.picture.width)+'pixels' ؛
Application.Restore ؛
نهاية؛