VCL, избавляемся от мерцания, раз и навсегда06.01.2017 20:33

image
Delphi и C++Builder разработчики, использующие VCL не по наслышке знают о вездесущей проблеме мерцания контролов.
Мерцание происходит при перерисовке, вследствие того, что сначала отрисовываеться фон компонента, и только потом сам компонент.
И если в случае с наследниками от TWinControl частичным решением проблемы является установка свойства DoubleBuffered в True, что заставляет контрол отрисовываться в буфере (однако DoubleBuffered работает тоже не идеально, к прим.: контрол перестает быть прозрачным), то в случае с TGraphicControl решение с DoubleBuffered просто невозможно, из-за отсутствия у TGraphicControl окна, установка же DoubleBuffered в True у родителя не помогает, из-за того что отрисовка вложенных TGraphicControl-ов происходит уже после прорисовки родителя в буфере.
Обычно остается только одно — смириться с мерцанием, и максимально упростить отрисовку для минимизации эффекта, или использовать по возможности исключительно TWinControl-ы, что не всегда возможно и удобно.


Однажды намучившись с мерцанием, я не выдержал и решил решить эту проблему, раз и навсегда!


Как мне удалось решить проблему?
Заранее извиняюсь за некоторую сумбурность подачи, и недосказанность, описывать подобные вещи довольно сложно, однако поделиться с сообществом хочется.


Был разработан класс TEsCustomControl = class (TWinControl), который осуществляет альтернативную буферизацию (при DoubleBuffered = False, иначе используется родная буферизация VCL).
Класс имеет свойство BufferedChildrens, при активации которого отрисовка вложенных TGraphicControl-ов происходит в буфере, что полностью избавляет от мерцания.


К счастью в VCL нужные методы отрисовки объявлены не как private, что и позволило реализовать полную буферизацию.


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


procedure DrawParentImage(Control: TControl; DC: HDC; InvalidateParent: Boolean = False);
var
  ClientRect: TRect;
  P: TPoint;
  SaveIndex: Integer;
begin
  if Control.Parent = nil then
    Exit;
  SaveIndex := SaveDC(DC);
  GetViewportOrgEx(DC, P);

  // if control has non client border then need additional offset viewport
  ClientRect := Control.ClientRect;
  if (ClientRect.Right <> Control.Width) or (ClientRect.Bottom <> Control.Height) then
  begin
    ClientRect := CalcClientRect(Control);
    SetViewportOrgEx(DC, P.X - Control.Left - ClientRect.Left, P.Y - Control.Top - ClientRect.Top, nil);
  end else
    SetViewportOrgEx(DC, P.X - Control.Left, P.Y - Control.Top, nil);

  IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);

  Control.Parent.Perform(WM_ERASEBKGND, DC, 0);
  // Control.Parent.Perform(WM_PAINT, DC, 0);
  Control.Parent.Perform(WM_PRINTCLIENT, DC, PRF_CLIENT);

  RestoreDC(DC, SaveIndex);

  if InvalidateParent then
    if not (Control.Parent is TCustomControl) and not (Control.Parent is TCustomForm) and
       not (csDesigning in Control.ComponentState)and not (Control.Parent is TEsCustomControl) then
    begin
      Control.Parent.Invalidate;
    end;

  SetViewportOrgEx(DC, P.X, P.Y, nil);
end;

Буферизация происходит за счет того что компонент в переопределенном методе PaintWindow отрисовываеться не непосредственно на предоставленный хендл, а на временный (или нет в зависимости от свойства IsCachedBuffer) HBITMAP, и уже после полной отрисовки копируется функцией BitBlt.
(Довольно много кода, из-за многих частных случаев)


TEsCustomControl.PaintWindow
procedure TEsCustomControl.PaintWindow(DC: HDC);
var
  TempDC: HDC;
  UpdateRect: TRect;
  //---
  BufferDC: HDC;
  BufferBitMap: HBITMAP;
  Region: HRGN;
  SaveViewport: TPoint;
  BufferedThis: Boolean;
begin
  BufferBitMap := 0;
  Region := 0;

  if GetClipBox(DC, UpdateRect) = ERROR then
    UpdateRect := ClientRect;

  BufferedThis := not BufferedChildrens;

  if BufferedThis then
  begin
  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintHandler
  //------------------------------------------------------------------------------------------------
    // if control not double buffered then create or assign buffer
    if not DoubleBuffered then
    begin
      BufferDC := CreateCompatibleDC(DC);
      // CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
      // return <> 0 => need to double buffer || return = 0 => no need to double buffer
      if BufferDC <> 0 then
      begin
        // Using the cache if possible
        if FIsCachedBuffer or FIsFullSizeBuffer then
        begin
          // Create cache if need
          if CacheBitmap = 0 then
          begin
            BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
            // Assign to cache if need
            if FIsCachedBuffer then
              CacheBitmap := BufferBitMap;
          end
          else
            BufferBitMap := CacheBitmap;

          // Assign region for minimal overdraw
          Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
          SelectClipRgn(BufferDC, Region);
        end
        else
          // Create buffer
          BufferBitMap := CreateCompatibleBitmap(DC, RectWidth(UpdateRect), RectHeight(UpdateRect));
        // Select buffer bitmap
        SelectObject(BufferDC, BufferBitMap);
        // [change coord], if need
        // Moving update region to the (0,0) point
        if not(FIsCachedBuffer or FIsFullSizeBuffer) then
        begin
          GetViewportOrgEx(BufferDC, SaveViewport);
          SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
        end;
      end
      else
        BufferDC := DC;
    end
    else
      BufferDC := DC;
  //------------------------------------------------------------------------------------------------
  end else
    BufferDC := DC;

  if not(csOpaque in ControlStyle) then
    if ParentBackground then
    begin
      if FIsCachedBackground then
      begin
        if CacheBackground = 0 then
        begin
          TempDC := CreateCompatibleDC(DC);
          CacheBackground := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
          SelectObject(TempDC, CacheBackground);
          DrawBackground(TempDC); //DrawParentImage(Self, TempDC, False);
          DeleteDC(TempDC);
        end;
        TempDC := CreateCompatibleDC(BufferDC);
        SelectObject(TempDC, CacheBackground);
        if not FIsCachedBuffer then
          BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
            UpdateRect.Left, UpdateRect.Top, SRCCOPY)
        else
          BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
            UpdateRect.Left, UpdateRect.Top, SRCCOPY);
        DeleteDC(TempDC);
      end
      else
        DrawBackground(BufferDC); //DrawParentImage(Self, BufferDC, False);
    end else
      if (not DoubleBuffered or (DC <> 0)) then
        if not IsStyledClientControl(Self) then
          FillRect(BufferDC, ClientRect, Brush.Handle)
        else
        begin
          SetDCBrushColor(BufferDC,
            ColorToRGB({$ifdef VER230UP}StyleServices.GetSystemColor(Color){$else}Color{$endif}));
          FillRect(BufferDC, ClientRect, GetStockObject(DC_BRUSH));
        end;

  FCanvas.Lock;
  try
    Canvas.Handle := BufferDC;
    TControlCanvas(Canvas).UpdateTextFlags;

    if Assigned(FOnPainting) then
      FOnPainting(Self, Canvas, ClientRect);
    Paint;
    if Assigned(FOnPaint) then
      FOnPaint(Self, Canvas, ClientRect);
  finally
    FCanvas.Handle := 0;
    FCanvas.Unlock;
  end;

  if BufferedThis then
  begin
  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintHandler
  //------------------------------------------------------------------------------------------------
    // draw to window
    if not DoubleBuffered then
    begin
      if not(FIsCachedBuffer or FIsFullSizeBuffer) then
      begin
        // [restore coord], if need
        SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
        BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
      end
      else
      begin
        BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
          UpdateRect.Left, UpdateRect.Top, SRCCOPY);
      end;
    end;

    if (BufferDC <> DC) then
      DeleteObject(BufferDC);
    if Region <> 0 then
      DeleteObject(Region);
    // delete buufer, if need
    if not FIsCachedBuffer and (BufferBitMap <> 0) then
      DeleteObject(BufferBitMap);
  //------------------------------------------------------------------------------------------------
  end;
