Question

我制作了一个应用程序，可以让你创建一个矩形并根据需要调整它的大小，但它有问题。

每当我想在现有的 this 上绘制一个新的矩形时。

以下是该应用程序的代码：

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时却无济于事。

我如何改进这段代码，以便不让矩形改变颜色然后我将它们相互绘制？

Answer 1

首先，我不认为你真正理解你在做什么以及它为什么有效（有点）。我认为你从某个地方挖出了一些代码并试图迁移它。所有这些全局变量都是一个不好的迹象。

（你也没有鼠标功能 - 所以你发布的内容永远不会产生你所展示的图像。）

那么，它做了什么？那么，画布背景是白色的，笔是黑色的（这些是你不会改变的默认值）所以如果你对它们进行异或，结果实际上是白色的 - 它似乎什么也不做（除非你改变了笔）颜色为白色），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.

delphi 7 - 使用NotXor penmode调整矩形大小

1 个答案: