Delphi样式问题TDBGrid垂直滚动时滚动不稳定

时间:2015-03-19 07:09:30

标签: delphi vcl vcl-styles tdbgrid

我正在使用带有样式的Delphi XE5。

当使用具有足够记录的DBGrid来显示垂直滚动条时,单击并拖动滚动条会导致动画不稳定。网格不断重新绘制/更新。

如果我将DBGRID.StyleElement.seBorder设置为False,它的行为正常,例如您可以将滚动条拖动到顶部或底部,而无需更改/重新绘制网格,直到您按下鼠标按钮。

当样式打开时,有没有办法让垂直滚动条显示?

1 个答案:

答案 0 :(得分:0)

这就是我在滚动时使样式网格的行为与非样式网格相似的行为。

unit xStyleFixes;

interface
uses forms, Vcl.Buttons, Vcl.StdCtrls, Windows, Messages, SysUtils, Classes, Graphics, Controls, themes, Wwdbgrid, typinfo, DBGrids;

type
  TFixScrollingStyleHook = class (TScrollingStyleHook)
    var ScrollBarthumbBtnWasPressed : Boolean;
    procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;
 end;

implementation

procedure TFixScrollingStyleHook.WMVScroll(var Msg: TMessage); 
var sTest : String;
begin
  if VertSliderState = tsThumbBtnVertPressed then begin
    ScrollBarthumbBtnWasPressed := true;
    Handled := True;
  end else begin
    if ScrollBarthumbBtnWasPressed then begin
      if Self.VertTrackRect.TopLeft = self.VertSliderRect.TopLeft then
        TWMVScroll(Msg).ScrollCode := SB_TOP;
      if Self.VertTrackRect.BottomRight = self.VertSliderRect.BottomRight then
        TWMVScroll(Msg).ScrollCode := SB_BOTTOM;
      ScrollBarthumbBtnWasPressed := False;
    end;
    CallDefaultProc(TMessage(Msg));
    PaintScroll;
  end;
end;

initialization
  TCustomStyleEngine.RegisterStyleHook(TWWDbGrid, TFixScrollingStyleHook );
  TCustomStyleEngine.RegisterStyleHook(TDbGrid, TFixScrollingStyleHook );
end.

这是我第一次玩Style钩子,所以如果你能看到更好的方法,请告诉我们