TEdit неправильно перерисовывает с Invalidate в Delphi 5

Существует проблема с TScrollBox в Delphi 5 при использовании Cirtix, в некоторых системах, когда пользователь прокручивает, нажимая кнопку в верхней или нижней части конца полосы прокрутки, все приложение зависает. Изначально у нас была проблема с предварительными версиями QucikReports, и мы решили ее, реализовав собственные полосы прокрутки в TScrollBox.

Теперь у нас есть заказная работа, в которой используется TScrollBox, и клиент сообщает о похожей проблеме, поэтому я работаю над ней таким же образом. Я скрываю полосы прокрутки TScrollBox и добавляю свои собственные. Когда они нажаты, я вызываю следующее.

Обратите внимание, что этот тестовый код в настоящее время не работает в Citrix, я тестировал его в XP и Window 7.

Я отключаю перерисовку элемента управления, перемещаю все дочерние элементы управления, затем снова включаю рисование и вызываю Invalidate. Я бы ожидал, что аннулирование полностью перерисует элемент управления, но этого не происходит.

procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
begin
  if (x = 0) and (y = 0) then
    Exit;

  // Stop the control from repaining while we're updating it
  try
    SendMessage(FScrollBox.Handle, WM_SETREDRAW, 0, 0);

    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      if (FScrollBox.Controls[I] = FVScrollBar) or (FScrollBox.Controls[I] = FHScrollBar) then
        Continue;

      FScrollBox.Controls[I].Left := FScrollBox.Controls[I].Left + x;
      FScrollBox.Controls[I].Top := FScrollBox.Controls[I].Top + y;
    end;

  finally
    // Turn on painting again
    SendMessage(FScrollBox.Handle, WM_SETREDRAW, 1, 0);
  end;
  // Redraw everything
  InvalidateEverything(FScrollBox);
end;

Код для перерисовки элементов управления

procedure TScrollBoxScrollReplacement.InvalidateEverything(AControl: TControl);
var
  I: Integer;
begin
  AControl.Invalidate();

  if (AControl is TWinControl) then
    for I := 0 to TWinControl(AControl).ControlCount - 1 do
      InvalidateEverything(TWinControl(AControl).Controls[I]);
end;

Я добавил Invalidate, Refresh и Reapint и перебрал все дочерние элементы управления, чтобы заставить его работать, но все равно не повезло. Поля редактирования выглядят следующим образом:

Если я установлю для параметра Visible значение false, а затем верну его в значение true, они будут правильно перерисовываться, но, очевидно, будет ужасное мерцание. Они также правильно перерисовываются, если я сворачиваю, разворачиваю окно или перетаскиваю его на экран.

Любая помощь приветствуется.

изменить: немного информации об ответах.

Пользователям, ищущим решение, я бы порекомендовал вам попробовать оба. Дэвида и Сертака. Согласно документации Microsoft, решение Дэвида выглядит правильным. Однако в полосе прокрутки Delphi метки, размещенные непосредственно в полосе прокрутки, мерцают, в то время как метки, размещенные в групповых полях в полосе прокрутки, совершенно гладкие. Я думаю, что это может быть проблемой для всех компонентов, которые не происходят от TWinControl. Прокрутка сама по себе более плавная с решением Дэвида, но меньше щелкает с помощью WM_SETREDRAW и RedrawWindow. Я хотел бы принять оба ответа, поскольку оба имеют свои преимущества и недостатки.

изменить: код для всего класса ниже. Чтобы протестировать, просто добавьте в форму полосу прокрутки с некоторыми элементами управления и вызовите

TScrollBoxScrollReplacement.Create(ScrollBox1);

.

unit ScrollBoxScrollReplacement;

interface

uses extctrls, stdctrls, SpScrollBox, forms, Controls, classes, Messages, Windows, Sysutils, Math;

type
  TScrollBoxScrollReplacement = class(TComponent)
  private
    FLastVScrollPos: Integer;
    FLastHScrollPos: Integer;
    FScrollBox: TScrollBox;
    FVScrollBar: TScrollBar;
    FHScrollBar: TScrollBar;
    FVScrollBarVisible: Boolean;
    FHScrollBarVisible: Boolean;
    FCornerPanel: TPanel;
    FMaxRight: Integer;
    FMaxBottom: Integer;
    FOriginalResizeEvent: TNotifyEvent;
    FOriginalCanResizeEvent: TCanResizeEvent;
    FInScroll: Boolean;
    function GetHScrollHeight: Integer;
    function GetVScrollWidth: Integer;
    procedure ReplaceScrollBars;
    function SetUpScrollBar(AControlScrollBar: TControlScrollBar; AKind: TScrollBarKind): TScrollBar;
    procedure ScrollBoxResize(Sender: TObject);
    procedure ScrollBarEnter(Sender: TObject);
    procedure PositionScrollBars;
    procedure Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure ScrollControls(x, y: Integer);
    procedure CalculateControlExtremes();
    procedure ResetVScrollBarRange;
    procedure ResetHScrollBarRange;
    function IsReplacementControl(AControl: TControl): Boolean;
    property HScrollHeight: Integer read GetHScrollHeight;
    property VScrollWidth: Integer read GetVScrollWidth;
    procedure ScrollBoxCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  public
    constructor Create(AScrollBox: TScrollBox); reintroduce; overload;
    destructor Destroy(); override;
    procedure ResetScrollBarRange();
    procedure BringReplacementControlsToFront();
  end;

implementation

{ TScrollBoxScrollReplacement }

constructor TScrollBoxScrollReplacement.Create(AScrollBox: TScrollBox);
begin
  // Set up the scrollbox as our owner so we're destroyed when the scrollbox is
  inherited Create(AScrollBox);

  FScrollBox := AScrollBox;
  ReplaceScrollBars();

  // We make a note of any existing resize and can resize events so we can call them to make sure we don't break anything
  FOriginalResizeEvent := FScrollBox.OnResize;
  FScrollBox.OnResize := ScrollBoxResize;

  FOriginalCanResizeEvent := FScrollBox.OnCanResize;
  FScrollBox.OnCanResize := ScrollBoxCanResize;
end;

// This is called (unintuitively) when controls are moved within the scrollbox. We can use this to reset our scrollbar ranges

procedure TScrollBoxScrollReplacement.ScrollBoxCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  if (not FInScroll) then
  begin
    ResetScrollBarRange();
    BringReplacementControlsToFront();
  end;

  if (Assigned(FOriginalCanResizeEvent)) then
    FOriginalCanResizeEvent(Sender, NewWidth, NewHeight, Resize);
end;


procedure TScrollBoxScrollReplacement.ScrollBoxResize(Sender: TObject);
begin
  if (Assigned(FOriginalResizeEvent)) then
    FOriginalResizeEvent(Sender);

  ResetScrollBarRange();
end;

// Hides the original scrollbars and adds in ours

procedure TScrollBoxScrollReplacement.ReplaceScrollBars();
begin
  FVScrollBar := SetUpScrollBar(FScrollBox.VertScrollBar, sbVertical);
  FVScrollBarVisible := FVScrollBar.Visible;
  FHScrollBar := SetUpScrollBar(FScrollBox.HorzScrollBar, sbHorizontal);
  FHScrollBarVisible := FHScrollBar.Visible;

  FCornerPanel := TPanel.Create(FScrollBox);
  FCornerPanel.Parent := FScrollBox;

  ResetScrollBarRange();
end;


