Delphi在调整大小时避免没有边框的表单从右边缘和下边缘闪烁[重复]

Question

           我已经完成了我的工作，但我遇到了这个闪烁问题
当我想从左边距
或底部边距调整我的表单（BorderStyle 属性中有 bsNone）时，请先尝试这个示例（完整代码内）：
My Example =>

最后是代码：

const
  // frame Width
  BORDER_WIDTH = 5;
  // Key performance indicators (top-left, top-right ...)
  EDGE_SIZE = 15;    
var
  Form1: TForm1;    
implementation    
{$R *.dfm} 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  fRect: TRect;
  fPos: TPoint;
  fChangedCursor: Boolean;
begin
  // Change cursor when the mouse pointer is located on the edge    
  fChangedCursor := False;
  fPos := Point(X, Y);    
  // top margin
  fRect := Rect(EDGE_SIZE, 0, Width - EDGE_SIZE, BORDER_WIDTH);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeNS;
    if ssLeft in Shift then
    begin
    // here the bottom Margin flickering
      ReleaseCapture;
      PerForm(WM_SysCommand, $F003, 0);
    end;
  end;    
  // right margin
  fRect := Rect(Width - BORDER_WIDTH, EDGE_SIZE, Width, Height - EDGE_SIZE);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeWE;
    if ssLeft in Shift then
    begin
      ReleaseCapture;
      PerForm(WM_SysCommand, $F002, 0);
    end;
  end;    
  // Bottom margin
  fRect := Rect(EDGE_SIZE, Height - BORDER_WIDTH, Width - EDGE_SIZE,    Height);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeNS;
    if ssLeft in Shift then
    begin
      ReleaseCapture;
      PerForm(WM_SysCommand, $F006, 0);
    end;
  end;    
  // left margin
  fRect := Rect(0, EDGE_SIZE, BORDER_WIDTH, Height - EDGE_SIZE);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeWE;
    if ssLeft in Shift then
    begin
    // here the Right Margin flickering
      ReleaseCapture;
      PerForm(WM_SysCommand, $F001, 0);
    end;
  end;    
  // Top left corner
  fRect := Rect(0, 0, EDGE_SIZE, EDGE_SIZE);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeNWSE;
    if ssLeft in Shift then
    begin
      // here the Both Margins flickering
      ReleaseCapture;
      PerForm(WM_SysCommand, $F004, 0);
    end;
  end;    
  // Top right corner
  fRect := Rect(Width - EDGE_SIZE, 0, Width, EDGE_SIZE);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeNESW;
    if ssLeft in Shift then
    begin
      // here the both Margins flickering
      ReleaseCapture;
      PerForm(WM_SysCommand, $F005, 0);
    end;
  end;    
// Bottom right corner
  fRect := Rect(Width - EDGE_SIZE, Height - EDGE_SIZE, Width, Height);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeNWSE;
    if ssLeft in Shift then
    begin
    // here the both Margins flickering a Little
      ReleaseCapture;
      PerForm(WM_SysCommand, $F008, 0);
    end;
  end;    
  // Bottom left corner
  fRect := Rect(0, Height - EDGE_SIZE, EDGE_SIZE, Height);
  if PtInRect(fRect, fPos) then
  begin
    fChangedCursor := True;
    Cursor := crSizeNESW;
    if ssLeft in Shift then
    begin
    // here the Right Margin flickering
      ReleaseCapture;
      PerForm(WM_SysCommand, $F007, 0);
    end;
  end;    
  // Standardcursor    
 if not fChangedCursor then
    Cursor := crDefault;
end;

Answer 1

我不确定您遇到闪烁的原因是什么，但您检测鼠标是否在边缘的代码有点缺陷。

我认为您的代码的主要问题是您指定的矩形相互重叠。

所以当鼠标光标放在Top Left corner 上时，Top border、Left border 和 Top Left 角的代码将执行。

这将导致连续调用ReleaseCapture 和PerForm(WM_SysCommand, ...) 三次。

所以我的第一个建议是更改您的边框检测代码，以防止同时调用多个单独边框的代码。

这是我在一个项目中使用的边界检测代码的简化示例：

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var LeftEdge,RightEdge,TopEdge,BottomEdge: Boolean;
    BorderPosition: TBorderPos;
    BorderWidth: Integer;
begin
  BorderWidth := 20;
  LeftEdge := False;
  RightEdge := False;
  TopEdge := False;
  BottomEdge := False;
  //Check if mouse cursor is on left or right edge
  if X < BorderWidth then
  begin
    LeftEdge := True;
  end
  else if X > Self.Width-BorderWidth then
  begin
    RightEdge := True;
  end;

  //Check if mouse cursor is on top or bottom edge
  if Y < BorderWidth then
  begin
    TopEdge := True;
  end
  else if Y > Self.Height-BorderWidth then
  begin
    BottomEdge := True;
  end;

  //Get border position by using if..else if..else clause in order for if block
  //to break as soon as one of the conditions is met
  //First check for corners
  if TopEdge and LeftEdge then BorderPosition := bpTopLeft
  else if TopEdge and RightEdge then BorderPosition := bpTopRight
  else if BottomEdge and LeftEdge then BorderPosition := bpBottomLeft
  else if BottomEdge and RightEdge then BorderPosition := bpBottomRight
  //and only then check for individual edges
  else if TopEdge then BorderPosition := bpTop
  else if BottomEdge then BorderPosition := bpBottom
  else if LeftEdge then BorderPosition := bpLeft
  else if RightEdge then BorderPosition := bpRight
  //mouse cursor is not on any border edge
  else BorderPosition := bpNone;

  //Finally you can use case statement to execute needed code based on which
  //border edge is your mouse cursor positioned
  case BorderPosition of
    bpNone: Label1.Caption := 'Not on border';
    bpLeft: Label1.Caption := 'Left border';
    bpRight: Label1.Caption := 'Right border';
    bpTop: Label1.Caption := 'Top border';
    bpBottom: Label1.Caption := 'Bottom border';
    bpTopLeft: Label1.Caption := 'Top Left corner';
    bpTopRight: Label1.Caption := 'Top Right corner';
    bpBottomLeft: Label1.Caption := 'Bottom Left corner';
    bpBottomRight: Label1.Caption := 'Bottom Right corner';
  end;
end;

如果需要，您甚至可以用四个变量替换当前的 BorderWidth 变量（每个变量都有自己的边缘）。

如果没有别的，我的代码应该为您提供更好的性能，因为它避免了八次针对矩形检查点位置的代码。