end;

Буферизация вложенных TGraphicControl-ов реализована альтернативным методом PaintHandler, в котором происходит буферизация всех этапов прорисовки компонента, в том числе и отрисовки TGraphicControl-ов.


TEsCustomControl.PaintHandler
procedure TEsCustomControl.PaintHandler(var Message: TWMPaint);
var
  PS: TPaintStruct;
  BufferDC: HDC;
  BufferBitMap: HBITMAP;
  UpdateRect: TRect;
  SaveViewport: TPoint;
  Region: HRGN;
  DC: HDC;
  IsBeginPaint: Boolean;
begin
  BufferBitMap := 0;
  Region := 0;
  IsBeginPaint := Message.DC = 0;

  if IsBeginPaint then
  begin
    DC := BeginPaint(Handle, PS);
    {$IFDEF VER230UP}
    if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
      UpdateRect := ClientRect
      // I had to use a crutch to ClientRect, due to the fact that
      // VCL.Styles.TCustomStyle.DoDrawParentBackground NOT use relative coordinates,
      // ie ignores SetViewportOrgEx!
      // This function uses ClientToScreen and ScreenToClient for coordinates calculation!
    else
    {$endif}
      UpdateRect := PS.rcPaint;
  end
  else
  begin
    DC := Message.DC;
    {$IFDEF VER230UP}
    if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
      UpdateRect := ClientRect
    else
    {$endif}
      if GetClipBox(DC, UpdateRect) = ERROR then
        UpdateRect := ClientRect;
  end;

  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintWindow
  //------------------------------------------------------------------------------------------------
  // if control not double buffered then create or assign buffer
  if not DoubleBuffered then
  begin
    BufferDC := CreateCompatibleDC(DC);
    // CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
    // return <> 0 => need to double buffer || return = 0 => no need to double buffer
    if BufferDC <> 0 then
    begin
      // Using the cache if possible
      if FIsCachedBuffer or FIsFullSizeBuffer then
      begin
        // Create cache if need
        if CacheBitmap = 0 then
        begin
          BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
          // Assign to cache if need
          if FIsCachedBuffer then
            CacheBitmap := BufferBitMap;
        end
        else
          BufferBitMap := CacheBitmap;

        // Assign region for minimal overdraw
        Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
        SelectClipRgn(BufferDC, Region);
      end
      else
        // Create buffer
        BufferBitMap := CreateCompatibleBitmap(DC,
          UpdateRect.Right - UpdateRect.Left, UpdateRect.Bottom - UpdateRect.Top);
      // Select buffer bitmap
      SelectObject(BufferDC, BufferBitMap);
      // [change coord], if need
      // Moving update region to the (0,0) point
      if not(FIsCachedBuffer or FIsFullSizeBuffer) then
      begin
        GetViewportOrgEx(BufferDC, SaveViewport);
        SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
      end;
    end
    else
      BufferDC := DC;
  end
  else
    BufferDC := DC;
  //------------------------------------------------------------------------------------------------

  // DEFAULT HANDLER:
  Message.DC := BufferDC;
  inherited PaintHandler(Message);

  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintWindow
  //------------------------------------------------------------------------------------------------
  // draw to window
  if not DoubleBuffered then
  begin
    if not(FIsCachedBuffer or FIsFullSizeBuffer) then
    begin
      // [restore coord], if need
      SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
    end
    else
    begin
      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
        UpdateRect.Left, UpdateRect.Top, SRCCOPY);
    end;
  end;

  if BufferDC <> DC then
    DeleteObject(BufferDC);
  if Region <> 0 then
    DeleteObject(Region);
  // delete buufer, if need
  if not FIsCachedBuffer and (BufferBitMap <> 0) then
    DeleteObject(BufferBitMap);
  //------------------------------------------------------------------------------------------------

  // end paint, if need
  if IsBeginPaint then
    EndPaint(Handle, PS);
end;

Класс TEsCustomControl имеет несколько полезных свойств и событий: 


  TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; Rect: TRect) of object;

  ///  The best replacement for TCustomControl, supports transparency and without flicker 
  TEsCustomControl = class(TWinControl)
  ...
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateBackground(Repaint: Boolean); overload;
    procedure UpdateBackground; overload;
    // ------------------ Properties for published -------------------------------------------------
    property DoubleBuffered default False;
    {$IFDEF VER210UP}
    property ParentDoubleBuffered default False;
    {$ENDIF}
    // Painting for chidrens classes
    property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
    property OnPainting: TPaintEvent read FOnPainting write FOnPainting;
    // BufferedChildrens
    property ParentBufferedChildrens: Boolean read FParentBufferedChildrens write SetParentBufferedChildrens default True;
    property BufferedChildrens: Boolean read FBufferedChildrens write SetBufferedChildrens stored IsBufferedChildrensStored;
    // External prop
    property IsCachedBuffer: Boolean read FIsCachedBuffer write SetIsCachedBuffer default False;
    property IsCachedBackground: Boolean read FIsCachedBackground write SetIsCachedBackground default False;
    property IsDrawHelper: Boolean read FIsDrawHelper write SetIsDrawHelper default False;
    property IsOpaque: Boolean read GetIsOpaque write SetIsOpaque default False;
    // property IsTransparentMouse: Boolean read FIsTransparentMouse write FIsTransparentMouse default False;
    property IsFullSizeBuffer: Boolean read FIsFullSizeBuffer write FIsFullSizeBuffer default False;
  end;

Интересным может оказаться свойство IsDrawHelper рисующее удобную рамку в DesignTime.
image


Для создания своего не мерцающего компонента вам достаточно унаследоваться от TEsCustomControl, как если бы вы делали наследника от TCustomControl, и объявить нужные вам свойства как published.


TEsCustomControl дает полное управление процессом буферизации и отрисовки, и доказал свою надежность во многих проектах и компонентах.


Для примера можно рассмотреть компонент TEsLayout — прозрачный Layout с возможностью буферизации вложенных в него TGraphicControl-ов:
https://github.com/errorcalc/FreeEsVclComponents/blob/master/Source/ES.Layouts.pas


И под спойлером
{******************************************************************************}
{                            EsVclComponents v2.0                              }
{                           ErrorSoft(c) 2009-2016                             }
{                                                                              }
{                     More beautiful things: errorsoft.org                     }
{                                                                              }
{           errorsoft@mail.ru | vk.com/errorsoft | github.com/errorcalc        }
{              errorsoft@protonmail.ch | habrahabr.ru/user/error1024           }
{                                                                              }
{         Open this on github: github.com/errorcalc/FreeEsVclComponents        }
{                                                                              }
{ You can order developing vcl/fmx components, please submit requests to mail. }
{ Вы можете заказать разработку VCL/FMX компонента на заказ.                   }
{******************************************************************************}
unit ES.Layouts;

interface

uses
  Winapi.Messages, Vcl.Controls, System.Classes, System.Types, Vcl.Graphics, ES.BaseControls;

type
  TEsCustomLayout = class(TEsBaseLayout)
  private
    FLocked: Boolean;
    procedure CMIsToolControl(var Message: TMessage); message CM_ISTOOLCONTROL;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    property UseDockManager default True;
  public
    constructor Create(AOwner: TComponent); override;
    property Color default clBtnFace;
    property DockManager;
    property Locked: Boolean read FLocked write FLocked default False;
  end;

  TEsLayout = class(TEsCustomLayout)
  published
    property Align;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property BorderWidth;
    property BufferedChildrens;// TEsCustomControl
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property IsCachedBuffer;// TEsCustomControl
    property IsCachedBackground;// TEsCustomControl
    property IsDrawHelper;// TEsCustomControl
    property IsOpaque;// TEsCustomControl
    property IsFullSizeBuffer;// TEsCustomControl
    property Locked;
    property Padding;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentBufferedChildrens;// TEsCustomControl
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Touch;
    property Visible;
    {$if CompilerVersion > 23}
    property StyleElements;
    {$ifend}
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnPaint;// TEsCustomControl
    property OnPainting;// TEsCustomControl
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

implementation

uses
  ES.ExGraphics;

procedure TEsCustomLayout.CMIsToolControl(var Message: TMessage);
begin
  if not FLocked then Message.Result := 1;
end;

constructor TEsCustomLayout.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csParentBackground, csDoubleClicks, csReplicatable, csPannable, csGestures];
  Width := 185;
  Height := 41;
  UseDockManager := True;
end;

procedure TEsCustomLayout.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  // nope now
end;

end.

Исходный же код модуля содержащего TEsCustomControl и его версии-Layout-а TEsBaseLayout доступен по ссылке:
https://github.com/errorcalc/FreeEsVclComponents/blob/master/Source/ES.BaseControls.pas


И под спойлером
{******************************************************************************}
{                       EsVclComponents/EsVclCore v2.0                         }
{                           ErrorSoft(c) 2009-2017                             }
{                                                                              }
{                     More beautiful things: errorsoft.org                     }
{                                                                              }
{           errorsoft@mail.ru | vk.com/errorsoft | github.com/errorcalc        }
{              errorsoft@protonmail.ch | habrahabr.ru/user/error1024           }
{                                                                              }
{         Open this on github: github.com/errorcalc/FreeEsVclComponents        }
{                                                                              }
{ You can order developing vcl/fmx components, please submit requests to mail. }
{ Вы можете заказать разработку VCL/FMX компонента на заказ.                   }
{******************************************************************************}

{
  This is the base unit, which must remain Delphi 7 support, and it should not
  be dependent on any other units!
}

unit ES.BaseControls;

{$IF CompilerVersion >= 18} {$DEFINE VER180UP} {$IFEND}
{$IF CompilerVersion >= 21} {$DEFINE VER210UP} {$IFEND}
{$IF CompilerVersion >= 23} {$DEFINE VER230UP} {$IFEND}
{$IF CompilerVersion >= 24} {$DEFINE VER240UP} {$IFEND}

// see function CalcClientRect
{$define FAST_CALC_CLIENTRECT}

// see TEsBaseLayout.ContentRect
{$define TEST_CONTROL_CONTENT_RECT}

interface

uses
  WinApi.Windows, System.Types, System.Classes, Vcl.Controls,
  Vcl.Graphics, {$IFDEF VER230UP}Vcl.Themes,{$ENDIF} WinApi.Messages, WinApi.Uxtheme, Vcl.Forms;

const
  CM_ESBASE = CM_BASE + $0800;
  CM_PARENT_BUFFEREDCHILDRENS_CHANGED = CM_ESBASE + 1;

  EsVclCoreVersion = 2.0;

type
  THelperOption = (hoPadding, hoBorder, hoClientRect);
  THelperOptions = set of THelperOption;

  TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; Rect: TRect) of object;

  ///  The best replacement for TCustomControl, supports transparency and without flicker 
  TEsCustomControl = class(TWinControl)
  private
    // anti flicker and transparent magic
    FCanvas: TCanvas;
    CacheBitmap: HBITMAP;// Cache for buffer BitMap
    CacheBackground: HBITMAP;// Cache for background BitMap
    FIsCachedBuffer: Boolean;
    FIsCachedBackground: Boolean;
    StoredCachedBuffer: Boolean;
    StoredCachedBackground: Boolean;
    FBufferedChildrens: Boolean;
    FParentBufferedChildrens: Boolean;
    FIsFullSizeBuffer: Boolean;
    // paint events
    FOnPaint: TPaintEvent;
    FOnPainting: TPaintEvent;
    // draw helper
    FIsDrawHelper: Boolean;
    // transparent mouse
    // FIsTransparentMouse: Boolean;
    // paint
    procedure SetIsCachedBuffer(Value: Boolean);
    procedure SetIsCachedBackground(Value: Boolean);
    procedure SetIsDrawHelper(const Value: Boolean);
    procedure SetIsOpaque(const Value: Boolean);
    function GetIsOpaque: Boolean;
    procedure SetBufferedChildrens(const Value: Boolean);
    procedure SetParentBufferedChildrens(const Value: Boolean);
    function GetTransparent: Boolean;
    procedure SetTransparent(const Value: Boolean);
    function IsBufferedChildrensStored: Boolean;
    // handle messages
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMParentBufferedChildrensChanged(var Message: TMessage); message CM_PARENT_BUFFEREDCHILDRENS_CHANGED;
    procedure DrawBackgroundForOpaqueControls(DC: HDC);
    // intercept mouse
    // procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    // other
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMTextChanges(var Message: TMessage); message WM_SETTEXT;
  protected
    // paint
    property Canvas: TCanvas read FCanvas;
    procedure DeleteCache;{$IFDEF VER210UP}inline;{$ENDIF}
    procedure Paint; virtual;
    procedure BeginCachedBuffer;{$IFDEF VER210UP}inline;{$ENDIF}
    procedure EndCachedBuffer;{$IFDEF VER210UP}inline;{$ENDIF}
    procedure BeginCachedBackground;{$IFDEF VER210UP}inline;{$ENDIF}
    procedure EndCachedBackground;{$IFDEF VER210UP}inline;{$ENDIF}
    procedure PaintWindow(DC: HDC); override;
    procedure PaintHandler(var Message: TWMPaint);
    procedure DrawBackground(DC: HDC); virtual;
    // other
    procedure UpdateText; dynamic;
    //
    property ParentBackground default True;
    property Transparent: Boolean read GetTransparent write SetTransparent default True;// analog of ParentBackground
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateBackground(Repaint: Boolean); overload;
    procedure UpdateBackground; overload;
    // ------------------ Properties for published -------------------------------------------------
    property DoubleBuffered default False;
    {$IFDEF VER210UP}
    property ParentDoubleBuffered default False;
    {$ENDIF}
    // Painting for chidrens classes
    property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
    property OnPainting: TPaintEvent read FOnPainting write FOnPainting;
    // BufferedChildrens
    property ParentBufferedChildrens: Boolean read FParentBufferedChildrens write SetParentBufferedChildrens default True;
    property BufferedChildrens: Boolean read FBufferedChildrens write SetBufferedChildrens stored IsBufferedChildrensStored;
    // External prop
    property IsCachedBuffer: Boolean read FIsCachedBuffer write SetIsCachedBuffer default False;
    property IsCachedBackground: Boolean read FIsCachedBackground write SetIsCachedBackground default False;
    property IsDrawHelper: Boolean read FIsDrawHelper write SetIsDrawHelper default False;
    property IsOpaque: Boolean read GetIsOpaque write SetIsOpaque default False;
    // property IsTransparentMouse: Boolean read FIsTransparentMouse write FIsTransparentMouse default False;
    property IsFullSizeBuffer: Boolean read FIsFullSizeBuffer write FIsFullSizeBuffer default False;
  end;

  {$IFDEF VER180UP}
  TContentMargins = record
  type
    TMarginSize = 0..MaxInt;
  private
    Left: TMarginSize;
    Top: TMarginSize;
    Right: TMarginSize;
    Bottom: TMarginSize;
  public
    function Width: TMarginSize;
    function Height: TMarginSize;
    procedure Inflate(DX, DY: Integer); overload;
    procedure Inflate(DLeft, DTop, DRight, DBottom: Integer); overload;
    procedure Reset;
    constructor Create(Left, Top, Right, Bottom: TMarginSize); overload;
  end;

  ///  ONLY INTERNAL USE! THIS CLASS CAN BE DELETED! (USE TEsCustomControl OR TEsCustomLayot) 
  TEsBaseLayout = class(TEsCustomControl)
  private
    FBorderWidth: TBorderWidth;
    procedure SetBorderWidth(const Value: TBorderWidth);
  protected
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure Paint; override;
    // new
    procedure CalcContentMargins(var Margins: TContentMargins); virtual;
  public
    function ContentRect: TRect; virtual;
    function ContentMargins: TContentMargins; inline;
    property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
  end;

  ///  The GraphicControl, supports Padding and IsDrawHelper property 
  TEsGraphicControl = class(TGraphicControl)
  private
    FPadding: TPadding;
    FIsDrawHelper: Boolean;
    function GetPadding: TPadding;
    procedure SetPadding(const Value: TPadding);
    procedure PaddingChange(Sender: TObject);
    procedure SetIsDrawHelper(const Value: Boolean);
  protected
    procedure Paint; override;
    function HasPadding: Boolean;
    // new
    procedure CalcContentMargins(var Margins: TContentMargins); virtual;
  public
    destructor Destroy; override;
    property Padding: TPadding read GetPadding write SetPadding;
    function ContentRect: TRect; virtual;
    function ContentMargins: TContentMargins; inline;
    property IsDrawHelper: Boolean read FIsDrawHelper write SetIsDrawHelper default False;
  end;

  procedure DrawControlHelper(Control: TControl; Options: THelperOptions); overload;
  procedure DrawControlHelper(Canvas: TCanvas; Rect: TRect; BorderWidth: TBorderWidth;
    Padding: TPadding; Options: THelperOptions); overload;
  {$ENDIF}

  function CalcClientRect(Control: TControl): TRect;

  procedure DrawParentImage(Control: TControl; DC: HDC; InvalidateParent: Boolean = False);

implementation

uses
  System.SysUtils, System.TypInfo;

type
  TOpenCtrl = class(TWinControl)
  public
    property BorderWidth;
  end;

// Old delphi support
{$IFNDEF VER210UP}
function RectWidth(const Rect: TRect): Integer;
begin
  Result := Rect.Right - Rect.Left;
end;

function RectHeight(const Rect: TRect): Integer;
begin
  Result := Rect.Bottom - Rect.Top;
end;
{$ENDIF}

{$IFDEF VER210UP} {$REGION 'DrawControlHelper'}
procedure DrawControlHelper(Canvas: TCanvas; Rect: TRect; BorderWidth: TBorderWidth;
  Padding: TPadding; Options: THelperOptions);
  procedure Line(Canvas: TCanvas; x1, y1, x2, y2: Integer);
  begin
    Canvas.MoveTo(x1, y1);
    Canvas.LineTo(x2, y2);
  end;
var
  SaveBk: TColor;
  SavePen, SaveBrush: TPersistent;
begin
  SavePen := nil;
  SaveBrush := nil;

  try
    if Canvas.Handle = 0 then
      Exit;

    // save canvas state
    SavePen := TPen.Create;
    SavePen.Assign(Canvas.Pen);
    SaveBrush := TBrush.Create;
    SaveBrush.Assign(Canvas.Brush);

    Canvas.Pen.Mode := pmNot;
    Canvas.Pen.Style := psDash;
    Canvas.Brush.Style := bsClear;

    // ClientRect Helper
    if THelperOption.hoClientRect in Options then
    begin
      SaveBk := SetBkColor(Canvas.Handle, RGB(127,255,255));
      DrawFocusRect(Canvas.Handle, Rect);
      SetBkColor(Canvas.Handle, SaveBk);
    end;

    // Border Helper
    if THelperOption.hoBorder in Options then
    begin
      if (BorderWidth <> 0) and (BorderWidth * 2 <= RectWidth(Rect)) and (BorderWidth * 2 <= RectHeight(Rect)) then
        Canvas.Rectangle(Rect.Left + BorderWidth, Rect.Top + BorderWidth,
          Rect.Right - BorderWidth, Rect.Bottom - BorderWidth);
    end;

    // Padding Helper
    if THelperOption.hoPadding in Options then
    begin
      if (BorderWidth + Padding.Top < RectHeight(Rect) - BorderWidth - Padding.Bottom) and
         (BorderWidth + Padding.Left < RectWidth(Rect) - BorderWidth - Padding.Right) then
      begin
        Canvas.Pen.Style := psDot;

        if Padding.Left <> 0 then
          Line(Canvas, Rect.Left + Padding.Left + BorderWidth, Rect.Top + Padding.Top + BorderWidth,
            Rect.Left + Padding.Left + BorderWidth, Rect.Bottom - Padding.Bottom - BorderWidth - 1);
        if Padding.Top <> 0 then
          Line(Canvas, Rect.Left + Padding.Left + BorderWidth, Rect.Top + Padding.Top + BorderWidth,
            Rect.Right - Padding.Right - BorderWidth - 1, Rect.Top + Padding.Top + BorderWidth);
        if Padding.Right <> 0 then
          Line(Canvas, Rect.Right - Padding.Right - BorderWidth - 1, Rect.Top + Padding.Top + BorderWidth,
            Rect.Right - Padding.Right - BorderWidth - 1, Rect.Bottom - Padding.Bottom - BorderWidth - 1);
        if Padding.Bottom <> 0 then
          Line(Canvas, Rect.Left + Padding.Left + BorderWidth, Rect.Bottom - Padding.Bottom - BorderWidth - 1,
            Rect.Right - Padding.Right - BorderWidth - 1, Rect.Bottom - Padding.Bottom - BorderWidth - 1);
      end;
    end;

    Canvas.Pen.Assign(SavePen);
    Canvas.Brush.Assign(SaveBrush);
  finally
    SavePen.Free;
    SaveBrush.Free;
  end;
end;

procedure DrawControlHelper(Control: TControl; Options: THelperOptions);
var
  Canvas: TCanvas;
  Padding: TPadding;
  BorderWidth: Integer;
  MyCanvas: Boolean;
