마우스 위치에서 구성 요소를 그릴 때 깜박임

Question

마우스로 움직일 커서의 X 위치에 수직선을 그리려고합니다. 이 선은 내 양식의 모든 구성 요소 위에 그려야합니다. 이를 위해 여기 제공된 코드를 사용하고 있습니다 : https://stackoverflow.com/a/4481835. 내가 한 가지를 제외하고 그것을 원하는 것 작동

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. 

: 여기

전체 양식의 코드입니다. 마우스를 왼쪽이나 오른쪽으로 움직일 때 (그리고 X 위치가 바뀌기 때문에) 화면에서 선이 끊임없이 그려지고 펼쳐지는 것을 깜박입니다. 비교적 빠르게 움직일 때 커서의 '뒤에서'선을 볼 수 있습니다.

누구나 시각 효과를 향상시키는 방법에 대한 아이디어가 있습니까? 또 다른 기술/알고리즘? 전용 구성 요소 어딘가에?

Answer 1

그림의 우선 순위가 낮 으면 메시지 큐를 비운 후에 만 ​​WM_PAINT가 전달됩니다. 게시되었지만 입력 메시지는 우선 순위가 높습니다. 따라서 지연된은 정상적인 동작입니다.

당신이 무효화를 포기하고 그것을 원할 때 원하는 것을 페인트하는 것을 피하고 싶다면. 물론 지우는 것도 당신의 책임입니다. 이를 위해 한 가지 방법은 드로잉없이 이미지를 캡처 한 후 붙여 넣기 지울 때 사용합니다. 모양에 변화를 줄 수있는 버튼과 유사한 컨트롤이 있으면 거의 불가능한 것으로 드러날 것입니다. 또 다른 방법은 어린이, 그랜드 자식 컨트롤의 영역을 추적하여 제거 할 위치를 찾은 다음 페인트 사이클을 기다리지 않고 자체 페인트 할 수있게하는 것입니다. 나는 그것이 매우 복잡 할 것으로 기대한다. 또한 응용 프로그램의 모든 성능이 저하됩니다. 나중에 "왜 내 마우스 포인터가 더듬 거리지?"라고 물어볼 것입니다.

---

아래 버전으로 테스트하십시오. 마우스를 움직일 때 사각형을 무효화하는 대신 직사각형을 그립니다. 모든 마우스 이동 알림에 대해 페인트 메시지를 통합 할 수있는 질문의 버전과 반대로 라인이 그려지는 것입니다. 하위 컨트롤의 무효화는 여전히 시스템에 남아 있으며, 특히 편집 컨트롤에서 지연 동작을 관찰 할 수 있습니다. 나는 어떤 고정 모르겠다. 그 외에는 성능이 내 기대에 덜 해 롭습니다.

테스트 사례를 컴파일하려고 할 때 알아 차린 것 중 하나는 원활한 동작을위한 가장 분명한 장애물은 Repaint 코드 인 OnMouseMove에 코드를 추가하는 것입니다. 그걸 지워야 만하는데, 왜 니가 필요하다고 생각하니?

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;