Лучший способ сделать не мерцающие, сегментированные графические обновления в Delphi?

Двойная буферизация и причудливая тактика рисования - всего лишь половина истории. Другая половина, некоторые утверждают, что более важная половина, заключается в том, чтобы ограничить, насколько ваш контроль недействителен.

В ваших комментариях упоминается, что вы используете RedrawWindow(handle, @R, 0, rdw_Invalidate or rdw_Frame). Что вы устанавливаете для прямоугольника R? Если вы настроили его на свою клиентскую область, то вы перерисовываете всю клиентскую область своего элемента управления. При прокрутке нужно отредактировать только небольшую часть вашего элемента управления - срез на "задней кромке" направления прокрутки. Windows будет биллировать остальную часть экрана клиентской области для экрана, чтобы переместить существующие пиксели в направлении прокрутки.

Также проверьте, установлены ли флажки окна для полного перерисовывания прокрутки. Я не помню имена флагов, но вы хотите, чтобы они отключились, так что действия прокрутки только лишали области вашего клиентского пространства. Я считаю, что это по умолчанию Windows.

Даже с аппаратной ускоренной графикой меньше работы быстрее, чем больше работы. Получите недействительные исправления до абсолютного минимума и уменьшите количество пикселей, которые вы нажимаете на системную шину.

Это довольно открытый вопрос. Много советов и ответов уже дано. Я хотел бы добавить два:

• Включить csOpaque в ControlStyle, если полностью нарисовать ClientRect,
• Исключить CS_HREDRAW и CS_VREDRAW из Params.WindowClass.Style в CreateParams.

Поскольку вам особенно интересно рисовать на TScrollingWinControl, я трачу последние пару часов на сокращение кода моего компонента планирования, чтобы получить только необходимый код для рисования и прокрутки. Это всего лишь пример и отнюдь не полностью функциональный или подразумеваемый как святой, но он может дать некоторое вдохновение:

unit Unit2;

interface

uses
  Classes, Controls, Windows, Messages, ComCtrls, Forms, Grids, Math, CommCtrl,
  SysUtils, StdCtrls, Graphics, Contnrs;

type
  TAwPlanGrid = class;

  TContainer = class(TWinControl)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure PaintWindow(DC: HDC); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TScrollEvent = procedure(Sender: TControlScrollBar) of object;

  TScroller = class(TScrollingWinControl)
  private
    FOnScroll: TScrollEvent;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure DoScroll(AScrollBar: TControlScrollBar);
    property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TColumn = class(TCustomControl)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMControlChange(var Message: TCMControlChange);
      message CM_CONTROLCHANGE;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TTimeLineHeader = class(TCustomHeaderControl)
  protected
    procedure SectionResize(Section: THeaderSection); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TTimeLineGrid = class(TStringGrid)
  private
    FOnRowHeightsChanged: TNotifyEvent;
    FRowHeightsUpdating: Boolean;
  protected
    procedure Paint; override;
    procedure RowHeightsChanged; override;
    property OnRowHeightsChanged: TNotifyEvent read FOnRowHeightsChanged
      write FOnRowHeightsChanged;
  public
    constructor Create(AOwner: TComponent); override;
    function CanFocus: Boolean; override;
  end;

  TTimeLine = class(TContainer)
  private
    FHeader: TTimeLineHeader;
  protected
    TimeLineGrid: TTimeLineGrid;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  THighwayHeader = class(TCustomHeaderControl)
  private
    FSectionWidth: Integer;
    procedure SetSectionWidth(Value: Integer);
  protected
    function CreateSection: THeaderSection; override;
    procedure SectionResize(Section: THeaderSection); override;
    property SectionWidth: Integer read FSectionWidth write SetSectionWidth;
  public
    procedure AddSection(const AText: String);
    constructor Create(AOwner: TComponent); override;
  end;

  THighwayScroller = class(TScroller)
  private
    procedure WMHScroll(var Message: TWMScroll); message WM_HSCROLL;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMVScroll(var Message: TWMScroll); message WM_VSCROLL;
  protected
    procedure PaintWindow(DC: HDC); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  THighwayColumn = class(TColumn)
  end;

  THighwayColumns = class(TObject)
  private
    FHeight: Integer;
    FItems: TList;
    FParent: TWinControl;
    FWidth: Integer;
    function Add: THighwayColumn;
    function GetItem(Index: Integer): THighwayColumn;
    procedure SetHeight(Value: Integer);
    procedure SetWidth(Value: Integer);
  protected
    property Height: Integer read FHeight write SetHeight;
    property Items[Index: Integer]: THighwayColumn read GetItem; default;
    property Parent: TWinControl read FParent write FParent;
    property Width: Integer read FWidth write SetWidth;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  THighway = class(TContainer)
  private
    procedure HeaderSectionResized(HeaderControl: TCustomHeaderControl;
      Section: THeaderSection);
  protected
    Columns: THighwayColumns;
    Header: THighwayHeader;
    Scroller: THighwayScroller;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TParkingHeader = class(TCustomHeaderControl)
  protected
    procedure SectionResize(Section: THeaderSection); override;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TParkingScroller = class(TScroller)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TParkingColumn = class(TColumn)
  private
    FItemHeight: Integer;
    procedure SetItemHeight(Value: Integer);
  protected
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    property ItemHeight: Integer read FItemHeight write SetItemHeight;
  end;

  TParking = class(TContainer)
  protected
    Column: TParkingColumn;
    Header: TParkingHeader;
    Scroller: TParkingScroller;
    procedure PaintWindow(DC: HDC); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TPlanItem = class(TGraphicControl)
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TPlanItems = class(TList)
  public
    procedure DayHeightChanged(OldDayHeight, NewDayHeight: Integer);
  end;

  TAwPlanGrid = class(TContainer)
  private
    FDayHeight: Integer;
    FHighway: THighway;
    FParking: TParking;
    FPlanItems: TPlanItems;
    FTimeLine: TTimeLine;
    function GetColWidth: Integer;
    procedure HighwayScrolled(Sender: TControlScrollBar);
    procedure SetColWidth(Value: Integer);
    procedure SetDayHeight(Value: Integer);
    procedure TimeLineRowHeightsChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MouseWheelHandler(var Message: TMessage); override;
    procedure Test;
    property ColWidth: Integer read GetColWidth;
    property DayHeight: Integer read FDayHeight;
  end;

function GradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG;
  Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; overload;
  external msimg32 name 'GradientFill';

implementation

function Round2(Value, Rounder: Integer): Integer;
begin
  if Rounder = 0 then Result := Value
  else Result := (Value div Rounder) * Rounder;
end;

// Layout:
//
// - PlanGrid
//   - TimeLine         - Highway            - Parking
//     - TimeLineHeader   - HighwayHeader      - ParkingHeader
//     - TimeLineGrid     - HighwayScroller    - ParkingScroller
//                          - HighwayColumns     - ParkingColumn
//                            - PlanItems          - PlanItems

const
  DaysPerWeek = 5;
  MaxParkingWidth = 300;
  MinColWidth = 50;
  MinDayHeight = 40;
  MinParkingWidth = 60;
  DefTimeLineWidth = 85;
  DividerColor = $0099A8AC;
  DefColWidth = 100;
  DefDayHeight = 48;
  DefWeekCount = 20;

{ TContainer }

constructor TContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
end;

procedure TContainer.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
    Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TContainer.PaintWindow(DC: HDC);
begin
  { Eat inherited }
end;

procedure TContainer.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

{ TScroller }

constructor TScroller.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
  HorzScrollBar.Tracking := True;
  VertScrollBar.Tracking := True;
end;

procedure TScroller.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
    Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;

function TScroller.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  Delta: Integer;
begin
  with VertScrollBar do
  begin
    Delta := Increment;
    if WheelDelta > 0 then
      Delta := -Delta;
    if ssCtrl in Shift then
      Delta := DaysPerWeek * Delta;
    Position := Min(Round2(Range - ClientHeight, Increment), Position + Delta);
  end;
  DoScroll(VertScrollBar);
  Result := True;
end;

procedure TScroller.DoScroll(AScrollBar: TControlScrollBar);
begin
  if Assigned(FOnScroll) then
    FOnScroll(AScrollBar);
end;

procedure TScroller.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

{ TColumn }

procedure TColumn.CMControlChange(var Message: TCMControlChange);
begin
  inherited;
  if Message.Inserting then
    Message.Control.Width := Width;
end;

constructor TColumn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
end;

procedure TColumn.Paint;
type
  PTriVertex = ^TTriVertex;
  TTriVertex = packed record
    X: DWORD;
    Y: DWORD;
    Red: WORD;
    Green: WORD;
    Blue: WORD;
    Alpha: WORD;
  end;