begin
  MyCanvas := False;
  Canvas := nil;
  Padding := nil;
  BorderWidth := 0;

  // if win control
  if Control is TWinControl then
  begin
    // get padding
    Padding := TWinControl(Control).Padding;
    // get canvas
    if Control is TEsCustomControl then
      Canvas := TEsCustomControl(Control).Canvas
    else
    begin
      MyCanvas := True;
      Canvas := TControlCanvas.Create;
      TControlCanvas(Canvas).Control := Control;
    end;
    // get border width
    if Control is TEsBaseLayout then
      BorderWidth := TEsBaseLayout(Control).BorderWidth
    else
      BorderWidth := TOpenCtrl(Control).BorderWidth;
  end else
  if Control is TGraphicControl then
  begin
    // get canvas
    Canvas := TEsGraphicControl(Control).Canvas;
    if Control is TEsGraphicControl then
      Padding := TEsGraphicControl(Control).Padding;
  end;

  try
    DrawControlHelper(Canvas, Control.ClientRect, BorderWidth, Padding, Options);
  finally
    if MyCanvas then
      Canvas.Free;
  end;
end;
{$ENDREGION} {$ENDIF}

function IsStyledClientControl(Control: TControl): Boolean;
begin
  Result := False;

  {$IFDEF VER230UP}
  if Control = nil then
    Exit;

  if StyleServices.Enabled then
  begin
    Result := {$ifdef VER240UP}(seClient in Control.StyleElements) and{$endif}
      TStyleManager.IsCustomStyleActive;
  end;
  {$ENDIF}
end;

function CalcClientRect(Control: TControl): TRect;
var
  {$ifdef FAST_CALC_CLIENTRECT}
  Info: TWindowInfo;
  {$endif}
  IsFast: Boolean;
begin
  {$ifdef FAST_CALC_CLIENTRECT}
  IsFast := True;
  {$else}
  IsFast := False;
  {$endif}

  Result := Rect(0, 0, Control.Width, Control.Height);

  // Only TWinControl's has non client area
  if not (Control is TWinControl) then
    Exit;

  // Fast method not work for controls not having Handle
  if not TWinControl(Control).Handle <> 0 then
    IsFast := False;

  if IsFast then
  begin
    ZeroMemory(@Info, SizeOf(TWindowInfo));
    Info.cbSize := SizeOf(TWindowInfo);
    GetWindowInfo(TWinControl(Control).Handle, info);
    Result.Left := Info.rcClient.Left - Info.rcWindow.Left;
    Result.Top := Info.rcClient.Top - Info.rcWindow.Top;
    Result.Right := -Info.rcWindow.Left + Info.rcClient.Right;
    Result.Top := -Info.rcWindow.Top + Info.rcClient.Bottom;
  end else
  begin
    Control.Perform(WM_NCCALCSIZE, 0, LParam(@Result));
  end;
end;

procedure DrawParentImage(Control: TControl; DC: HDC; InvalidateParent: Boolean = False);
var
  ClientRect: TRect;
  P: TPoint;
  SaveIndex: Integer;
begin
  if Control.Parent = nil then
    Exit;
  SaveIndex := SaveDC(DC);
  GetViewportOrgEx(DC, P);

  // if control has non client border then need additional offset viewport
  ClientRect := Control.ClientRect;
  if (ClientRect.Right <> Control.Width) or (ClientRect.Bottom <> Control.Height) then
  begin
    ClientRect := CalcClientRect(Control);
    SetViewportOrgEx(DC, P.X - Control.Left - ClientRect.Left, P.Y - Control.Top - ClientRect.Top, nil);
  end else
    SetViewportOrgEx(DC, P.X - Control.Left, P.Y - Control.Top, nil);

  IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);

  Control.Parent.Perform(WM_ERASEBKGND, DC, 0);
  // Control.Parent.Perform(WM_PAINT, DC, 0);
  Control.Parent.Perform(WM_PRINTCLIENT, DC, PRF_CLIENT);

  RestoreDC(DC, SaveIndex);

  if InvalidateParent then
    if not (Control.Parent is TCustomControl) and not (Control.Parent is TCustomForm) and
       not (csDesigning in Control.ComponentState)and not (Control.Parent is TEsCustomControl) then
    begin
      Control.Parent.Invalidate;
    end;

  SetViewportOrgEx(DC, P.X, P.Y, nil);
end;

{ TESCustomControl }

procedure BitMapDeleteAndNil(var BitMap: HBITMAP);{$IFDEF VER210UP}inline;{$ENDIF}
begin
  if BitMap <> 0 then
  begin
    DeleteObject(BitMap);
    BitMap := 0;
  end;
end;

procedure TEsCustomControl.BeginCachedBackground;
begin
  if CacheBackground <> 0 then BitMapDeleteAndNil(CacheBackground);
  StoredCachedBackground := FIsCachedBackground;
  FIsCachedBackground := True;
end;

procedure TEsCustomControl.BeginCachedBuffer;
begin
  if CacheBitmap <> 0 then BitMapDeleteAndNil(CacheBitmap);
  StoredCachedBuffer := FIsCachedBuffer;
  FIsCachedBuffer := True;
end;

procedure TEsCustomControl.CMParentBufferedChildrensChanged(var Message: TMessage);
begin
  if FParentBufferedChildrens then
  begin
    if Parent <> nil then
    begin
      if Parent is TEsCustomControl then
        BufferedChildrens := TEsCustomControl(Parent).BufferedChildrens
      else
        BufferedChildrens := False;
    end;
    FParentBufferedChildrens := True;
  end;
end;

procedure TEsCustomControl.CMTextChanged(var Message: TMessage);
begin
  inherited;
  UpdateText;
end;

procedure TEsCustomControl.WMTextChanges(var Message: TMessage);
begin
  Inherited;
  UpdateText;
end;

constructor TEsCustomControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  ControlStyle := ControlStyle - [csOpaque] + [csParentBackground];
  {$IFDEF VER210UP}
  ParentDoubleBuffered := False;
  {$ENDIF}
  FParentBufferedChildrens := True;// !!
  CacheBitmap := 0;
  CacheBackground := 0;
  FIsCachedBuffer := False;
  FIsCachedBackground := False;
end;

procedure TEsCustomControl.DeleteCache;
begin
  if CacheBitmap <> 0 then BitMapDeleteAndNil(CacheBitmap);
  if CacheBackground <> 0 then BitMapDeleteAndNil(CacheBackground);
end;

destructor TEsCustomControl.Destroy;
begin
  FCanvas.Free;
  DeleteCache;
  inherited;
end;

procedure TEsCustomControl.DrawBackground(DC: HDC);
begin
  DrawParentImage(Self, DC, False);
end;

procedure TEsCustomControl.DrawBackgroundForOpaqueControls(DC: HDC);
var
  i: integer;
  Control: TControl;
  Prop: Pointer;
begin
  for i := 0 to ControlCount - 1 do
  begin
    Control := Controls[i];
    if (Control is TGraphicControl) and (csOpaque in Control.ControlStyle) and Control.Visible and
       (not (csDesigning in ComponentState) or not (csNoDesignVisible in ControlStyle)
       {$IFDEF VER210UP}or not (csDesignerHide in Control.ControlState){$ENDIF})
    then
    begin
      // Necessary to draw a background if the control has a Property 'Transparent' and hasn't a Property 'Color'
      Prop := GetPropInfo(Control.ClassInfo, 'Transparent');
      if Prop <> nil then
      begin
        Prop := GetPropInfo(Control.ClassInfo, 'Color');
        if Prop = nil then
          FillRect(DC, Rect(Control.Left, Control.Top, Control.Left + Control.Width, Control.Top + Control.Height), Brush.Handle);
      end;
    end;
