How to draw a line using mouse drag?

后端 未结 2 1956
失恋的感觉
失恋的感觉 2021-01-07 14:43

I need to draw a line in delphi using the cursor, I already have created the line code, but I can\'t get what to do next? How can do that, I push the mouse, when the line ne

相关标签:
2条回答
  • 2021-01-07 15:11

    Something like this:

    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

    Notice that this method is simple and robust, but not optimal in terms of performance. This will likely be an issue if you try to run this on a Windows 3.1-era computer.

    0 讨论(0)
  • 2021-01-07 15:23

    Another technique that can be used, without the need to create a bitmap, is using the Pen.Mode property. Something like this:

      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;
    
    0 讨论(0)
提交回复
热议问题