var
  Vertex: array[0..1] of TTriVertex;
  GRect: TGradientRect;
begin
  Vertex[0].X := 0;
  Vertex[0].Y := Canvas.ClipRect.Top;
  Vertex[0].Red := $DD00;
  Vertex[0].Green := $DD00;
  Vertex[0].Blue := $DD00;
  Vertex[0].Alpha := 0;
  Vertex[1].X := Width;
  Vertex[1].Y := Canvas.ClipRect.Bottom;
  Vertex[1].Red := $FF00;
  Vertex[1].Green := $FF00;
  Vertex[1].Blue := $FF00;
  Vertex[1].Alpha := 0;
  GRect.UpperLeft := 0;
  GRect.LowerRight := 1;
  GradientFill(Canvas.Handle, @Vertex, 2, @GRect, 1, GRADIENT_FILL_RECT_H);
end;

procedure TColumn.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

{ TTimeLineHeader }

constructor TTimeLineHeader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
  DoubleBuffered := True;
  Sections.Add;
  Sections[0].MinWidth := 40;
  Sections[0].Width := DefTimeLineWidth;
  Sections[0].MaxWidth := DefTimeLineWidth;
  Sections[0].Text := '2011';
end;

procedure TTimeLineHeader.SectionResize(Section: THeaderSection);
begin
  if HasParent then
    Parent.Width := Section.Width;
  inherited SectionResize(Section);
end;

{ TTimeLineGrid }

function TTimeLineGrid.CanFocus: Boolean;
begin
  Result := False;
end;

constructor TTimeLineGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
  Anchors := [akTop, akRight, akBottom];
  BorderStyle := bsNone;
  ColCount := 2;
  ColWidths[0] := 85;
  ControlStyle := [csOpaque];
  FixedCols := 1;
  FixedRows := 0;
  GridLineWidth := 0;
  Options := [goFixedHorzLine, goRowSizing];
  ScrollBars := ssNone;
  TabStop := False;
  Cells[0, 4] := 'Drag day height';
end;

procedure TTimeLineGrid.Paint;
begin
  inherited Paint;
  with Canvas do
    if ClipRect.Right >= Width - 1 then
    begin
      Pen.Color := DividerColor;
      MoveTo(Width - 1, ClipRect.Top);
      LineTo(Width - 1, ClipRect.Bottom);
    end;
end;

procedure TTimeLineGrid.RowHeightsChanged;
begin
  inherited RowHeightsChanged;
  if Assigned(FOnRowHeightsChanged) and (not FRowHeightsUpdating) then
    try
      FRowHeightsUpdating := True;
      FOnRowHeightsChanged(Self);
    finally
      FRowHeightsUpdating := False;
    end;
end;

{ TTimeLine }

constructor TTimeLine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alLeft;
  Width := DefTimeLineWidth;
  Height := 100;
  FHeader := TTimeLineHeader.Create(Self);
  FHeader.Parent := Self;
  TimeLineGrid := TTimeLineGrid.Create(Self);
  TimeLineGrid.RowCount := DefWeekCount * DaysPerWeek;
  TimeLineGrid.SetBounds(0, FHeader.Height, Width, Height - FHeader.Height);
  TimeLineGrid.Parent := Self;
end;

{ THighwayHeader }

procedure THighwayHeader.AddSection(const AText: String);
begin
  with THeaderSection(Sections.Add) do
    Text := AText;
end;

constructor THighwayHeader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
  Anchors := [akLeft, akTop, akRight];
  ControlStyle := [csOpaque];
  DoubleBuffered := True;
  FullDrag := False;
end;

function THighwayHeader.CreateSection: THeaderSection;
begin
  Result := THeaderSection.Create(Sections);
  Result.MinWidth := MinColWidth;
  Result.Width := FSectionWidth;
end;

procedure THighwayHeader.SectionResize(Section: THeaderSection);
begin
  SectionWidth := Section.Width;
  inherited SectionResize(Section);
end;

procedure THighwayHeader.SetSectionWidth(Value: Integer);
var
  i: Integer;
begin
  if FSectionWidth <> Value then
  begin
    FSectionWidth := Value;
    for i := 0 to Sections.Count - 1 do
      Sections[i].Width := FSectionWidth;
  end;
end;

{ THighwayScroller }

