Как нарисовать линию с помощью перетаскивания мышью?

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.

Скомпилированный образец 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;