Delphi之Canvas画矩形
程序员文章站
2023-12-22 16:28:40
...
在窗口上放一个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.
完成后就是这样
推荐阅读
-
Delphi之Canvas画矩形
-
HTML5 canvas基本绘图之绘制矩形
-
html5 Canvas画图教程(5)—canvas里画曲线之arc方法
-
html5 Canvas画图教程(8)—canvas里画曲线之bezierCurveTo方法
-
html5 Canvas画图教程(7)—canvas里画曲线之quadraticCurveTo方法
-
html5 Canvas画图教程(6)—canvas里画曲线之arcTo方法
-
HTML5 canvas画矩形时出现边框样式不一致的解决方法
-
html5的canvas元素使用方法介绍(画矩形、画折线、圆形)
-
HTML5 canvas基本绘图之绘制矩形
-
html5 Canvas画图教程(8)—canvas里画曲线之bezierCurveTo方法