2

I'm trying to draw a vertical line at the X position of the cursor that would move with the mouse. This line would have to be drawn 'on top' of all components on my form. To achieve this, i'm using a piece of code provided here : https://stackoverflow.com/a/4481835 .

Here is the code of the full form :

    unit UDemo;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, AdvSmoothTimeLine, ImgList, StdCtrls, ComCtrls, ExtCtrls,
      System.ImageList, Vcl.AppEvnts;

    type
      TForm235 = class(TForm)
        ImageList1: TImageList;
        Panel1: TPanel;
        DateTimePicker1: TDateTimePicker;
        Edit1: TEdit;
        Button1: TButton;
        ComboBox1: TComboBox;
        ApplicationEvents1: TApplicationEvents;
        Button2: TButton;
        Panel2: TPanel;
        Panel3: TPanel;
        Panel4: TPanel;
        Panel5: TPanel;
        Panel6: TPanel;
        Panel7: TPanel;
        Panel8: TPanel;
        Panel9: TPanel;
        Panel10: TPanel;
        Panel11: TPanel;
        Panel12: TPanel;
        procedure FormCreate(Sender: TObject);

        procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
        procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
      private
        { Private declarations }
        FSelecting : Boolean;
        FSelectRect : TRect;
        FFixedLineX : Integer;
        FDragLineX : Integer;
        FMousePt, FOldPt: TPoint;
        procedure WM_PAINT(var Msg: TWmPaint); message WM_PAINT;
      public
        { Public declarations }
      end;

    var
      Form235: TForm235;

    implementation

    {$R *.dfm}


    procedure TForm235.ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    var
      R: TRect;
      Pt: TPoint;
    begin
      if Msg.message = WM_MOUSEMOVE then begin

        // assume no drawing (will test later against the point).
        // also, below RedrawWindow will cause an immediate WM_PAINT, this will
        // provide a hint to the paint handler to not to draw anything yet.
        FMousePt := Point(-1, -1);


        // first, if there's already a previous rectangle, invalidate it to clear
        if (FOldPt.X > 0) and (FOldPt.Y > 0) then begin
          R := Rect(FOldPt.X -1, 0, FOldPt.X + 1, self.Height);
          InvalidateRect(Handle, @R, True);

          // invalidate childs
          // the pointer could be on one window yet parts of the rectangle could be
          // on a child or/and a parent, better let Windows handle it all
          RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
        end;


        // is the message window our form?
        if Msg.hwnd = Handle then
          // then save the bottom-right coordinates
          FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam))
        else begin
          // is the message window one of our child windows?
          if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then begin
            // then convert to form's client coordinates
            Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
            windows.ClientToScreen(Msg.hwnd, Pt);
            FMousePt := ScreenToClient(Pt);
          end;
        end;

        // will we draw?  (test against the point)
        if PtInRect(ClientRect, FMousePt) then begin
          R := Rect(FMousePt.X - 1, 0, FMousePt.X +1, self.Height);
          InvalidateRect(Handle, @R, False);
        end;
      end;
    end;

    procedure TForm235.WM_PAINT(var Msg: TWmPaint);
    var
      DC: HDC;
      Rgn: HRGN;
    begin
      inherited;

      if (FMousePt.X > 0) and (FMousePt.Y > 0) then begin
        // save where we draw, we'll need to erase before we draw an other one
        FOldPt := FMousePt;

        // get a dc that could draw on child windows
        DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);

        // don't draw on borders & caption
        Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top,
                              ClientRect.Right, ClientRect.Bottom);
        SelectClipRgn(DC, Rgn);
        DeleteObject(Rgn);

        // draw a red rectangle
        SelectObject(DC, GetStockObject(DC_BRUSH));
        SetDCBrushColor(DC, ColorToRGB(clBlack));
        FillRect(DC, Rect(FMousePt.X - 1, 0, FMousePt.X +1, self.Height ), 0);

        ReleaseDC(Handle, DC);
      end;
    end;




    procedure TForm235.FormCreate(Sender: TObject);
    begin
      FSelectRect := TRect.Create(TPoint.Create(self.Left, self.Top));
    end;


    procedure TForm235.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    begin
        FSelectRect.Bottom :=   self.Height;
        FSelectRect.Right := X;
        FDragLineX := X;

        self.Repaint;

    end;

    end.

It works like I wanted it to except for one thing. The line flickers from constantly being drawn and undrawn from the screen when you move the mouse left and right (and so changing X position). When moving relatively rapidly you can also notice the line 'lagging behind' the cursor.

Does anyone has an idea on how to improve this visual effect? Another technic / algorithm? A dedicated component somewhere?

Community
  • 1
  • 1
mathieu
  • 235
  • 2
  • 11
  • What is the purpose of this line drawing? Why do you have a TRect in your code? – Tom Brunberg Oct 25 '16 at 17:33
  • @Tom, the rect is used at various places for invalidating and painting a rectangular region. What exactly is it that you ask? – Sertac Akyuz Oct 25 '16 at 21:00
  • @Sertac, ok for rect. I ask what the purpose of the whole line drawing is, because there are a few solutions but they are open ended if the line needs to be persistent for example. – Tom Brunberg Oct 25 '16 at 21:06
  • @Tom, ok. Of course I don't know why there is a traveling line. If I would have to guess, I'd think it's a projection of the mouse position to some kind of axis, but who knows... – Sertac Akyuz Oct 25 '16 at 21:09
  • Why are you even bothering drawing the line yourself and then figuring out which controls needs to be updated yourself. Wouldn't it be easier to simply create two new components which would be representing your lines and then change their positions accordingly to the mouse movment and let the windows do all the redrawing when needed. All you would have to take care is that these components won't handle any mouse or keyboard messages but let other windows of your program to handle them. – SilverWarior Oct 25 '16 at 21:32
  • Ok maybe more explanation is needed here on what i'm trying to achieve. What I want to do is an interactive way of selecting a section of the form by drag and drop. So basically the line follow the cursor, then the user press the left mouse button (mouse down) and drag to the right (or left) to another X position. A vertical line persist at the first X position and a second one start to follow the cursor to the second spot (where the left mouse button is released- mouse up). This would be used to select a portion of a timeline to zoom on. – mathieu Oct 26 '16 at 14:38

1 Answers1

2

Painting is low priority, a WM_PAINT is dispatched only after the message queue is emptied. Although posted, input messages are higher priority. Hence lagging as you observe is normal behavior.

If you want to avoid that you should give up invalidating and instead paint what you want when you want it. Of course, then, erasing will be your responsibility too. For that, one way would be to capture an image without any drawing and later paste it when you want to erase. With buttons and similar controls on the form which can change their appearances, that's going to prove near to be impossible. Another way could be to keep track of areas of child, grand child controls where the line is going to be removed, and then have them paint themselves without waiting a paint cycle. I'd expect that to be quite complicated. Additionally, all of your application's performance will suffer. You'll probably later ask, "why does my mouse pointer stutter?".


Test with the below version. Instead of invalidating a rectangle when the mouse is moved, it directly draws a rectangle. The implication is that, for every mouse move notification a line is drawn as opposed to the version in the question where paint messages may be consolidated. Invalidation of the child controls is still left to the system and, noticeably, it is still possible to observe lag behavior, especially on edit controls. I don't know any fix for that. Apart from that, performance is less adversely effected to my expectations.

One thing I noticed when I attempted to compile your test case, the most obvious obstacle for smooth behavior is one addition of yourself to the code, which is the Repaint call in OnMouseMove. You have to remove that, I don't know why do you thought you needed that.

procedure TForm235.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  R: TRect;
  Pt: TPoint;
  DC:  HDC;
  Rgn: HRGN;
begin
  if Msg.message = WM_MOUSEMOVE then begin
    FMousePt := Point(-1, -1);
    if (FOldPt.X > 0) and (FOldPt.Y > 0) then begin
      R := Rect(FOldPt.X -1, 0, FOldPt.X + 1, self.Height);
      InvalidateRect(Handle, @R, True);
      RedrawWindow(Handle, @R, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
    end;
    if Msg.hwnd = Handle then
      FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam))
    else begin
      if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then begin
        Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
        winapi.windows.ClientToScreen(Msg.hwnd, Pt);
        FMousePt := ScreenToClient(Pt);
      end;
    end;
    if PtInRect(ClientRect, FMousePt) then begin
      R := Rect(FMousePt.X - 1, 0, FMousePt.X +1, self.Height);
      FOldPt := FMousePt;
      DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);
      Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top,
                            ClientRect.Right, ClientRect.Bottom);
      SelectClipRgn(DC, Rgn);
      DeleteObject(Rgn);
      SelectObject(DC, GetStockObject(DC_BRUSH));
      SetDCBrushColor(DC, ColorToRGB(clBlack));
      FillRect(DC, Rect(FMousePt.X - 1, 0, FMousePt.X +1, self.Height ), 0);
      ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TForm235.WMPaint(var Message: TWMPaint);
begin
  inherited;
end;
Sertac Akyuz
  • 54,131
  • 4
  • 102
  • 169
  • Thank you very much for your time and explanations. So if I follow correctly there is no "smooth" way to achieve what i'm doing -> having a vertical line following the cursor and being over some components already drawn. – mathieu Oct 26 '16 at 14:48
  • @tab - You're welcome. The performance of the application/system will be effected negatively, however that may not imply **there is no "smooth" way"*, the machine may still be able to handle smooth movement depending on other factors. Considering why do you need it, regarding your comment to Silver on the question, it is utterly unnecessary if you ask me. – Sertac Akyuz Oct 26 '16 at 15:08