(Vi) форма захвата площади
Создайте новую форму1, сохраните как capture1.pas. Установите четыре свойства атрибута Bordisticons для false.
Borderstyle установлен на Bsnone, курсор настроен на Crcross, стиль Form устанавливается на fsstayontop.
Добавить частную переменную: fdragging: boolean;
Функция Form1: создан при захвате область, исчезает после захвата картинки.
единица захвата1;
интерфейс
Использование
Windows, сообщения, Sysutils, варианты, классы, графика, управления, формы,
Диалоги;
тип
Tform1 = class (tform)
Процедура FormCreate (отправитель: Tobject);
процедура FormDestroy (отправитель: Tobject);
Процедура Formpaint (отправитель: tobject);
Процедура FormuseDown (отправитель: Tobject; кнопка: tmousebutton;
Сдвиг: TshiftState;
Процедура FormouseMove (отправитель: tobject; shift: tshiftstate; x,
Y: целое число);
Процедура FormMouseup (отправитель: tobject; кнопка: tmousebutton;
Сдвиг: TshiftState;
Частный
FDRAGGING: BOOLEN;
публичный
FRECT: TRECT;
FBMP: TBITMAP;
конец;
вар
Форма1: tform1;
Выполнение
{$ R *.dfm}
Процедура tform1.formcreate (отправитель: tobject);
VAR ADC: HDC;
Начинать
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);
Выпущенк (0, ADC);
SetBounds (0,0, Screen.width, Screen.height);
конец;
Процедура tform1.formDestroy (отправитель: tobject);
Начинать
fbmp.free;
конец;
Процедура tform1.formpaint (отправитель: tobject);
Начинать
Canvas.draw (0,0, FBMP);
конец;
// Если вы нажмете левую кнопку мыши, используйте SetRect, чтобы установить прямоугольник, чтобы это было просто точкой.
// Нарисуйте этот прямоугольник с помощью DrawcusRect
Процедура tform1.formmousedown (отправитель: tobject; кнопка: tmousebutton;
Сдвиг: TshiftState;
Начинать
Если кнопка = mbleft, затем начните
fdragging: = true;
SetRect (frect, x, y, x, y);
Canvas.drawfocusrect (frect);
конец;
конец;
// Когда мышь движется, определите, находится ли она на чертеже (нажмите кнопку «Левая мыши»), и DrawFocusRect сбрасывает прямоугольник
// Сделайте нижний правый угол в положении текущего мыши и нарисуйте прямоугольник при вызове DrawCuseCtrect
Процедура tform1.formmouseMove (отправитель: tobject; shift: tshiftState; x,
Y: целое число);
Начинать
Если фрэггирование, то начните
Canvas.drawfocusrect (frect);
frect.right: = x;
frect.bottom: = y;
Canvas.drawfocusrect (frect);
конец;
конец;
// Судите, находится ли он на чертеже (нажмите левую кнопку мыши), когда мышь появляется,
// DrawFocusRect сбросить прямоугольник
Процедура tform1.formmouseup (отправитель: tobject; кнопка: tmousebutton;
Сдвиг: TshiftState;
Начинать
Если фрэггирование, то начните
Canvas.drawfocusrect (frect);
fdragging: = неверно;
конец;
ModalResult: = MROK;
конец;
конец.