//    if (Control is TGraphicControl) and (Control is TSpeedButton) and (csOpaque in Control.ControlStyle) and
//      Control.Visible and (not (csDesigning in ComponentState) or not (csDesignerHide in Control.ControlState) and
//      not (csNoDesignVisible in ControlStyle)) then
//        FillRect(DC, Rect(Control.Left, Control.Top, Control.Left + Control.Width, Control.Top + Control.Height), Brush.Handle);
  end;
end;

procedure TEsCustomControl.EndCachedBackground;
begin
  FIsCachedBackground := StoredCachedBackground;
end;

procedure TEsCustomControl.EndCachedBuffer;
begin
  FIsCachedBuffer := StoredCachedBuffer;
end;

function TEsCustomControl.GetIsOpaque: Boolean;
begin
  Result := csOpaque in ControlStyle;
end;

function TEsCustomControl.GetTransparent: Boolean;
begin
  Result := ParentBackground;
end;

procedure TEsCustomControl.Paint;
var
  SaveBk: TColor;
begin
  // for Design time
  if IsDrawHelper and(csDesigning in ComponentState) then
  begin
    SaveBk := SetBkColor(Canvas.Handle, RGB(127,255,255));
    DrawFocusRect(Canvas.Handle, Self.ClientRect);
    SetBkColor(Canvas.Handle, SaveBk);
  end;
end;

{ TODO -cCRITICAL : 22.02.2013:
  eliminate duplication of code! }
procedure TEsCustomControl.PaintHandler(var Message: TWMPaint);
var
  PS: TPaintStruct;
  BufferDC: HDC;
  BufferBitMap: HBITMAP;
  UpdateRect: TRect;
  SaveViewport: TPoint;
  Region: HRGN;
  DC: HDC;
  IsBeginPaint: Boolean;
begin
  BufferBitMap := 0;
  Region := 0;
  IsBeginPaint := Message.DC = 0;

  if IsBeginPaint then
  begin
    DC := BeginPaint(Handle, PS);
    {$IFDEF VER230UP}
    if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
      UpdateRect := ClientRect
      // I had to use a crutch to ClientRect, due to the fact that
      // VCL.Styles.TCustomStyle.DoDrawParentBackground NOT use relative coordinates,
      // ie ignores SetViewportOrgEx!
      // This function uses ClientToScreen and ScreenToClient for coordinates calculation!
    else
    {$endif}
      UpdateRect := PS.rcPaint;
  end
  else
  begin
    DC := Message.DC;
    {$IFDEF VER230UP}
    if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
      UpdateRect := ClientRect
    else
    {$endif}
      if GetClipBox(DC, UpdateRect) = ERROR then
        UpdateRect := ClientRect;
  end;

  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintWindow
  //------------------------------------------------------------------------------------------------
  // if control not double buffered then create or assign buffer
  if not DoubleBuffered then
  begin
    BufferDC := CreateCompatibleDC(DC);
    // CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
    // return <> 0 => need to double buffer || return = 0 => no need to double buffer
    if BufferDC <> 0 then
    begin
      // Using the cache if possible
      if FIsCachedBuffer or FIsFullSizeBuffer then
      begin
        // Create cache if need
        if CacheBitmap = 0 then
        begin
          BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
          // Assign to cache if need
          if FIsCachedBuffer then
            CacheBitmap := BufferBitMap;
        end
        else
          BufferBitMap := CacheBitmap;

        // Assign region for minimal overdraw
        Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
        SelectClipRgn(BufferDC, Region);
      end
      else
        // Create buffer
        BufferBitMap := CreateCompatibleBitmap(DC,
          UpdateRect.Right - UpdateRect.Left, UpdateRect.Bottom - UpdateRect.Top);
      // Select buffer bitmap
      SelectObject(BufferDC, BufferBitMap);
      // [change coord], if need
      // Moving update region to the (0,0) point
      if not(FIsCachedBuffer or FIsFullSizeBuffer) then
      begin
        GetViewportOrgEx(BufferDC, SaveViewport);
        SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
      end;
    end
    else
      BufferDC := DC;
  end
  else
    BufferDC := DC;
  //------------------------------------------------------------------------------------------------

  // DEFAULT HANDLER:
  Message.DC := BufferDC;
  inherited PaintHandler(Message);

  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintWindow
  //------------------------------------------------------------------------------------------------
  // draw to window
  if not DoubleBuffered then
  begin
    if not(FIsCachedBuffer or FIsFullSizeBuffer) then
    begin
      // [restore coord], if need
      SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
    end
    else
    begin
      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
        UpdateRect.Left, UpdateRect.Top, SRCCOPY);
    end;
  end;

  if BufferDC <> DC then
    DeleteObject(BufferDC);
  if Region <> 0 then
    DeleteObject(Region);
  // delete buufer, if need
  if not FIsCachedBuffer and (BufferBitMap <> 0) then
    DeleteObject(BufferBitMap);
  //------------------------------------------------------------------------------------------------

  // end paint, if need
  if IsBeginPaint then
    EndPaint(Handle, PS);
end;

{$ifdef VER210UP} {$REGION 'BACKUP'}
(*
// Main magic located here:
procedure TESCustomControl.PaintWindow(DC: HDC);
var
  BufferDC, TempDC: HDC;
  BufferBitMap: HBITMAP;
  UpdateRect: TRect;
  SaveViewport: TPoint;
  Region: HRGN;
begin
  //UpdateRect := Rect(0, 0, Width, Height);
  //GetClipBox(DC, UpdateRect);
  if GetClipBox(DC, UpdateRect) = ERROR then
    UpdateRect := Rect(0, 0, Width, Height);

  if not DoubleBuffered then
  begin
    BufferDC := CreateCompatibleDC(DC);
    // for bitmap context
    if BufferDC = 0 then
      BufferDC := DC
    else
    begin
      if FCachedBuffer then
      begin
        if CacheBuffer = 0 then
          CacheBuffer := CreateCompatibleBitmap(DC, Width, Height);
        BufferBitMap := CacheBuffer;
        Region := CreateRectRgn(0, 0, UpdateRect.Width, UpdateRect.Height);
        SelectClipRgn(BufferDC, Region);
      end
      else
        BufferBitMap := CreateCompatibleBitmap(DC, UpdateRect.Width, UpdateRect.Height);
      SelectObject(BufferDC, BufferBitMap);
    end;
  end
  else
    BufferDC := DC;

  // change coord
  if (not DoubleBuffered){ and (not FCachedBuffer)} then
  begin
    GetViewportOrgEx(BufferDC, SaveViewport);
    SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
  end;

  if not(csOpaque in ControlStyle) then
    if ParentBackground then
    begin
      if FCachedBackground then
      begin
        if CacheBackground = 0 then
        begin
          TempDC := CreateCompatibleDC(DC);
          CacheBackground := CreateCompatibleBitmap(DC, Width, Height);
          SelectObject(TempDC, CacheBackground);
          DrawParentImage(Self, TempDC, False);
          DeleteDC(TempDC);
        end;
        TempDC := CreateCompatibleDC(BufferDC);
        SelectObject(TempDC, CacheBackground);
        BitBlt(BufferDC, 0, 0, UpdateRect.Width, UpdateRect.Height, TempDC, 0, 0, SRCCOPY);
        DeleteDC(TempDC);
      end
      else
        DrawParentImage(Self, BufferDC, False);
    end else
      if (not DoubleBuffered) then
        FillRect(BufferDC, Rect(0, 0, Width, Height), Brush.Handle);

  FCanvas.Lock;
  try
    Canvas.Handle := BufferDC;
    TControlCanvas(Canvas).UpdateTextFlags;
    Paint;
    //Canvas.Brush.Color := Random(256*256*256);
    //Canvas.FillRect(Updaterect);
  finally
    FCanvas.Handle := 0;
    FCanvas.Unlock;
  end;

  if IsDrawHelper and(csDesigning in ComponentState) then
  begin
    SetBkColor(BufferDC, RGB(127,255,255));
    DrawFocusRect(BufferDC, self.ClientRect);//self.ClientRect);// for Design
  end;

  // restore coord
  if (not DoubleBuffered){ and (not FCachedBuffer)} then
    SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);

  if not DoubleBuffered then
  begin
    if not FCachedBuffer then
      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Width, UpdateRect.Height, BufferDC, 0, 0, SRCCOPY)
    else
    begin
      //BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Width, UpdateRect.Height, BufferDC, UpdateRect.Left, UpdateRect.Top, SRCCOPY);
      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Width, UpdateRect.Height, BufferDC, 0, 0, SRCCOPY);
      DeleteObject(Region);
    end;
    DeleteDC(BufferDC);
  end;

  if not FCachedBuffer and (BufferBitMap <> 0) then DeleteObject(BufferBitMap);