constructor THighwayScroller.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
  Anchors := [akLeft, akTop, akRight, akBottom];
  ControlStyle := [csOpaque];
end;

procedure THighwayScroller.PaintWindow(DC: HDC);
begin
  if ControlCount > 0 then
    ExcludeClipRect(DC, 0, 0, ControlCount * Controls[0].Width,
      Controls[0].Height);
  FillRect(DC, ClientRect, Brush.Handle);
end;

procedure THighwayScroller.Resize;
begin
  with VertScrollBar do
    Position := Round2(Position, Increment);
  DoScroll(HorzScrollBar);
  DoScroll(VertScrollBar);
  inherited Resize;
end;

procedure THighwayScroller.WMHScroll(var Message: TWMScroll);
begin
  inherited;
  DoScroll(HorzScrollBar);
end;

procedure THighwayScroller.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;

procedure THighwayScroller.WMVScroll(var Message: TWMScroll);
var
  NewPos: Integer;
begin
  NewPos := Round2(Message.Pos, VertScrollBar.Increment);
  Message.Pos := NewPos;
  inherited;
  with VertScrollBar do
    if Position <> NewPos then
      Position := Round2(Position, Increment);
  DoScroll(VertScrollBar);
end;

{ THighwayColumns }

function THighwayColumns.Add: THighwayColumn;
var
  Index: Integer;
begin
  Result := THighwayColumn.Create(nil);
  Index := FItems.Add(Result);
  Result.SetBounds(Index * FWidth, 0, FWidth, FHeight);
  Result.Parent := FParent;
end;

constructor THighwayColumns.Create;
begin
  FItems := TObjectList.Create(True);
end;

destructor THighwayColumns.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

function THighwayColumns.GetItem(Index: Integer): THighwayColumn;
begin
  Result := FItems[Index];
end;

procedure THighwayColumns.SetHeight(Value: Integer);
var
  i: Integer;
begin
  if FHeight <> Value then
  begin
    FHeight := Value;
    for i := 0 to FItems.Count - 1 do
      Items[i].Height := FHeight;
  end;
end;

procedure THighwayColumns.SetWidth(Value: Integer);
var
  i: Integer;
begin
  if FWidth <> Value then
  begin
    FWidth := Max(MinColWidth, Value);
    for i := 0 to FItems.Count - 1 do
      with Items[i] do
        SetBounds(Left + (FWidth - Width) * i, 0, FWidth, FHeight);
  end;
end;

{ THighway }

constructor THighway.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alClient;
  Width := 100;
  Height := 100;
  Header := THighwayHeader.Create(Self);
  Header.SetBounds(0, 0, Width, Header.Height);
  Header.OnSectionResize := HeaderSectionResized;
  Header.Parent := Self;
  Scroller := THighwayScroller.Create(Self);
  Scroller.SetBounds(0, Header.Height, Width, Height - Header.Height);
  Scroller.Parent := Self;
  Columns := THighwayColumns.Create;
  Columns.Parent := Scroller;
end;

destructor THighway.Destroy;
begin
  Columns.Free;
  inherited Destroy;
end;

procedure THighway.HeaderSectionResized(HeaderControl: TCustomHeaderControl;
  Section: THeaderSection);
begin
  Columns.Width := Section.Width;
  Scroller.HorzScrollBar.Increment := Columns.Width;
  Header.Left := -Scroller.HorzScrollBar.Position;
end;

{ TParkingHeader }

const
  BlindWidth = 2000;

constructor TParkingHeader.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
  Anchors := [akLeft, akTop, akRight];
  ControlStyle := [csOpaque];
  DoubleBuffered := True;
  Sections.Add;
  Sections[0].Width := BlindWidth;
  Sections.Add;
  Sections[1].AutoSize := True;
  Sections[1].Text := 'Parked';
end;

procedure TParkingHeader.SectionResize(Section: THeaderSection);
begin
  if (Section.Index = 0) and HasParent then
  begin
    Parent.Width := Max(MinParkingWidth,
      Min(Parent.Width - Section.Width + BlindWidth, MaxParkingWidth));
    Section.Width := BlindWidth;
    Sections[1].Width := Parent.Width - 2;
  end;
  inherited SectionResize(Section);
end;

procedure TParkingHeader.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if HasParent then
  begin
    SetBounds(-BlindWidth + 2, 0, BlindWidth + Parent.Width, Height);
    Sections[1].Width := Parent.Width - 2;
  end;