procedure TScrollBoxScrollReplacement.PositionScrollBars();
begin
  // Align our scrollbars correctly
  FVScrollBar.Top := 0;
  FVScrollBar.Left := FScrollBox.ClientWidth - FVScrollBar.Width;
  FVScrollBar.Height := FScrollBox.ClientHeight - HScrollHeight;
  //  FVScrollBar.BringToFront();

  FHScrollBar.Left := 0;
  FHScrollBar.Top := FScrollBox.ClientHeight - FHScrollBar.Height;
  FHScrollBar.Width := FScrollBox.ClientWidth - VScrollWidth;
  //  FHScrollBar.BringToFront();

    // If both scrollbars are visible we'll put a panel in the corner so we can't see components through it
  if (FVScrollBar.Visible) and (FHScrollBar.Visible) then
  begin
    FCornerPanel.Left := FHScrollBar.Width;
    FCornerPanel.Top := FVScrollBar.Height;
    FCornerPanel.Width := FVScrollBar.Width;
    FCornerPanel.Height := FHScrollBar.Height;
    FCornerPanel.Visible := True;
    //    FCornerPanel.BringToFront();
  end
  else
    FCornerPanel.Visible := False;
end;


procedure TScrollBoxScrollReplacement.ResetScrollBarRange();
begin
  CalculateControlExtremes();

  ResetVScrollBarRange();
  ResetHScrollBarRange();

  PositionScrollBars();
end;

procedure TScrollBoxScrollReplacement.ResetVScrollBarRange();
var
  ScrollMax: Integer;
  ScrollAmount: Integer;
begin
  // If all the controls fit to the right of the screen, but there are controls off the left then we'll scroll right.
  ScrollMax := FMaxBottom - FScrollBox.ClientHeight + FHScrollBar.Height;
  if (ScrollMax < 0) and (FLastVScrollPos > 0) then
  begin
    ScrollAmount := Min(Abs(ScrollMax), FLastVScrollPos);
    ScrollControls(0, ScrollAmount);
    FLastVScrollPos := FLastVScrollPos - ScrollAmount;
    CalculateControlExtremes();
  end;

  FVScrollBar.Max := Max(FMaxBottom - FScrollBox.ClientHeight + FHScrollBar.Height + FLastVScrollPos, 0);
  FVScrollBar.Visible := (FVScrollBar.Max > 0) and FVScrollBarVisible;
end;


procedure TScrollBoxScrollReplacement.ResetHScrollBarRange();
var
  ScrollMax: Integer;
  ScrollAmount: Integer;
begin
  // If all the controls fit to the bottom of the screen, but there are controls off the top then we'll scroll up.
  ScrollMax := FMaxRight - FScrollBox.ClientWidth + FVScrollBar.Width;
  if (ScrollMax < 0) and (FLastHScrollPos > 0) then
  begin
    ScrollAmount := Min(Abs(ScrollMax), FLastHScrollPos);
    ScrollControls(ScrollAmount, 0);
    FLastHScrollPos := FLastHScrollPos - ScrollAmount;
    CalculateControlExtremes();
  end;

  FHScrollBar.Max := Max(FMaxRight - FScrollBox.ClientWidth + FVScrollBar.Width + FLastHScrollPos, 0);
  FHScrollBar.Visible := (FHScrollBar.Max > 0) and FHScrollBarVisible;
end;


function TScrollBoxScrollReplacement.SetUpScrollBar(AControlScrollBar: TControlScrollBar; AKind: TScrollBarKind): TScrollBar;
begin
  Result := TScrollBar.Create(FScrollBox);
  Result.Visible := AControlScrollBar.Visible;
  Result.Parent := FScrollBox;
  Result.Kind := AKind;
  Result.Ctl3D := False;
  Result.Max := AControlScrollBar.Range;
  Result.OnEnter := ScrollBarEnter;
  Result.OnScroll := Scroll;
  Result.SmallChange := 5;
  Result.LargeChange := 20;

  AControlScrollBar.Visible := False;
end;

destructor TScrollBoxScrollReplacement.Destroy;
begin
  inherited;
end;

procedure TScrollBoxScrollReplacement.ScrollBarEnter(Sender: TObject);
begin
  // We just call this here to make sure our ranges are set correctly - a backup in case things go wrong
  ResetScrollBarRange();
end;

procedure TScrollBoxScrollReplacement.Scroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
var
  Change: Integer;
begin
  ResetScrollBarRange();

  if (Sender = FVScrollBar) then
  begin
    Change := FLastVScrollPos - ScrollPos;
    ScrollControls(0, Change);
    FLastVScrollPos := ScrollPos;
  end
  else if (Sender = FHScrollBar) then
  begin
    Change := FLastHScrollPos - ScrollPos;
    ScrollControls(Change, 0);
    FLastHScrollPos := ScrollPos;
  end;
end;

// Moves all the controls in the scrollbox except for the scrollbars we've added

{procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
begin
  if (x = 0) and (y = 0) then
    Exit;

  // Stop the control from repaining while we're updating it
  SendMessage(FScrollBox.Handle, WM_SETREDRAW, 0, 0);
  FInScroll := True;
  try
    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      if IsReplacementControl(FScrollBox.Controls[I]) then
        Continue;

      FScrollBox.Controls[I].Left := FScrollBox.Controls[I].Left + x;
      FScrollBox.Controls[I].Top := FScrollBox.Controls[I].Top + y;
    end;

  finally
    // Turn on painting again
    FInScroll := False;
    SendMessage(FScrollBox.Handle, WM_SETREDRAW, 1, 0);
  end;

  // Redraw everything
  RedrawWindow(FSCrollBox.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;  }


procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
  I: Integer;
  Control: TControl;
  WinControl: TWinControl;
  hWinPosInfo: HDWP;
begin
  if (x = 0) and (y = 0) then
    Exit;

  hWinPosInfo := BeginDeferWindowPos(0);
  Win32Check(hWinPosInfo<>0);
  try
    for I := 0 to FScrollBox.ControlCount - 1 do
    begin
      Control := FScrollBox.Controls[I];
      if (Control = FVScrollBar) or (Control = FHScrollBar) then
        Continue;
      if Control is TWinControl then
      begin
        WinControl := FScrollBox.Controls[I] as TWinControl;
        hWinPosInfo := DeferWindowPos(
          hWinPosInfo,
          WinControl.Handle,
          0,
          WinControl.Left + x,
          WinControl.Top + y,
          WinControl.Width,
          WinControl.Height,
          SWP_NOZORDER or SWP_NOOWNERZORDER or SWP_NOACTIVATE
        );
        Win32Check(hWinPosInfo<>0);
      end
      else
        Control.SetBounds(Control.Left + x, Control.Top + y, Control.Width, Control.Height);
    end;
  finally
    EndDeferWindowPos(hWinPosInfo);
  end;
end;



// works out where our right most and bottom most controls are so we can set the scrollbars correctly

procedure TScrollBoxScrollReplacement.CalculateControlExtremes();
var
  I: Integer;
  Right: Integer;
  Bottom: Integer;
begin
  FMaxRight := 0;
  FMaxBottom := 0;
  for I := 0 to FScrollBox.ControlCount - 1 do
  begin
    if IsReplacementControl(FScrollBox.Controls[I]) then
      Continue;

    Right := FScrollBox.Controls[I].Left + FScrollBox.Controls[I].Width;
    Bottom := FScrollBox.Controls[I].Top + FScrollBox.Controls[I].Height;

    FMaxRight := Max(FMaxRight, Right);
    FMaxBottom := Max(FMaxBottom, Bottom);
  end;
end;

function TScrollBoxScrollReplacement.GetHScrollHeight: Integer;
begin
  if (FHScrollBar.Visible) then
    Result := FHScrollBar.Height
  else
    Result := 0;
end;

function TScrollBoxScrollReplacement.GetVScrollWidth: Integer;
begin
  if (FVScrollBar.Visible) then
    Result := FVScrollBar.Width
  else
    Result := 0;
end;

// Returns true if the passed control is one of the controls we've added

function TScrollBoxScrollReplacement.IsReplacementControl(
  AControl: TControl): Boolean;
begin
  Result := (AControl = FVScrollBar) or (AControl = FHScrollBar) or (AControl = FCornerPanel);
end;

procedure TScrollBoxScrollReplacement.BringReplacementControlsToFront;
begin
  FVScrollBar.BringToFront();
  FHScrollBar.BringToFront();
  FCornerPanel.BringToFront();
end;

end.