end;
*)
{$ENDREGION} {$endif}

{ TODO -cMAJOR : 22.02.2013:
 See: PaintHandler,
 need eliminate duplication of code! }
procedure TEsCustomControl.PaintWindow(DC: HDC);
var
  TempDC: HDC;
  UpdateRect: TRect;
  //---
  BufferDC: HDC;
  BufferBitMap: HBITMAP;
  Region: HRGN;
  SaveViewport: TPoint;
  BufferedThis: Boolean;
begin
  BufferBitMap := 0;
  Region := 0;

  if GetClipBox(DC, UpdateRect) = ERROR then
    UpdateRect := ClientRect;

  BufferedThis := not BufferedChildrens;

  if BufferedThis then
  begin
  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintHandler
  //------------------------------------------------------------------------------------------------
    // if control not double buffered then create or assign buffer
    if not DoubleBuffered then
    begin
      BufferDC := CreateCompatibleDC(DC);
      // CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
      // return <> 0 => need to double buffer || return = 0 => no need to double buffer
      if BufferDC <> 0 then
      begin
        // Using the cache if possible
        if FIsCachedBuffer or FIsFullSizeBuffer then
        begin
          // Create cache if need
          if CacheBitmap = 0 then
          begin
            BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
            // Assign to cache if need
            if FIsCachedBuffer then
              CacheBitmap := BufferBitMap;
          end
          else
            BufferBitMap := CacheBitmap;

          // Assign region for minimal overdraw
          Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
          SelectClipRgn(BufferDC, Region);
        end
        else
          // Create buffer
          BufferBitMap := CreateCompatibleBitmap(DC, RectWidth(UpdateRect), RectHeight(UpdateRect));
        // Select buffer bitmap
        SelectObject(BufferDC, BufferBitMap);
        // [change coord], if need
        // Moving update region to the (0,0) point
        if not(FIsCachedBuffer or FIsFullSizeBuffer) then
        begin
          GetViewportOrgEx(BufferDC, SaveViewport);
          SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
        end;
      end
      else
        BufferDC := DC;
    end
    else
      BufferDC := DC;
  //------------------------------------------------------------------------------------------------
  end else
    BufferDC := DC;

  if not(csOpaque in ControlStyle) then
    if ParentBackground then
    begin
      if FIsCachedBackground then
      begin
        if CacheBackground = 0 then
        begin
          TempDC := CreateCompatibleDC(DC);
          CacheBackground := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
          SelectObject(TempDC, CacheBackground);
          DrawBackground(TempDC); //DrawParentImage(Self, TempDC, False);
          DeleteDC(TempDC);
        end;
        TempDC := CreateCompatibleDC(BufferDC);
        SelectObject(TempDC, CacheBackground);
        if not FIsCachedBuffer then
          BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
            UpdateRect.Left, UpdateRect.Top, SRCCOPY)
        else
          BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
            UpdateRect.Left, UpdateRect.Top, SRCCOPY);
        DeleteDC(TempDC);
      end
      else
        DrawBackground(BufferDC); //DrawParentImage(Self, BufferDC, False);
    end else
      if (not DoubleBuffered or (DC <> 0)) then
        if not IsStyledClientControl(Self) then
          FillRect(BufferDC, ClientRect, Brush.Handle)
        else
        begin
          SetDCBrushColor(BufferDC,
            ColorToRGB({$ifdef VER230UP}StyleServices.GetSystemColor(Color){$else}Color{$endif}));
          FillRect(BufferDC, ClientRect, GetStockObject(DC_BRUSH));
        end;

  FCanvas.Lock;
  try
    Canvas.Handle := BufferDC;
    TControlCanvas(Canvas).UpdateTextFlags;

    if Assigned(FOnPainting) then
      FOnPainting(Self, Canvas, ClientRect);
    Paint;
    if Assigned(FOnPaint) then
      FOnPaint(Self, Canvas, ClientRect);
  finally
    FCanvas.Handle := 0;
    FCanvas.Unlock;
  end;

  if BufferedThis then
  begin
  //------------------------------------------------------------------------------------------------
  // Dublicate code, see PaintHandler
  //------------------------------------------------------------------------------------------------
    // draw to window
    if not DoubleBuffered then
    begin
      if not(FIsCachedBuffer or FIsFullSizeBuffer) then
      begin
        // [restore coord], if need
        SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
        BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
      end
      else
      begin
        BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
          UpdateRect.Left, UpdateRect.Top, SRCCOPY);
      end;
    end;

    if (BufferDC <> DC) then
      DeleteObject(BufferDC);
    if Region <> 0 then
      DeleteObject(Region);
    // delete buufer, if need
    if not FIsCachedBuffer and (BufferBitMap <> 0) then
      DeleteObject(BufferBitMap);
  //------------------------------------------------------------------------------------------------
  end;
end;

function TEsCustomControl.IsBufferedChildrensStored: Boolean;
begin
  Result := not ParentBufferedChildrens;
end;

procedure TEsCustomControl.SetBufferedChildrens(const Value: Boolean);
begin
  if Value <> FBufferedChildrens then
  begin
    FBufferedChildrens := Value;
    FParentBufferedChildrens := False;
    NotifyControls(CM_PARENT_BUFFEREDCHILDRENS_CHANGED);
  end;
end;

procedure TEsCustomControl.SetIsCachedBackground(Value: Boolean);
begin
  if Value <> FIsCachedBackground then
  begin
    FIsCachedBackground := Value;
    if not FIsCachedBackground then BitMapDeleteAndNil(CacheBackground);
  end;
end;

procedure TEsCustomControl.SetIsCachedBuffer(Value: Boolean);
begin
  if Value <> FIsCachedBuffer then
  begin
    FIsCachedBuffer := Value;
    if not FIsCachedBuffer then BitMapDeleteAndNil(CacheBitmap);
  end;
end;

procedure TEsCustomControl.SetIsDrawHelper(const Value: Boolean);
begin
  FIsDrawHelper := Value;
  if csDesigning in ComponentState then Invalidate;
end;

procedure TEsCustomControl.SetIsOpaque(const Value: Boolean);
begin
  if Value <> (csOpaque in ControlStyle) then
  begin
    if Value then
    begin
      ControlStyle := ControlStyle + [csOpaque];
    end else
    begin
      ControlStyle := ControlStyle - [csOpaque];
    end;
    Invalidate;
  end;
