我正在构建一个自定义菜单,并一直有一些问题的悬停状态上的链接。现在,经过许多修补,我已经设法使我的菜单矩形正确地响应鼠标悬停状态-几乎。
我不能为我的生活想出如何让他们恢复正常,一旦鼠标离开矩形-它仍然停留在它的徘徊状态。正确地移动到不同的矩形重置,画布上的任何其他位置都被视为仍然在最后一个矩形上徘徊。
我的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;发布于 2014-06-04 12:51:10
错误发生在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; 发布于 2014-05-29 15:13:38
您在鼠标移动事件处理程序中所做的绘制立即丢失,因为您通过调用Invalidate强制绘制周期。通常情况下,最好是在一个油漆周期内对屏幕进行所有的绘画。在某些情况下,在油漆周期之外进行绘画是有意义的,但众所周知,这是很难做到的。
因此,我怀疑您需要将所有的绘图代码移到您的画图例程中,无论是在何处,还是在任何地方。因此,在鼠标移动事件中,您需要使窗体或画框或其他绘制场景的内容失效。然后在画图例程中使用GetCursorPos或Mouse.Pos或类似的方法来查找光标的位置。你用它来决定如何画场景。你很可能会发现,在避免闪烁方面,画到屏幕外的位图上,然后把它涂到画布上会更有效。
现在,如果您对每一个鼠标移动无效,那么您可能会发现绘画负担过大。所以,也许你应该跟踪最近的绘画场景的状态。在鼠标移动处理程序中测试新状态是否与最近绘制的状态不同。只有当它确实不同时,你才会强制画一个循环。
https://stackoverflow.com/questions/23936550
复制相似问题