Introduction
I am writing a custom control that is derived from a TScrollBox but I am having a few difficulties overcoming what seems like should be an easy enough problem to solve.
The control will be used to display a caption bar at the top which will be static (ie, never moves when the scrollbox is scrolled), and then underneath the caption bar I will be drawing some values within there own columns such as row numbers etc.
This is what the control currently looks like to give a better idea (very much a early work in progress):
Flicker Problem
The problem I am facing is flickering and I do not see an easy way to eliminate it. I have a feeling the flickering is been caused because I am trying to draw underneath my caption bar and when the flickering occurs you can actually see the values been drawing underneath the caption bar, although my assumption could be completely wrong.
All the drawing is done on a TGraphicControl which is child to the scrollbox, the flickering occurs a lot when scrolling fast, when using the scrollbar buttons it still flickers but not as frequently.
I am unable to catch the flickering and show as an image here, but with the code below you can build and install into a new package and test for yourself:
unit MyGrid;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.Classes,
System.SysUtils,
Vcl.Controls,
Vcl.Dialogs,
Vcl.Forms,
Vcl.Graphics;
type
TMyCustomGrid = class(TGraphicControl)
private
FFont: TFont;
FRowNumbers: TStringList;
FRowCount: Integer;
FCaptionBarRect: TRect;
FRowNumbersBackgroundRect: TRect;
FValuesBackgroundRect: TRect;
procedure CalculateNewHeight;
function GetMousePosition: TPoint;
function RowIndexToMousePosition(ARowIndex: Integer): Integer;
function GetRowHeight: Integer;
function RowExists(ARowIndex: Integer): Boolean;
function GetRowNumberRect(ARowIndex: Integer): TRect;
function GetRowNumberTextRect(ARowIndex: Integer): TRect;
function GetValueRect(ARowIndex: Integer): TRect;
function GetValueTextRect(ARowIndex: Integer): TRect;
function GetFirstVisibleRow: Integer;
function GetLastVisibleRow: Integer;
protected
procedure Paint; override;
procedure DrawCaptionBar;
procedure DrawRowNumbers;
procedure DrawValues;
procedure DrawColumnLines;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TMyGrid = class(TScrollBox)
private
FGrid: TMyCustomGrid;
protected
procedure Loaded; override;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
const
FCaptionBarHeight = 20;
FRowNumbersWidth = 85;
FValuesWidth = 175;
FTextSpacing = 5;
implementation
constructor TMyCustomGrid.Create(AOwner: TComponent);
var
I: Integer;
begin
inherited Create(AOwner);
FFont := TFont.Create;
FFont.Color := clBlack;
FFont.Name := 'Tahoma';
FFont.Size := 10;
FFont.Style := [];
FRowNumbers := TStringList.Create;
//FOR TEST PURPOSES
for I := 0 to 1000 do
begin
FRowNumbers.Add(IntToStr(I));
end;
Canvas.Font.Assign(FFont);
end;
destructor TMyCustomGrid.Destroy;
begin
FFont.Free;
FRowNumbers.Free;
inherited Destroy;
end;
procedure TMyCustomGrid.Paint;
begin
FCaptionBarRect := Rect(0, 0, Self.Width, GetRowHeight + TMyGrid(Self.Parent).VertScrollBar.Position + 2);
FRowCount := FRowNumbers.Count;
DrawRowNumbers;
DrawValues;
DrawCaptionBar;
DrawColumnLines;
end;
procedure TMyCustomGrid.DrawCaptionBar;
var
R: TRect;
S: string;
begin
{background}
Canvas.Brush.Color := clSkyBlue;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(FCaptionBarRect);
{text}
Canvas.Brush.Style := bsClear;
R := Rect(FTextSpacing, FCaptionBarRect.Top + TMyGrid(Self.Parent).VertScrollBar.Position, FRowNumbersWidth - FTextSpacing, FCaptionBarRect.Bottom);
S := 'Row No.';
DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
R := Rect(FTextSpacing + FRowNumbersWidth, FCaptionBarRect.Top + TMyGrid(Self.Parent).VertScrollBar.Position, FValuesWidth - FTextSpacing, FCaptionBarRect.Bottom);
S := 'Item No.';
DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
end;
procedure TMyCustomGrid.DrawRowNumbers;
var
I, Y: Integer;
R: TRect;
S: string;
begin
{background}
FRowNumbersBackgroundRect := Rect(0, FCaptionBarRect.Bottom, FRowNumbersWidth, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
Canvas.Brush.Color := clCream;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(FRowNumbersBackgroundRect);
{text}
Y := 0;
// a bit of optimization here, instead of iterating every item in FRowNumbers
// which would be slow - instead determine the the top and last visible row
// and paint only that area.
for I := GetFirstVisibleRow to GetLastVisibleRow do
begin
if RowExists(I) then
begin
R := GetRowNumberTextRect(I);
S := FRowNumbers.Strings[I];
DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
Inc(Y, GetRowHeight);
end;
end;
end;
procedure TMyCustomGrid.DrawValues;
var
I, Y: Integer;
R: TRect;
S: string;
begin
{background}
FValuesBackgroundRect := Rect(FRowNumbersBackgroundRect.Width, FCaptionBarRect.Bottom, FValuesWidth + FRowNumbersWidth, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
Canvas.Brush.Color := clMoneyGreen;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(FValuesBackgroundRect);
{text}
Y := 0;
// a bit of optimization here, instead of iterating every item in FRowNumbers
// which would be slow - instead determine the the top and last visible row
// and paint only that area.
for I := GetFirstVisibleRow to GetLastVisibleRow do
begin
if RowExists(I) then
begin
R := GetValueTextRect(I);
S := 'This is item number ' + FRowNumbers.Strings[I];
DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
Inc(Y, GetRowHeight);
end;
end;
end;
procedure TMyCustomGrid.DrawColumnLines;
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clBlack;
{row numbers column}
Canvas.MoveTo(FRowNumbersBackgroundRect.Right, FCaptionBarRect.Top);
Canvas.LineTo(FRowNumbersBackgroundRect.Right, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
{values column}
Canvas.MoveTo(FValuesBackgroundRect.Right, FCaptionBarRect.Top);
Canvas.LineTo(FValuesBackgroundRect.Right, FCaptionBarRect.Height + GetLastVisibleRow * GetRowHeight + 1);
end;
procedure TMyCustomGrid.CalculateNewHeight;
var
I, Y: Integer;
begin
FRowCount := FRowNumbers.Count;
Y := 0;
for I := 0 to FRowCount -1 do
begin
Inc(Y, GetRowHeight);
end;
if Self.Height <> Y then
Self.Height := Y + FCaptionBarHeight + 1;
end;
function TMyCustomGrid.GetMousePosition: TPoint;
var
P: TPoint;
begin
Winapi.Windows.GetCursorPos(P);
Winapi.Windows.ScreenToClient(Self.Parent.Handle, P);
Result := P;
end;
function TMyCustomGrid.RowIndexToMousePosition(
ARowIndex: Integer): Integer;
begin
if RowExists(ARowIndex) then
Result := ARowIndex * GetRowHeight;
end;
function TMyCustomGrid.GetRowHeight: Integer;
begin
Result := 18;
end;
function TMyCustomGrid.RowExists(ARowIndex: Integer): Boolean;
var
I: Integer;
Y: Integer;
begin
Result := False;
Y := 0;
for I := GetFirstVisibleRow to GetLastVisibleRow -1 do
begin
if ARowIndex = I then
begin
Result := True;
Break;
end;
Inc(Y, GetRowHeight);
end;
end;
function TMyCustomGrid.GetRowNumberRect(ARowIndex: Integer): TRect;
begin
Result.Bottom := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + GetRowHeight;
Result.Left := 0;
Result.Right := FRowNumbersWidth;
Result.Top := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + 1;
end;
function TMyCustomGrid.GetRowNumberTextRect(ARowIndex: Integer): TRect;
begin
Result := GetRowNumberRect(ARowIndex);
Result.Inflate(-FTextSpacing, 0);
end;
function TMyCustomGrid.GetValueRect(ARowIndex: Integer): TRect;
begin
Result.Bottom := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + GetRowHeight;
Result.Left := FRowNumbersWidth;
Result.Right := FValuesBackgroundRect.Right;
Result.Top := RowIndexToMousePosition(ARowIndex) + FCaptionBarHeight + 1;
end;
function TMyCustomGrid.GetValueTextRect(ARowIndex: Integer): TRect;
begin
Result := GetValueRect(ARowIndex);
Result.Inflate(-FTextSpacing, 0);
end;
function TMyCustomGrid.GetFirstVisibleRow: Integer;
begin
Result := TMyGrid(Self.Parent).VertScrollBar.Position div GetRowHeight;
end;
function TMyCustomGrid.GetLastVisibleRow: Integer;
begin
Result := GetFirstVisibleRow + TMyGrid(Self.Parent).Height div GetRowHeight -1;
end;
constructor TMyGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Self.DoubleBuffered := True;
Self.Height := 150;
Self.HorzScrollBar.Visible := False;
Self.TabStop := True;
Self.Width := 250;
FGrid := TMyCustomGrid.Create(Self);
FGrid.Align := alTop;
FGrid.Parent := Self;
FGrid.CalculateNewHeight;
Self.VertScrollBar.Smooth := False;
Self.VertScrollBar.Increment := FGrid.GetRowHeight;
Self.VertScrollBar.Tracking := True;
end;
destructor TMyGrid.Destroy;
begin
FGrid.Free;
inherited Destroy;
end;
procedure TMyGrid.Loaded;
begin
inherited Loaded;
Self.VertScrollBar.Range := FGrid.Height - FGrid.FCaptionBarRect.Height;
end;
procedure TMyGrid.WMVScroll(var Message: TWMVScroll);
begin
inherited;
Self.Invalidate;
end;
end.
Question
What should I be doing differently to overcome the flicker?
Setting DoubleBuffered to True for the scrollbox makes little difference here it seems. I experimented a little with the WM_ERASEBACKGROUND message which just made the scrollbox black.
I also tried implementing a canvas onto the scrollbox and drawing my caption bar directly onto it then setting the padding on the scrollbox to the height of my caption bar and drawing the rest on my TGraphicControl but this lead to even worse flickering. At this point I don't know what exactly is causing the flickering and how to eliminate it?
One last thing is how can I make the scrollbar scroll at a set increment when using the scrollbar thumb? I have set the vertical scrollbar increment to the equivalent of the row height and this works when pressing the scrollbar button, when using the scrollbar thumb to scroll up and down it is not at a fixed increment. I am trying to get the scrollbar to work in increments not scroll loosely.
