3

The problem is: I draw some rectangle on the desktop, while mouse moving(rectangle size increases) I dont have lags, artefacts, etc, All is good: enter image description here

But when I resize rectangle to lower than it was beed, I have the artefact: enter image description here

The red rectangle is the real rectangle, all other is the bug.

The perfect solution is redraw the canvas, but I can't do it all time while mouse is moving.

Is there solution to do some when mouse absolute stops after moving?

Update

The code:

    unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    isDown: Boolean;
    downX, downY: Integer;
  public
    { Public declarations }
    Bild: TBitMap;
  end;

implementation

{ Form props: BorderStyle= bsNone AlphaBlend true, 150 Transparentcolor = true, clBlack }

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  Bild := TBitMap.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  Bild.Free;
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  isDown := true;
  downX := X;
  downY := Y;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
const
  cVal = 4;
begin
  if isDown then
  begin
    Self.Canvas.Lock;
    Self.Repaint;
    Self.Canvas.Pen.Color := clNone;
    Self.Canvas.Pen.Width := 1;

    Self.Canvas.Pen.Style := psDot;
    //Self.Canvas.Pen.Mode := pmNotCopy;
    Self.Canvas.Brush.Color := clGreen;
    Self.Canvas.Rectangle(downX, downY, X, Y);
    Self.Canvas.Pen.Style := psSolid;
    Self.Canvas.Brush.Color := clNone;
    Self.Canvas.Unlock;
    { Self.Canvas.Rectangle(downX - cVal, downY - cVal, downX + cVal, downY + cVal);
     Self.Canvas.Rectangle(X - cVal, Y - cVal, X + cVal, Y + cVal);
     Self.Canvas.Rectangle(X - cVal, downY - cVal, X + cVal, downY + cVal);
     Self.Canvas.Rectangle(downX - cVal, Y - cVal, downX + cVal, Y + cVal);

     Self.Canvas.Rectangle(downX - cVal, (downY + Y) div 2 - cVal, downX + cVal,
       (downY + Y) div 2 + cVal);
     Self.Canvas.Rectangle(X - cVal, (downY + Y) div 2 - cVal, X + cVal,
       (downY + Y) div 2 + cVal);

     Self.Canvas.Rectangle((downX + X) div 2 - cVal, downY - cVal,
       (downX + X) div 2 + cVal, downY + cVal);
     Self.Canvas.Rectangle((downX + X) div 2 - cVal, Y - cVal, (downX + X) div 2 + cVal,
       Y + cVal);   }
  end;
end;

function CaptureRect(aRect: TRect; out aBmp: TBitmap): Boolean;
var
  ScreenDC: HDC;
begin
  Result := False;
  try
    with aBmp, aRect do
    begin
      Width := Right - Left;
      Height := Bottom - Top;
      ScreenDC := GetDC(0);
      try
        BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
      finally
        ReleaseDC(0, ScreenDC);
      end;
    end;
  except
  end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r: TRect;
begin
  isDown := false;
  r.Left := downX;
  r.Top := downY;
  r.Right := X;
  r.Bottom := Y;
  CaptureRect(r, Bild);
  Self.Close;
end;

end.
AlexLL
  • 165
  • 1
  • 13
  • 2
    You can overdraw the *old rectangle* by a pen with `pmXor` mode. – TLama Jul 24 '14 at 10:56
  • nope, this didn't work. – AlexLL Jul 24 '14 at 11:23
  • 2
    Do you have any code? And what makes you think you can draw on a window that you don't own. How would you like it if some other app started drawing on your windows? Would you be surprised if your program stopped working? Would you try to deal with that by changing your code to adapt, or would you blame the other program? Do you understand how painting works? Specifically that windows need to be able to update themselves at any time in response to `WM_PAINT` messages, and need not have persistent state. – David Heffernan Jul 24 '14 at 11:29

2 Answers2

7

Your problem is that you are painting in the wrong place. Stop painting in the OnMouseMove event handler. Move the painting code to a paint handler. For example the form's OnPaint handler.

Then, in the OnMouseMove event handler, and indeed OnMouseDown and OnMouseUp, call Invalidate on the form, or the Win32 InvalidateRect function, to force a paint cycle.

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
1

Paint into a layered window instead. That will give you great speed without the artefacts, and Windows takes care of the drawing.

A layered window is a window that is created by specifying WS_EX_LAYERED when creating the window with the CreateWindowEx function. Later you can use UpdateLayeredWindow in order to set the content of this window. That way you can paint on top of a canvas without modifying the content of the canvas.

Of course this is a more advanced approach to solving your problem. So you need to have some knowledge about the Windows API.

Sebastian Z
  • 4,520
  • 1
  • 15
  • 30
  • Can you please describe more simply what you mean under "Paint into layered window instead"? My english dictionary isn't so perfect to understand that in true way. – AlexLL Jul 24 '14 at 11:36
  • I use window with bsNone and width & height are equal to screen size – AlexLL Jul 24 '14 at 11:39
  • @AlexLL If you won't show any code, we just have to guess at what you are doing. That's not at all productive. If you want help you'll make more of an effort to make it clear to all of us what you are doing. Until you do that, it's going to be a rather fruitless and painful exercise. – David Heffernan Jul 24 '14 at 11:56
  • @Srbastian_Z, answer please. – AlexLL Jul 24 '14 at 13:34
  • I updated my answer. But now that you have shown your code, there is probably an easier way to archive the desired result. – Sebastian Z Jul 24 '14 at 15:46
  • I think that the solution provided by DavidH is better, but yours is also Interesting (alternative solution). – Gabriel Sep 07 '20 at 09:04