end;

{ TParkingScroller }

constructor TParkingScroller.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alCustom;
  Anchors := [akLeft, akTop, akRight, akBottom];
  ControlStyle := [csOpaque];
  HorzScrollBar.Visible := False;
  VertScrollBar.Increment := DefDayHeight;
end;

{ TParkingColumn }

function TParkingColumn.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  if HasParent then
    NewHeight := Max(Parent.Height, ControlCount * FItemHeight);
  Result := True;
end;

constructor TParkingColumn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alTop;
  AutoSize := True;
  FItemHeight := DefDayHeight;
end;

procedure TParkingColumn.SetItemHeight(Value: Integer);
var
  i: Integer;
begin
  if FItemHeight <> Value then
  begin
    FItemHeight := Value;
    for i := 0 to ControlCount - 1 do
      Controls[i].Height := FItemHeight;
    TScroller(Parent).VertScrollBar.Increment := FItemHeight;
  end;
end;

{ TParking }

constructor TParking.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alRight;
  Width := 120;
  Height := 100;
  Header := TParkingHeader.Create(Self);
  Header.Parent := Self;
  Scroller := TParkingScroller.Create(Self);
  Scroller.SetBounds(1, Header.Height, Width, Height - Header.Height);
  Scroller.Parent := Self;
  Column := TParkingColumn.Create(Self);
  Column.Parent := Scroller;
end;

procedure TParking.PaintWindow(DC: HDC);
var
  R: TRect;
begin
  Brush.Color := DividerColor;
  SetRect(R, 0, Header.Height, 1, Height);
  FillRect(DC, R, Brush.Handle);
end;

procedure TParking.Resize;
begin
  Column.AdjustSize;
  inherited Resize;
end;

{ TPlanItem }

constructor TPlanItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Anchors := [akLeft, akTop, akRight];
  ControlStyle := [csOpaque];
  Color := Random(clWhite);
end;

procedure TPlanItem.Paint;
begin
  Canvas.Brush.Color := Color;
  Canvas.FillRect(Canvas.ClipRect);
end;

{ TPlanItems }

procedure TPlanItems.DayHeightChanged(OldDayHeight, NewDayHeight: Integer);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    with TPlanItem(Items[i]) do
      if not (Parent is TParkingColumn) then
      begin
        Top := Trunc(Top * (NewDayHeight / OldDayHeight));
        Height := Trunc(Height * (NewDayHeight / OldDayHeight));
      end;
end;

{ TAwPlanGrid }

constructor TAwPlanGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csOpaque];
  TabStop := True;
  Width := 400;
  Height := 200;
  FTimeLine := TTimeLine.Create(Self);
  FTimeLine.TimeLineGrid.OnRowHeightsChanged := TimeLineRowHeightsChanged;
  FTimeLine.Parent := Self;
  FParking := TParking.Create(Self);
  FParking.Parent := Self;
  FHighway := THighway.Create(Self);
  FHighway.Scroller.OnScroll := HighwayScrolled;
  FHighway.Parent := Self;
  FPlanItems := TPlanItems.Create;
  SetColWidth(DefColWidth);
  SetDayHeight(DefDayHeight);
  FHighway.Columns.Height := DefWeekCount * DaysPerWeek * FDayHeight;
end;

destructor TAwPlanGrid.Destroy;
begin
  FPlanItems.Free;
  inherited Destroy;
end;

function TAwPlanGrid.GetColWidth: Integer;
begin
  Result := FHighway.Columns.Width;
end;

procedure TAwPlanGrid.HighwayScrolled(Sender: TControlScrollBar);
begin
  if Sender.Kind = sbVertical then
    FTimeLine.TimeLineGrid.TopRow := Sender.Position div FDayHeight
  else
  begin
    FHighway.Header.Left := -Sender.Position;
    FHighway.Header.Width := FHighway.Width + Sender.Position;
  end;
end;

procedure TAwPlanGrid.MouseWheelHandler(var Message: TMessage);
var
  X: Integer;
begin
  with Message do
  begin
    X := ScreenToClient(SmallPointToPoint(TCMMouseWheel(Message).Pos)).X;
    if X >= FParking.Left then
      Result := FParking.Scroller.Perform(CM_MOUSEWHEEL, WParam, LParam)
    else
      Result := FHighway.Scroller.Perform(CM_MOUSEWHEEL, WParam, LParam);
  end;
  if Message.Result = 0 then
    inherited MouseWheelHandler(Message);
