Question

我需要使用游标在delphi中画一条线，我已经创建了行代码，但我接下来无法做什么？怎么办，我按下鼠标，当线需要启动并拖动我的鼠标或简单我释放鼠标按钮，我画线。

procedure TForm1.Button1Click(Sender: TObject);
var 
  x0, y0, x1, y1: Integer;
begin
  x0 := StrToInt(Edit1.Text);
  y0 := StrToInt(Edit2.Text);
  x1 := StrToInt(Edit3.Text);
  y1 := StrToInt(Edit4.Text);
  Brezenhems(x0 , Y0 , X1 , Y1);
end;

我希望有人帮助我感谢

Answer 1

这样的事情：

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm4 = class(TForm)
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FStartPoint, FEndPoint: TPoint;
    FDrawingLine: boolean;
    bm: TBitmap;
    procedure AddLineToCanvas;
    procedure SwapBuffers;
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.FormCreate(Sender: TObject);
begin
  bm := TBitmap.Create;
  FDrawingLine := false;
end;

procedure TForm4.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FStartPoint := Point(X, Y);
  FDrawingLine := true;
end;

procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDrawingLine then
  begin
    SwapBuffers;
    Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
    Canvas.LineTo(X, Y);
  end;
end;

procedure TForm4.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDrawingLine := false;
  FEndPoint := Point(X, Y);
  AddLineToCanvas;
  SwapBuffers;
end;

procedure TForm4.AddLineToCanvas;
begin
  bm.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
  bm.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;

procedure TForm4.FormPaint(Sender: TObject);
begin
  SwapBuffers;
end;

procedure TForm4.SwapBuffers;
begin
  BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
    bm.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TForm4.FormResize(Sender: TObject);
begin
  bm.SetSize(ClientWidth, ClientHeight);
end;

end.

Compiled sample EXE

请注意，此方法简单而强大，但在性能方面并非最佳。如果您尝试在Windows 3.1时代的计算机上运行此功能，则可能会出现此问题。

Answer 2

可以使用的另一种技术是使用Pen.Mode属性而无需创建位图。像这样：

  TForm2 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
   PO,LP: TPoint;
   draw: boolean;
  public
    { Public declarations }
  end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 PO.X:= X;
 PO.Y:= Y;
 LP.X:= X;
 LP.Y:= Y;
 draw:= true;
 Canvas.Pen.Mode:= pmNotXor;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if draw then
  begin
   if (LP.X <> PO.X) or (LP.Y <> PO.Y) then
    begin
     Canvas.MoveTo(PO.X,PO.Y);
     Canvas.LineTo(LP.X,LP.Y);
    end;
   LP.X:= X;
   LP.Y:= Y;
   Canvas.MoveTo(PO.X,PO.Y);
   Canvas.LineTo(LP.X,LP.Y);
  end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if draw then draw:= false;
end;

如何使用鼠标拖动绘制线条？

2 个答案: