在窗口上放一个Image大小差不多为窗体大小
这个Button不用管,我只是为了看能不能透明而已QWQ。下面是实现在Image1的Canvas上画图的代码,要对Image1设置鼠标Down、Up和Move的事件
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,Math, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);//鼠标移动
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);//鼠标左键按下
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);//鼠标左键弹起
private
function GetReviseRect(ASourceRect: TRect): TRect;//这是用来计算你的方框拉的位置
procedure Paint; override;//重写Paint方法
public
{ Public declarations }
end;
var
Form1: TForm1;
StartCursor:TPoint;//鼠标开始位置
CurCursor:TPoint;//当前鼠标下的位置
NewRect:TRect; //新画的矩形
implementation
{$R *.dfm}
var
ADown:Boolean;//判断鼠标是否按下
//鼠标移动的时候开始画矩形
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ADown then
begin
//GetCursorPos(CurCursor);//设置当前坐标
CurCursor.X:=X;//如果鼠标按下获取当前鼠标的X和Y
CurCursor.Y:=Y;
NewRect:= GetReviseRect(Rect(StartCursor,CurCursor));
end;
Repaint;
end;
//鼠标按下开始画矩形
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ADown:=True;
//GetCursorPos(StartCursor);//获得鼠标开始位置
StartCursor.X:=X;//开始鼠标的X和Y
StartCursor.Y:=Y;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ADown:=False;
//ShowMessage(IntToStr(CurCursor.X)+' ' + IntToStr(CurCursor.Y));
Repaint;
end;
function TForm1.GetReviseRect(ASourceRect: TRect): TRect;
begin
with ASourceRect do
begin
Result.Left := Min(Left, Right);
Result.Top := Min(Top, Bottom);
Result.Right := Max(Left, Right);
Result.Bottom := Max(Top, Bottom);
end;
end;
procedure TForm1.Paint;
begin
//选区变换
//SetAlpha(NewRect);
with Canvas,NewRect do
begin
Pen.Color:=clLime;//边框的颜色绿色
Pen.Width:= 3;
Rectangle(Left,Top,Right,Bottom);
end;
end;
end.
完成后就是这样