【问题标题】:Menu rollovers flicker - How to account for Mouse Leave activity菜单翻转闪烁 - 如何解释鼠标离开活动
【发布时间】:2014-05-29 15:07:19
【问题描述】:

我正在构建一个自定义菜单,并且在链接上的悬停状态方面遇到了一些问题。现在,经过多次修补,我设法让我的菜单矩形正确响应鼠标悬停状态 - 几乎。

一旦鼠标离开矩形,我终生无法弄清楚如何让它们恢复正常 - 它仍处于悬停状态。移动到不同的矩形会正确重置,画布上的其他任何地方都被视为仍然在最后一个悬停的矩形中。

我的 MouseMove 过程。

procedure TOC_MenuPanel.MouseMove(Shift:TShiftState; X,Y:Integer);
var
  i : integer;
begin
 pt := Mouse.CursorPos;
 pt := ScreenToClient(pt);
 for i := 0 to High(MenuRects) do
   begin
     if PtInRect(MenuRects[i], Point(X, Y)) then
        begin
           chosenRect := i;
           Refresh;
        end
     else
        begin
           chosenRect := -1;
        end;
   end;
   inherited;
end;

还有我的绘画程序:

procedure TOC_MenuPanel.Paint;
var
  // TextStyle: TTextStyle;
  R, itemR: TRect;
  count : Integer;
  x1,y1,x2,y2 : Integer;

begin
  // Set length of array
  SetLength(MenuRects, fLinesText.Count);

// Set TRect to Canvas size
R := Rect(5, 5, Width-5, Height-5);
x1 := 10;
y1 := 10;
x2 := Width-10;

inherited Paint;

with Canvas do begin
  // Set fonts
  Font.Height := MenuFontHeight;
  Font.Color := clWhite;

  // Draw outerbox
  GradientFill(R, clLtGray, clWhite, gdVertical);

  // Draw inner boxes
  if fLinesText.Count = 0 then exit
     else
  for count := 0 to fLinesText.Count - 1 do
     begin
       // Define y2
       y2 := TextHeight(fLinesText.strings[count])*2;

       itemR := Rect(x1, y1, x2, y2*(count+1));
       Pen.color := clGray;

     // Test against chosenRect value and compare mouse position against that of the rectangle
       if (chosenRect = count) and (PtInRect(MenuRects[count], pt)) then
          Brush.color := stateColor[bttn_on]
       else
          Brush.color := stateColor[bttn_off];

       Rectangle(itemR);

       // Push rectangle info to array
       MenuRects[count] := itemR;

       // Draw the text
       TextRect(itemR, x1+5,  y1+5, fLinesText.strings[count]);

       // inc y1 for positioning the next box
       y1 := y1+y2;
     end;
  end;
end;

【问题讨论】:

  • 这就是我昨天的tried to comment。仅当您移动到不同的项目时才应该使控件无效,而不是每次移动鼠标。
  • 是的,我记得,Tlama,我对 Pascal 还是有点菜鸟,但慢慢来。目前只是一步一步地找到我的方式!

标签: delphi canvas paint mousemove


【解决方案1】:

您在鼠标移动事件处理程序中进行的绘制会立即丢失,因为您通过调用 Invalidate 强制绘制循环。作为一般规则,最好在一个绘制周期中对屏幕进行所有绘制。在某些情况下,在绘制周期之外进行绘制是有意义的,但众所周知,要做到正确是非常困难的。

所以,我怀疑您需要将所有绘图代码移动到您的绘图例程中,无论它是什么地方。因此,在鼠标移动事件中,您需要使表单或绘画框或任何绘制场景的内容无效。然后在您的绘图例程中使用GetCursorPosMouse.Pos 或类似方法来查找光标的位置。你用它来决定如何绘制场景。您可能会发现,在避免闪烁方面,将其绘制到屏幕外位图然后将其 blit 到画布上会更有效。

现在,如果您在每次鼠标移动时都无效,那么您可能会发现绘画负担过重。所以也许你应该跟踪最近绘制的场景的状态。在鼠标移动处理程序中测试新状态是否与最近绘制的不同。只有当它确实不同时,您才会强制执行绘制周期。

【讨论】:

    【解决方案2】:

    错误出现在 MouseMove 过程中,以下会产生正确的行为:

    procedure TOC_MenuPanel.MouseMove(Shift:TShiftState; X,Y:Integer);
    var
      i : integer;
    begin
     // Get cursor position within the control
     pt := Mouse.CursorPos;
     pt := ScreenToClient(pt);
    
     // loop through Array of Rectangles
     for i := 0 to High(MenuRects) do
       begin
         if PtInRect(MenuRects[i], Point(X, Y)) then
            begin
               chosenRect := i;
               Break; // If statement evaluates to true, stop the loop
            end
         else
            begin
               chosenRect := -1;
            end;
    
       end;
       Refresh; // Refresh the canvs
    inherited;
    end; 
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2018-12-06
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多