end;

procedure TEsCustomControl.SetParentBufferedChildrens(const Value: Boolean);
begin
  //FParentBufferedChildrens := Value;
  if Value <> FParentBufferedChildrens then
  begin
//    if (Parent <> nil) and Value then
//    begin
//      if Parent is TESCustomControl then
//        BufferedChildrens := TESCustomControl(Parent).BufferedChildrens
//      else
//        BufferedChildrens := False;
//    end
//    else
//      if Value then
//        BufferedChildrens := False;
//    FParentBufferedChildrens := Value;
    FParentBufferedChildrens := Value;
    if (Parent <> nil) and not (csReading in ComponentState) then
      Perform(CM_PARENT_BUFFEREDCHILDRENS_CHANGED, 0, 0);
  end;
end;

procedure TEsCustomControl.SetTransparent(const Value: Boolean);
begin
  ParentBackground := Value;
end;

procedure TEsCustomControl.UpdateBackground;
begin
  UpdateBackground(True);
end;

procedure TEsCustomControl.UpdateText;
begin
end;

procedure TEsCustomControl.UpdateBackground(Repaint: Boolean);
begin
  // Delete cache background
  if CacheBackground <> 0 then BitMapDeleteAndNil(CacheBackground);
  if Repaint then Invalidate;
end;

procedure TEsCustomControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if DoubleBuffered {and not(csOpaque in ControlStyle)} then
  begin
    Inherited;
    Message.Result := 1;
    exit;
  end;
  if ControlCount <> 0 then
    DrawBackgroundForOpaqueControls(Message.DC);
  Message.Result := 1;
end;

//procedure TEsCustomControl.WMNCHitTest(var Message: TWMNCHitTest);
//begin
//  if (FIsTransparentMouse) and not(csDesigning in ComponentState) then
//    Message.Result := HTTRANSPARENT
//  else
//    inherited;
//end;

procedure TEsCustomControl.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  if BufferedChildrens and (not FDoubleBuffered or (Message.DC <> 0)) then
  begin
    PaintHandler(Message)// My new PaintHandler
  end
  else
    inherited;// WMPaint(Message);
  ControlState := ControlState - [csCustomPaint];
end;

procedure TEsCustomControl.WMSize(var Message: TWMSize);
begin
  DeleteCache;
  inherited;
end;

procedure TEsCustomControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  if not (csOpaque in ControlStyle) and ParentBackground{ and not CachedBackground }then
    Invalidate;
  Inherited;
end;

{$IFDEF VER180UP}
{ TEsBaseLayout }

procedure TEsBaseLayout.AdjustClientRect(var Rect: TRect);
begin
  inherited AdjustClientRect(Rect);
  if BorderWidth <> 0 then
  begin
    InflateRect(Rect, -Integer(BorderWidth), -Integer(BorderWidth));
  end;
end;

procedure TEsBaseLayout.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited AlignControls(AControl, Rect);
  if (csDesigning in ComponentState) and IsDrawHelper then
    Invalidate;
end;

procedure TEsBaseLayout.CalcContentMargins(var Margins: TContentMargins);
begin
  Margins.Create(Padding.Left, Padding.Top, Padding.Right, Padding.Bottom);
  if BorderWidth <> 0 then
    Margins.Inflate(Integer(BorderWidth), Integer(BorderWidth));
end;

function TEsBaseLayout.ContentMargins: TContentMargins;
begin
  Result.Reset;
  CalcContentMargins(Result);
end;

function TEsBaseLayout.ContentRect: TRect;
var
  ContentMargins: TContentMargins;
begin
  Result := ClientRect;

  ContentMargins.Reset;
  CalcContentMargins(ContentMargins);

  Inc(Result.Left, ContentMargins.Left);
  Inc(Result.Top, ContentMargins.Top);
  Dec(Result.Right, ContentMargins.Right);
  Dec(Result.Bottom, ContentMargins.Bottom);

  {$ifdef TEST_CONTROL_CONTENT_RECT}
  if Result.Left > Result.Right then
    Result.Right := Result.Left;
  if Result.Top > Result.Bottom then
    Result.Bottom := Result.Top;
  {$endif}
end;

procedure TEsBaseLayout.Paint;
begin
  if (csDesigning in ComponentState) and IsDrawHelper then
    DrawControlHelper(Self, [hoBorder, hoPadding, hoClientRect]);
end;

procedure TEsBaseLayout.SetBorderWidth(const Value: TBorderWidth);
begin
  if Value <> FBorderWidth then
  begin
    FBorderWidth := Value;
    Realign;
    Invalidate;
  end;
end;

{ TEsGraphicControl }

procedure TEsGraphicControl.CalcContentMargins(var Margins: TContentMargins);
begin
  if FPadding <> nil then
    Margins.Create(Padding.Left, Padding.Top, Padding.Right, Padding.Bottom)
  else
    Margins.Reset;
end;

function TEsGraphicControl.ContentMargins: TContentMargins;
begin
  Result.Reset;
  CalcContentMargins(Result);
end;

function TEsGraphicControl.ContentRect: TRect;
var
  ContentMargins: TContentMargins;
begin
  Result := ClientRect;

  ContentMargins.Reset;
  CalcContentMargins(ContentMargins);

  Inc(Result.Left, ContentMargins.Left);
  Inc(Result.Top, ContentMargins.Top);
  Dec(Result.Right, ContentMargins.Right);
  Dec(Result.Bottom, ContentMargins.Bottom);

  {$ifdef TEST_CONTROL_CONTENT_RECT}
  if Result.Left > Result.Right then
    Result.Right := Result.Left;
  if Result.Top > Result.Bottom then
    Result.Bottom := Result.Top;
  {$endif}
end;

destructor TEsGraphicControl.Destroy;
begin
  FPadding.Free;
  inherited;
end;

function TEsGraphicControl.GetPadding: TPadding;
begin
  if FPadding = nil then
  begin
    FPadding := TPadding.Create(nil);
    FPadding.OnChange := PaddingChange;
  end;
  Result := FPadding;
end;

function TEsGraphicControl.HasPadding: Boolean;
begin
  Result := FPadding <> nil;
end;

procedure TEsGraphicControl.PaddingChange(Sender: TObject);
begin
  AdjustSize;
  Invalidate;
  if (FPadding.Left = 0) and (FPadding.Top = 0) and (FPadding.Right = 0) and (FPadding.Bottom = 0) then
    FreeAndNil(FPadding);
end;

procedure TEsGraphicControl.Paint;
begin
  if (csDesigning in ComponentState) and IsDrawHelper then
    DrawControlHelper(Self, [hoPadding, hoClientRect]);
end;

procedure TEsGraphicControl.SetIsDrawHelper(const Value: Boolean);
begin
  if FIsDrawHelper <> Value then
  begin
      FIsDrawHelper := Value;
      if csDesigning in ComponentState then
        Invalidate;
  end;
end;

procedure TEsGraphicControl.SetPadding(const Value: TPadding);
begin
  Padding.Assign(Value);
end;

{ TContentMargins }

constructor TContentMargins.Create(Left, Top, Right, Bottom: TMarginSize);
begin
  Self.Left := Left;
  Self.Top := Top;
  Self.Right := Right;
  Self.Bottom := Bottom;
end;

procedure TContentMargins.Reset;
begin
  Left := 0;
  Top 
    
            
© Habrahabr.ru