private
{ Private declarations }
//首先定义全局变量:
mRct,mOldRct:tRect;//mRct保存新矩形框值;mOldRct:旧矩形框值;
mIsPaint:boolean;//是否画图
//-----------------------在Image1上作图------------------
procedure TfMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
mIsPaint:=true;//按下鼠标开始作图
mRct.Left:=x;
mRct.Top:=y;
mRct.Right:=x;
mRct.Bottom:=y;
mOldRct:=mRct;
Image1.Canvas.Pen.Width:=2;
Image1.Canvas.Pen.Style:=psDash;
Image1.Canvas.Pen.Color:=clRed;
//Image1.canvas.Pen.Mode:=pmcopy;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style:=bsClear;//无填充(重要!!!)
image1.Canvas.Pen.Mode := pmXor; //与背景异或运算(重要!!!)这样才能擦除旧框!
end;
procedure TfMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
//fMain.statusbar1.Panels[2].Text:='坐标:'+inttostr(x)+','+inttostr(y);
if(mIsPaint=false)then exit;
mRct.Right:=x;
mRct.Bottom:=y;
case cmbShape.ItemIndex of
0:begin //直线
Image1.canvas.MoveTo(mOldRct.Left,mOldRct.Top);
Image1.canvas.LineTo(mOldRct.Right,mOldRct.Bottom);//擦除旧的:
Image1.canvas.MoveTo(mRct.Left,mRct.Top);
Image1.canvas.LineTo(mRct.Right,mRct.Bottom);//绘制新的:
end;
1:begin //矩形
Image1.Canvas.Rectangle(mOldRct); //擦除以前的
Image1.Canvas.Rectangle(mRct);//绘制新矩形
end;
end;
mOldRct:=mRct;//保存矩形框坐标值;
end;
procedure TfMain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
mIsPaint:=false;//取消作图,防止误操作
mRct.Right:=x;
mRct.Bottom:=y;
Image1.Canvas.Pen.Mode := pmCopy; //恢复铅笔模式(重要!!!)
case cmbShape.ItemIndex of
0:begin //直线
Image1.canvas.MoveTo(mRct.Left,mRct.Top);
Image1.canvas.LineTo(mRct.Right,mRct.Bottom);//绘制新的:
end;
1:begin //矩形
Image1.Canvas.Rectangle(mRct); //绘制新矩形;
end;
end;
end;
原理:
绘制新矩形框前先擦除旧框,这样就能保证矩形框不被填充!画出跟随鼠标矩形框!!!