qq_30877677
qq_30877677
采纳率36.7%
2015-10-28 08:46 阅读 3.1k
已采纳

Delphi 在图片上画矩形

在image加载的图片上画矩形,会将图片覆盖,代码如下:
unit Unit3;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
TForm3 = class(TForm)
img1: TImage;
dlgOpen1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure img1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure img1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form3: TForm3;

implementation

{$R *.dfm}
var
cx, cy: Integer;
md: Boolean;

procedure TForm3.FormCreate(Sender: TObject);
var
openPath: string;
begin
dlgOpen1.Title := '打开图片';
dlgOpen1.Filter := '全部 (*.jpg;*.jpeg;*.bmp;)';

if dlgOpen1.Execute then
begin
openPath := dlgOpen1.FileName;
img1.Picture.LoadFromFile(openPath);
img1.AutoSize := False;
img1.Stretch := True;
end;
Form3.DoubleBuffered := true;
md := False;

end;

procedure TForm3.img1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
md := True;
cx := x;
cy := y;
end;

procedure TForm3.img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if md then
begin
// img1.Canvas.Brush.Color := clWhite; //画笔颜色设置为白色
// img1.Canvas.Brush.Style := bsclear;
//img1.Canvas.FillRect(img1.ClientRect); //把画布背景填充为白色
img1.Canvas.Pen.Color := clRed;
img1.Canvas.Rectangle(cx, cy, X, Y);

end;
end;

procedure TForm3.img1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
md := False;
end;

end.

  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 复制链接分享

3条回答 默认 最新

  • 已采纳
    lyhoo163 lyhoo163 2015-11-05 23:36

    使用FrameRect 用指定的刷子围绕一个矩形画一个边框。

    procedure TForm3.img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
    if md then
    begin
    img1.Canvas.Brush.Color := clWhite; //画笔颜色设置为白色
    img1.Canvas.Rectangle(cx, cy, X, Y);
    Img1.Canvas.FrameRect(TheRect);
    end;
    end;

    点赞 评论 复制链接分享
  • lyhoo163 lyhoo163 2015-11-05 23:34

    使用FrameRect 用指定的刷子围绕一个矩形画一个边框。

    procedure TForm3.img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
    if md then
    begin
    img1.Canvas.Brush.Color := clWhite; //画笔颜色设置为白色
    img1.Canvas.Rectangle(cx, cy, X, Y);
    Img1.Canvas.FrameRect(TheRect);
    end;
    end;

    点赞 评论 复制链接分享
  • qq_30877677 qq_30877677 2015-11-09 08:23

    问题已经解决,谢谢大家

    点赞 评论 复制链接分享

相关推荐