end;

procedure TAwPlanGrid.SetColWidth(Value: Integer);
begin
  if ColWidth <> Value then
  begin
    FHighway.Columns.Width := Value;
    FHighway.Header.SectionWidth := ColWidth;
    FHighway.Scroller.HorzScrollBar.Increment := ColWidth;
  end;
end;

procedure TAwPlanGrid.SetDayHeight(Value: Integer);
var
  OldDayHeight: Integer;
begin
  if FDayHeight <> Value then
  begin
    OldDayHeight := FDayHeight;
    FDayHeight := Max(MinDayHeight, Round2(Value, 4));
    FTimeLine.TimeLineGrid.DefaultRowHeight := FDayHeight;
    FHighway.Columns.Height := DefWeekCount * DaysPerWeek * FDayHeight;
    FHighway.Scroller.VertScrollBar.Increment := FDayHeight;
    FPlanItems.DayHeightChanged(OldDayHeight, FDayHeight);
  end;
end;

procedure TAwPlanGrid.Test;
var
  i: Integer;
  PlanItem: TPlanItem;
begin
  Randomize;
  Anchors := [akLeft, akTop, akBottom, akRight];
  for i := 0 to 3 do
    FHighway.Columns.Add;
  FHighway.Header.AddSection('Drag col width');
  FHighway.Header.AddSection('Column 2');
  FHighway.Header.AddSection('Column 3');
  FHighway.Header.AddSection('Column 4');
  for i := 0 to 9 do
  begin
    PlanItem := TPlanItem.Create(Self);
    PlanItem.Parent := FParking.Column;
    PlanItem.Top := i * DefDayHeight;
    PlanItem.Height := DefDayHeight;
    FPlanItems.Add(PlanItem);
  end;
  for i := 0 to 3 do
  begin
    PlanItem := TPlanItem.Create(Self);
    PlanItem.Parent := FHighway.Columns[i];
    PlanItem.Top := (i + 3) * DefDayHeight;
    PlanItem.Height := DefDayHeight;
    FPlanItems.Add(PlanItem);
  end;
  SetFocus;
end;

procedure TAwPlanGrid.TimeLineRowHeightsChanged(Sender: TObject);
var
  iRow: Integer;
begin
  with FTimeLine.TimeLineGrid do
    for iRow := 0 to RowCount - 1 do
      if RowHeights[iRow] <> DefaultRowHeight then
      begin
        SetDayHeight(RowHeights[iRow]);
        Break;
      end;
end;

end.

Код тестирования:

with TAwPlanGrid.Create(Self) do
begin
  SetBounds(10, 100, 600, 400);
  Parent := Self;
  Test;
end;

Мои 2 cts.

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

Если вы рисуете красный квадрат на белом фоне, тогда вы рисуете все белое, за исключением того, где будет красный квадрат, затем вы "заполните" красный квадрат:

Там нет мерцания, и вы выполняете меньше операций рисования.

Это крайний пример того, что у вас есть недействительность, как dthorp упоминает. Если вы прокручиваете элемент управления, используйте ScrollWindow, чтобы графическая подсистема двигала то, что уже было там, а затем просто заполнила отсутствующий бит внизу.

Будут случаи, когда вы имеете, чтобы рисовать одни и те же пиксели несколько раз; Текст ClearType - лучший пример. Для рендеринга ClearType требуется доступ к пикселам внизу - это означает, что вы собираетесь иметь, чтобы заполнить область белым цветом, а затем нарисуйте текст над ней.

Но даже это можно смягчить, измеряя rects текста, который вы собираетесь отображать, заполнить clWhite всюду, а затем DrawText заполнить пустые области - используя белый HBRUSH фон:

Но этот трюк не может работать при рисовании текста на градиенте или произвольном существующем содержимом - так что будет мерцание. В этом случае вам нужно как-то удвоить буфер. (Хотя не дублируйте буфер, если пользователь находится на удаленном сеансе - мерцание лучше, чем медленный рисунок).

Бонусный чат. Теперь, когда я объяснил, почему вы не должны дублировать содержимое буфера при запуске пользователем через Remote Desktop (например, службы терминалов), теперь вы знаете, что этот расширенный вариант Internet Explorer означает, что он делает, и почему он отключен по умолчанию: