我创建了一个应用程序,可以让你创建一个矩形并根据需要调整它的大小,但它有问题。
每当我想在现有的矩形上绘制一个新矩形时。
以下是该应用程序的代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
xstart,ystart,oldx,oldy,click1,lastx,lasty,copyrect_click:integer;
in_workspace,click_bol,copyrect_bol:boolean;
destrect,sourcerect:trect;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
image1.Canvas.pen.Width:=10;
image1.Canvas.Pen.style:=psSolid;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
click_bol:=true;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if click_bol then
begin
xstart:=x;
ystart:=y;
oldx:=x;
oldy:=y;
image1.Canvas.pen.mode:=pmnotxor;
image1.canvas.rectangle(xstart,ystart,oldx,oldy);
click1:=click1+1;
in_workspace:=true;
if click1 mod 2=0 then
begin
image1.canvas.Pen.mode:=pmCopy;
image1.Canvas.Rectangle(xstart,ystart,x,y);
in_workspace:=false;
end;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (in_workspace=true) and (click_bol=true) then
begin
image1.canvas.Rectangle(xstart,ystart,oldx,oldy);
image1.canvas.Rectangle(xstart,ystart,x,y);
oldx:=x;
oldy:=y;
end;
end;
end.
我怀疑这是因为NotXor penmode,你可以从代码中看到我试图将它改为复制penmode,当它绘制实际的rectagle但无济于事。
我怎样才能改进这段代码,以便不让矩形改变颜色然后我将它们相互绘制?
首先,我不认为你真的明白你在做什么,为什么它有效(有点)。我认为你从某个地方挖出了一些代码并试图迁移它。所有这些全局变量都是一个不好的迹象。
(您也没有鼠标功能 - 所以您发布的内容永远不会产生您显示的图像。)
那么,它做了什么?好吧,画布背景是白色的,笔是黑色的(这些是你不改变的默认值),所以如果你对它们进行异或,结果实际上是白色的 - 它似乎什么都不做(除非你把笔颜色改为白色),NotXOR使它变黑。我猜测的原始程序使用XOR,因为在旧程序中更为正常。
然而,现在图形已经大大改善了,正如David Heffernan所说的那样,最好只绘制旧的背景,并且当你将程序推进到使用颜色时,这将变得更加重要。
这显示了与使用此方法尝试实现的内容相同的内容。
请注意,代码少得多。我已经删除了按钮点击 - 这只是浪费时间。最好把它放在鼠标按下事件中。我也没有处理过鼠标右击等(但是,你也没有)。
unit Unit10;
interface
uses
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.ComCtrls,
Vcl.Grids, Vcl.Buttons, VCL.ExtCtrls,
System.Classes;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormActivate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
fSave : TPicture;
xstart,ystart:integer;
click_bol:boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
fSave := TPicture.Create;
image1.Canvas.pen.Width:=10;
image1.Canvas.Pen.style:=psSolid;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xstart:=x;
ystart:=y;
fSave.Assign( image1.Picture);
click_bol:=true;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Click_bol then
begin
image1.Picture.Assign( fSave );
image1.Canvas.pen.Width:=10;
image1.Canvas.Pen.style:=psSolid;
image1.Canvas.Brush.Style := bsClear;
image1.Canvas.Rectangle(xstart,ystart,x,y);
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
click_bol := FALSE;
end;
initialization
end.