{****************************************************
 This file is part of the Eye Candy Controls (EC-C)
 
  Copyright (C) 2013 Vojtěch Čihák, Czech Republic
 
  This library is free software.

  See the file COPYING.LGPL.txt, 
  included in this distribution,
  for details about the license.
****************************************************}   

unit ECTypes;
{$mode objfpc}{$H+}  

//{$DEFINE DBGLINE}  {don't remove, just comment}

interface

uses
  Classes, SysUtils, Controls, Graphics, Messages, LMessages, Math, LCLIntf, LCLType,
  {$IFDEF DBGLINE} LCLProc, {$ENDIF} StdCtrls, StrUtils, Themes, Types;

type
  {$PACKENUM 2}
  TBasicPos = (ebpTopLeft, ebpBottomRight);
  TColorLayout = (eclRGBColor, eclBGRColor, eclARGBColor, eclABGRColor, eclCMYColor, 
                  eclYMCColor, eclACMYColor, eclAYMCColor, eclSystemBGR);
  TGlyphDesign = (egdNone, egdArrowDec, egdArrowInc,
                  egdArrowUp, egdArrowRight, egdArrowDown, egdArrowLeft,
                  egdArrowUR, egdArrowDR, egdArrowDL, egdArrowUL,
                  egdArrowsUU, egdArrowsRR, egdArrowsDD, egdArrowsLL,
                  egdArrowsUD, egdArrowsMiddle, egdArrowsLR, egdArrowsHMiddle,
                  egdArrowsMax, egdArrowMax, egdArrowMin, egdArrowsMin,
                  egdArrowsHMax, egdArrowHMax, egdArrowHMin, egdArrowsHMin,
                  egdArrowsUDHor, egdArrowsURDL_S, egdArrowsURDL_M, egdArrowURDL_L,
                  egdArrowURDL_XL, egdArrowsUL_DR, egdArrowsUR_DL,
                  egdArrsB_Min, egdArrB_Min, egdArrsB_DD, egdArrB_Down, 
                  egdArrsB_Middle, egdArrsB_UD, egdArrB_Up, egdArrsB_UU,
                  egdArrB_Max, egdArrsB_Max,
                  egdArrsB_HMin, egdArrB_HMin, egdArrsB_LL, egdArrB_Left,
                  egdArrsB_HMiddle, egdArrsB_LR, egdArrB_Right, egdArrsB_RR,
                  egdArrB_HMax, egdArrsB_HMax,
                  egdArrC_Min, egdArrC_DD, egdArrC_Down, egdArrC_Middle,
                  egdArrC_UD, egdArrC_LR, egdArrC_Up, egdArrC_UU,
                  egdArrC_Max, egdArrC_URDL,
                  egdPlayPause, egdPlayUpDown, egdPlayStop, egdPlayEject, egdPlayEjectD,
                  egdMathBigMinus, egdMathMinus, egdMathEqual, egdMathPlusMinus, 
                  egdMathPlus, egdMathBigPlus, 
                  egdCombo, egdList, egdFramedList, 
                  egdGrid,
                  egdSizeArrUp, egdSizeArrRight, egdSizeArrDown, egdSizeArrLeft,
                  egdRectBeveled, egdRectFramed,  { coloured with 3D/clBtnText frame }
                  egdWinRectClr, egdWinRoundClr,  { for color dialogs }
                  egdWindowRect, egdWindowRound);  { Total: egdNone + 84 glyphs }
  TIncrementalMode = (eimContinuous, eimDiscrete);
  TItemState = (eisDisabled, eisHighlighted, eisEnabled, 
                eisPushed, eisPushedHihlighted, eisPushedDisabled);	
  TItemStates = set of TItemState;
  TObjectOrientation = (eooHorizontal, eooVertical);
  TObjectPos = (eopTop, eopRight, eopBottom, eopLeft);
  TObjectStyle = (eosButton, eosPanel);                  
  TRedrawMode = (ermHoverKnob, ermMoveKnob, ermFreeRedraw, ermRedrawBkgnd, ermRecalcRedraw);
  TTickDesign = (etdSimple, etdThick, etd3DLowered, etd3DRaised);
  TTickStyle = (etsSolid, etsDotted);
  TValuesVisibility = (evvNone, evvBounds, evvValues, evvAll);
  { Events }
  TMouseMethod = procedure(Button: TMouseButton; Shift: TShiftState) of object;
  TObjectMethod = procedure of object;
  TOnPrepareValue = procedure(Sender: TObject; var AValue: Double) of object;
  
  { TCanvasHelper }
  TCanvasHelper = class helper for TCanvas
  public
    procedure DrawButtonBackground(ARect: TRect; AEnabled: Boolean);  
    procedure DrawButtonBackground(ARect: TRect; AItemState: TItemState); overload;
    procedure DrawGlyph(ARect: TRect; AGlyphDesign: TGlyphDesign);
    procedure DrawPanelBackground(ARect: TRect; ABevelInner, ABevelOuter: TBevelCut;
                ABevelWidth: Integer; AColor: TColor);      
    procedure DrawPanelBackground(ARect: TRect; ABevelInner, ABevelOuter: TBevelCut;
                ABevelSpace, ABevelWidth: Integer; AColor3DDark, AColor3DLight, AColor: TColor); 
    function GlyphExtent(AGlyphDesign: TGlyphDesign): TSize;
    procedure SetFontParams(AOrientation: Integer; ASize: Integer; AStyle: TFontStyles);
    procedure SetRealGlyphColor(AGlyphColor: TColor; AState: TItemState); overload;
  end;
  
  { TBitmapHelper }
  TBitmapHelper = class helper for TBitmap
  public
    procedure SetProperties(AWidth, AHeight: Integer);
    procedure TransparentClear;
  end;

  { TFontOptions }
  TFontOptions = class(TPersistent)
  private
    FFontColor: TColor;
    FFontSize: SmallInt;
    FFontStyles: TFontStyles;  
    procedure SetFontColor(const AValue: TColor);
    procedure SetFontSize(const AValue: SmallInt);
    procedure SetFontStyles(const AValue: TFontStyles);
  protected
    procedure RecalcRedraw;
    procedure Redraw;
  public
    OnRecalcRedraw: TObjectMethod;
    OnRedraw: TObjectMethod;
    Parent: TControl;
    constructor Create(AParent: TControl);
  published
    property FontColor: TColor read FFontColor write SetFontColor default clDefault;
    property FontSize: SmallInt read FFontSize write SetFontSize;
    property FontStyles: TFontStyles read FFontStyles write SetFontStyles;
  end;

  { TECBaseControl }
  TECBaseControl = class(TCustomControl)
  private
    procedure SetBevelInner(const AValue: TBevelCut);
    procedure SetBevelOuter(const AValue: TBevelCut);
    procedure SetBevelSpace(const AValue: SmallInt);
    procedure SetBevelWidth(const AValue: SmallInt); 
    procedure SetColor3DDark(const AValue: TColor);
    procedure SetColor3DLight(const AValue: TColor); 
    procedure SetOrientation(const AValue: TObjectOrientation);
    procedure SetStyle(AValue: TObjectStyle); 
  protected
    FBevelInner: TBevelCut;
    FBevelOuter: TBevelCut;
    FBevelSpace: SmallInt;
    FBevelWidth: SmallInt; 
    FColor3DDark: TColor;
    FColor3DLight: TColor;
    FInvalidRect: TRect;
    FOrientation: TObjectOrientation;
    FStyle: TObjectStyle;
    RedrawMode: TRedrawMode;
    function GetBorderWidth: Integer;  { Border = BevelInner + BevelOuter + BevelSpace }
    function HasCaption: Boolean; virtual;
    procedure InvalidateCustomRect(AMove: Boolean); virtual; abstract;
    procedure OrientationChanged({%H-}AValue: TObjectOrientation); virtual;
    procedure RecalcRedraw; virtual; abstract; 
    procedure Redraw3DColorAreas; virtual; abstract; 
    procedure SetAutoSize(Value: Boolean); override;
    procedure StyleChanged({%H-}AValue: TObjectStyle); virtual;
    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;  { resolves vanishing }
  public
    UpdateCount: SmallInt;
    constructor Create(AOwner: TComponent); override;
    procedure BeginUpdate; virtual;
    procedure EndUpdate(Recalculate: Boolean = True); virtual;
    procedure InvalidateNonUpdated;  { Invalidates non-updated component (UpdateCount = 0) }
    procedure Redraw; virtual; abstract;
    property BevelInner: TBevelCut read FBevelInner write SetBevelInner default bvNone;
    property BevelOuter: TBevelCut read FBevelOuter write SetBevelOuter default bvRaised;
    property BevelSpace: SmallInt read FBevelSpace write SetBevelSpace default 0;
    property BevelWidth: SmallInt read FBevelWidth write SetBevelWidth default 1;   
    property Color3DDark: TColor read FColor3DDark write SetColor3DDark default clDefault;
    property Color3DLight: TColor read FColor3DLight write SetColor3DLight default clDefault;  
    property Orientation: TObjectOrientation read FOrientation write SetOrientation;
    property Style: TObjectStyle read FStyle write SetStyle;
  end;
  
  { TECCustomKnob }
  TECCustomKnob = class(TPersistent)
  private
    FBackgroundColor: TColor;
    FBevelWidth: SmallInt;
    FColor: TColor;
    FCursor: TCursor;
    FHeight: Integer;
    FStyle: TObjectStyle;
    FTickMarkCount: SmallInt;
    FTickMarkDesign: TTickDesign;
    FTickMarkSpacing: SmallInt;
    FTickMarkStyle: TTickStyle;
    FWidth: Integer;
    procedure SetBackgroundColor(AValue: TColor);
    procedure SetBevelWidth(const AValue: SmallInt);
    procedure SetColor(const AValue: TColor);
    procedure SetCursor(const AValue: TCursor);
    procedure SetHeight(const AValue: Integer);
    procedure SetStyle(const AValue: TObjectStyle);
    procedure SetTickMarkCount(const AValue: SmallInt);
    procedure SetTickMarkDesign(const AValue: TTickDesign);
    procedure SetTickMarkSpacing(const AValue: SmallInt);
    procedure SetTickMarkStyle(const AValue: TTickStyle);
    procedure SetWidth(const AValue: Integer);
  protected const
    cDefBevelWidth = 2;
    cDefKnobHeight = 32;
    cDefKnobWidth = 20;
    cDefTickDesign = etd3DLowered;
    cDefTickMarkCount = 5;
    cDefTickMarkSpacing = 2;
  protected
    Parent: TECBaseControl;
    procedure DrawKnobs;
  public
    UpdateCount: SmallInt;
    KnobDisabled: TBitmap;
    KnobNormal: TBitmap;
    KnobHighlighted: TBitmap;
    Left: Integer;
    MouseEntered: Boolean;
    Top: Integer;
    constructor Create(AParent: TECBaseControl);
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure RecalcRedraw;
    procedure SetSize(AWidth, AHeight: Integer);
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
  public                            
    property BevelWidth: SmallInt read FBevelWidth write SetBevelWidth default cDefBevelWidth;
    property Color: TColor read FColor write SetColor default clDefault;
    property Cursor: TCursor read FCursor write SetCursor default crHandPoint;
    property Height: Integer read FHeight write SetHeight default cDefKnobHeight;
    property Style: TObjectStyle read FStyle write SetStyle default eosButton;
    property TickMarkCount: SmallInt read FTickMarkCount write SetTickMarkCount default cDefTickMarkCount;
    property TickMarkDesign: TTickDesign read FTickMarkDesign write SetTickMarkDesign default cDefTickDesign;
    property TickMarkSpacing: SmallInt read FTickMarkSpacing write SetTickMarkSpacing default cDefTickMarkSpacing;
    property TickMarkStyle: TTickStyle read FTickMarkStyle write SetTickMarkStyle default etsSolid;
    property Width: Integer read FWidth write SetWidth default cDefKnobWidth;
  end;   

  { TBaseScrollControl }                   
  TBaseScrollControl = class(TCustomControl)
  private
    FAreaHeight: Integer;
    FAreaWidth: Integer;    
    FIncrementX: SmallInt;
    FIncrementY: SmallInt;
    function GetFullAreaHeight: Integer;
    function GetFullAreaWidth: Integer;  
    procedure SetAreaHeight(AValue: Integer);
    procedure SetAreaWidth(AValue: Integer);  
    procedure SetClientAreaLeft(AValue: Integer);
    procedure SetClientAreaTop(AValue: Integer);  
    procedure SetScrollBars(AValue: TScrollStyle);
  protected
    FClientAreaLeft: Integer;
    FClientAreaTop: Integer;        
    FRequiredArea: TPoint;  { area where all devices can fit }
    FScrollBars: TScrollStyle;
    FScrollInfoHor, FScrollInfoVert: TScrollInfo;
    procedure CreateWnd; override;
    procedure SetDefaultScrollParams; virtual;
    procedure UpdateRequiredAreaHeight; virtual; abstract; 
    procedure UpdateRequiredAreaWidth; virtual; abstract;  
    procedure UpdateScrollBars(AValue: TScrollStyle);
    procedure UpdateScrollInfoHor;
    procedure UpdateScrollInfoVert;  
    procedure WMHScroll(var Msg: TWMScroll); message WM_HSCROLL;
    procedure WMSize(var Message: TLMSize); message LM_SIZE;
    procedure WMVScroll(var Msg: TWMScroll); message WM_VSCROLL;     
  public
    UpdateCount: SmallInt;
    constructor Create(AOwner: TComponent); override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure InvalidateNonUpdated;
    property AreaHeight: Integer read FAreaHeight write SetAreaHeight default -1;
    property AreaWidth: Integer read FAreaWidth write SetAreaWidth default -1;  
    property ClientAreaLeft: Integer read FClientAreaLeft write SetClientAreaLeft;
    property ClientAreaTop: Integer read FClientAreaTop write SetClientAreaTop;
    property FullAreaHeight: Integer read GetFullAreaHeight;
    property FullAreaWidth: Integer read GetFullAreaWidth;
    property IncrementX: SmallInt read FIncrementX write FIncrementX default 1;
    property IncrementY: SmallInt read FIncrementY write FIncrementY default 1;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssAutoBoth;
  end;

function ARGBToColor(A, R, G, B: Byte): TColor; inline;

procedure ColorToRGBA(AColor: TColor; out R, G, B, A: Integer);

function ColorToStrLayouted(AColor: TColor; AColorLayout: TColorLayout): string;

function GetColorResolvingDefault(ASourceColor, ADefColor: TColor): TColor; inline;

function GetColorResolvingDefAndEnabled(ASourceColor, ADefColor: TColor; AEnabled: Boolean): TColor; inline;

function GetMergedColor(AColor, BColor: TColor; AProportion: Single): TColor;

function GetMonochromaticColor(AColor: TColor): TColor;

procedure IncludeRectangle(var AResultRect: TRect; const AppendRect: TRect);

function IsInRange(AValue, ALimit, BLimit: Integer): Boolean;

function IsRectIntersect(ARect, BRect: TRect): Boolean;

function LinearToLogarithmic(AValue, AMin, AMax, ALogarithmBase: Double): Double;

function NormalizeRectangle(PointAX, PointAY, PointBX, PointBY: Integer): TRect;

function TrimColorString(AString: string): string;

function TryStrToColorLayouted(AString: string; ALayout: TColorLayout; out AColor: TColor): Boolean;

operator = (ARect, BRect: TRect): Boolean;

const pi_1800: Double = 0.00174532925199432958;  { = pi/1800 }
      caThemedContent: array[low(TItemState)..high(TItemState)] of TThemedButton = 
        (tbPushButtonDisabled, tbPushButtonHot, tbPushButtonNormal, 
         tbPushButtonPressed, tbPushButtonHot, tbPushButtonDisabled);
      caThemedItems: array[low(TItemState)..high(TItemState)] of TThemedButton =
        (tbPushButtonDisabled, tbPushButtonHot, tbPushButtonNormal, 
         tbPushButtonPressed, tbPushButtonPressed, tbPushButtonPressed);
      caItemState: array[False..True] of TItemState = (eisDisabled, eisEnabled);
      caDisabledStates = [eisDisabled, eisPushedDisabled];
      caEnabledStates = [eisHighlighted, eisEnabled, eisPushed, eisPushedHihlighted];
      
implementation

function ARGBToColor(A, R, G, B: Byte): TColor; inline;
begin
  Result := (A shl 24) or (B shl 16) or (G shl 8) or R;
end;

procedure ColorToRGBA(AColor: TColor; out R, G, B, A: Integer);
begin
  R := AColor and $000000FF;
  G := (AColor shr 8) and $000000FF;
  B := (AColor shr 16) and $000000FF;
  A := (AColor shr 24) and $000000FF;
end;

function ColorToStrLayouted(AColor: TColor; AColorLayout: TColorLayout): string;
var R, G, B, A: Integer;
begin
  ColorToRGBA(AColor, R, G, B, A);
  case AColorLayout of
    eclRGBColor: Result := inttohex(R, 2) + inttohex(G, 2) + inttohex(B, 2);
    eclBGRColor: Result := inttohex(B, 2) + inttohex(G, 2) + inttohex(R, 2);
    eclARGBColor: Result := inttohex(A, 2) + inttohex(R, 2) + inttohex(G, 2) + inttohex(B, 2);
    eclABGRColor: Result := inttohex(A, 2) + inttohex(B, 2) + inttohex(G, 2) + inttohex(R, 2);
    eclCMYColor: Result := inttohex(255 - R, 2) + inttohex(255 - G, 2)  + inttohex(255 - B, 2);
    eclYMCColor: Result := inttohex(255 - B, 2) + inttohex(255 - G, 2)  + inttohex(255 - R, 2);
    eclACMYColor: Result := inttohex(A, 2) + inttohex(255 - R, 2) + inttohex(255 - G, 2)  + inttohex(255 - B, 2);
    eclAYMCColor: Result := inttohex(A, 2) + inttohex(255 - B, 2) + inttohex(255 - G, 2)  + inttohex(255 - R, 2);
    eclSystemBGR: Result := ColorToString(AColor);
  end;   
end;     

function GetColorResolvingDefault(ASourceColor, ADefColor: TColor): TColor;
begin
  Result := ASourceColor;
  if Result = clDefault then Result := ADefColor;
end; 

function GetColorResolvingDefAndEnabled(ASourceColor, ADefColor: TColor; AEnabled: Boolean): TColor;
begin
  Result := ASourceColor;
  if Result = clDefault then Result := ADefColor;  
  if not AEnabled then Result := GetMonochromaticColor(Result);
end;

function GetMergedColor(AColor, BColor: TColor; AProportion: Single): TColor;
var aR, bR, aG, bG, aB, bB: Integer;
begin
  GetRGBIntValues(ColorToRGB(AColor), aR, aG, aB);
  GetRGBIntValues(ColorToRGB(BColor), bR, bG, bB);
  aR := bR + trunc((aR - bR)*AProportion);
  aG := bG + trunc((aG - bG)*AProportion);
  aB := bB + trunc((aB - bB)*AProportion);
  Result := RGBToColor(aR, aG, aB);
end;

function GetMonochromaticColor(AColor: TColor): TColor;
var r, g, b: Integer;
begin
  GetRGBIntValues(ColorToRGB(AColor), r, g, b);
  r := 341*(r + g + b) shr 10;
  Result := RGBToColor(r, r, r);
end;

procedure IncludeRectangle(var AResultRect: TRect; const AppendRect: TRect);
begin
  AResultRect.Left := Math.min(AResultRect.Left, AppendRect.Left);
  AResultRect.Top := Math.min(AResultRect.Top, AppendRect.Top);
  AResultRect.Right := Math.max(AResultRect.Right, AppendRect.Right);
  AResultRect.Bottom := Math.max(AResultRect.Bottom, AppendRect.Bottom);
end;

function IsInRange(AValue, ALimit, BLimit: Integer): Boolean;
begin
  Result := ((ALimit <= AValue) and (AValue <= BLimit)) or
            ((BLimit <= AValue) and (AValue <= ALimit));
end;

function IsRectIntersect(ARect, BRect: TRect): Boolean;
var aTL, aBR: TPoint;
begin
  aTL.X := Math.max(ARect.Left, BRect.Left);
  aTL.Y := Math.max(ARect.Top, BRect.Top);
  aBR.X := Math.min(ARect.Right, BRect.Right);
  aBR.Y := Math.min(ARect.Bottom, BRect.Bottom);
  Result := (aTL.X < aBR.X) and (aTL.Y < aBR.Y);
end;
           
function LinearToLogarithmic(AValue, AMin, AMax, ALogarithmBase: Double): Double;
var aProportion: Double;
begin
  aProportion := (AValue - AMin)/(AMax - AMin);
  if AMin > 0
    then AMin := logn(ALogarithmBase, AMin)
    else AMin := 0;
  if AMax > 0
    then AMax := logn(ALogarithmBase, AMax)
    else AMax := 0;
  Result := power(ALogarithmBase, AMin + (AMax - AMin)*aProportion);  
end;  

function NormalizeRectangle(PointAX, PointAY, PointBX, PointBY: Integer): TRect;
var i: Integer;
begin
  if PointAX > PointBX then
    begin
      i := PointAX;
      PointAX := PointBX;
      PointBX := i;
    end;
  if PointAY > PointBY then
    begin
      i := PointAY;
      PointAY := PointBY;
      PointBY := i;
    end;
  Result := Rect(PointAX, PointAY, PointBX, PointBY);
end;

function TrimColorString(AString: string): string;
var aChar: Char;
    i: SmallInt;
begin
  Result := '';
  for i := 1 to length(AString) do
    begin
      {$IFDEF DBGLINE} DebugLn('Character '+ AString[i]); {$ENDIF}
      aChar := aString[i];
      if (aChar in ['0'..'9']) or (aChar in ['A'..'F']) or (aChar in ['a'..'f']) 
        then Result:=Result + aChar;
    end;
  {$IFDEF DBGLINE} DebugLn('Result: '+ Result); {$ENDIF}
end;     

function TryStrToColorLayouted(AString: string; ALayout: TColorLayout; out AColor: TColor): Boolean;
var i, aLength: SmallInt;
    A, R, G, B: Byte;
begin
  if ALayout <> eclSystemBGR then
    begin      
      if ALayout in [eclARGBColor, eclABGRColor, eclACMYColor, eclAYMCColor]
        then aLength := 8
        else aLength := 6;
      AString := TrimColorString(AString);
      {$IFDEF DBGLINE} DebugLn('AColorString ' + AString); {$ENDIF}
      AString:= RightStr(AString, aLength);
      i := length(AString);
      if i < aLength then
        for i := 0 to aLength - 1 - i do
          AString := '0' + AString;
      {$IFDEF DBGLINE}  DebugLn('AColorString ' + AString); {$ENDIF}
      try
        B := Hex2Dec(RightStr(AString, 2));
        if aLength = 6 then
          begin
            G := Hex2Dec(MidStr(AString, 3, 2));
            R := Hex2Dec(LeftStr(AString, 2));
            A := 0;
          end else
          begin
            G := Hex2Dec(MidStr(AString, 5, 2));
            R := Hex2Dec(MidStr(AString, 3, 2));
            A := Hex2Dec(LeftStr(AString, 2));
          end;
        case ALayout of
          eclRGBColor, eclARGBColor: AColor := ARGBToColor(A, R, G, B);   
          eclBGRColor, eclABGRColor: AColor := ARGBToColor(A, B, G, R);
          eclCMYColor, eclACMYColor: AColor := ARGBToColor(A, 255 - R, 255 - G, 255 - B);
          eclYMCColor, eclAYMCColor: AColor := ARGBToColor(A, 255 - B, 255 - G, 255 - R);
        end;
        Result := True;
      except
        Result := False;
      end;
    end else
    begin
      try
        AString := trim(AString);
        if not IdentToColor(AString, AColor) then
          begin
            AString := TrimColorString(AString);
            if AString <> '' 
              then AColor := TColor(Hex2Dec(AString))
              else AColor := clBlack;
          end;
        Result := True;
      except
        Result := False;
      end;
    end;                    
end;

operator = (ARect, BRect: TRect): Boolean;
begin
  Result := (ARect.Left = BRect.Left) and (ARect.Right = BRect.Right)
        and (ARect.Top = BRect.Top) and (ARect.Bottom = BRect.Bottom);
end;

{ TCanvasHelper }

procedure TCanvasHelper.DrawButtonBackground(ARect: TRect; AEnabled: Boolean);
begin                                                            
  if AEnabled 
    then DrawButtonBackground(ARect, eisEnabled)
    else DrawButtonBackground(ARect, eisDisabled);
end;

procedure TCanvasHelper.DrawButtonBackground(ARect: TRect; AItemState: TItemState);
begin                
 ThemeServices.DrawElement(Handle, 
    ThemeServices.GetElementDetails(caThemedItems[AItemState]), ARect, nil);   
end;

{$I ecdrawglyph.inc}

procedure TCanvasHelper.DrawPanelBackground(ARect: TRect; ABevelInner, 
  ABevelOuter: TBevelCut; ABevelWidth: Integer; AColor: TColor);
begin             
  DrawPanelBackground(ARect, ABevelInner, ABevelOuter, 0, ABevelWidth, clDefault, clDefault, AColor);
end;

procedure TCanvasHelper.DrawPanelBackground(ARect: TRect; ABevelInner, ABevelOuter: TBevelCut;
  ABevelSpace, ABevelWidth: Integer; AColor3DDark, AColor3DLight, AColor: TColor);
var bDefault3D: Boolean;
begin
  { both Canvas.Frame3D methods deflate Rectangle }
  { bvSpace draw the frame using Canvas.Brush.Color }
  bDefault3D := ((AColor3DDark = clDefault) and (AColor3DLight = clDefault));
  if not bDefault3D then
    begin
      AColor3DDark := GetColorResolvingDefault(AColor3DDark, clBtnShadow);
      AColor3DLight := GetColorResolvingDefault(AColor3DLight, clBtnHilight);   
    end;
  Brush.Color := AColor;
  if bDefault3D then
    begin
      if ABevelOuter <> bvNone then Frame3D(ARect, ABevelWidth, ABevelOuter)
    end else
    case ABevelOuter of
      bvLowered: Frame3D(ARect, AColor3DDark, AColor3DLight, ABevelWidth);
      bvRaised: Frame3D(ARect, AColor3DLight, AColor3DDark, ABevelWidth);     
      bvSpace: Frame3D(ARect, ABevelWidth, bvSpace);
    end;
  Frame3D(ARect, ABevelSpace, bvSpace);
  if bDefault3D then
    begin
      if ABevelInner <> bvNone then Frame3D(ARect, ABevelWidth, ABevelInner);
    end else
    case ABevelInner of
      bvLowered: Frame3D(ARect, AColor3DDark, AColor3DLight, ABevelWidth);
      bvRaised: Frame3D(ARect, AColor3DLight, AColor3DDark, ABevelWidth); 
      bvSpace: Frame3D(ARect, ABevelWidth, bvSpace);
    end; 
  FillRect(ARect);
end;   

function TCanvasHelper.GlyphExtent(AGlyphDesign: TGlyphDesign): TSize;
const cLargeGlyph: SmallInt = 16;
      cSmallGlyph: SmallInt = 8;      
begin
  case AGlyphDesign of
    egdNone: Result := Size(0, 0);
    egdArrowDec  .. egdArrowsUDHor: Result := Size(cSmallGlyph, cSmallGlyph);
    egdArrowsURDL_S: Result := Size(10, 10); 
    egdArrowsURDL_M: Result := Size(10, 10);
    egdArrowURDL_L: Result := Size(11, 11);
    egdArrowURDL_XL: Result := Size(12, 12);  
    egdArrowsUL_DR .. egdArrC_Max: Result := Size(cSmallGlyph, cSmallGlyph);  
    egdArrC_URDL: Result := Size(cLargeGlyph, cLargeGlyph);  
    egdPlayPause .. egdFramedList: Result := Size(cSmallGlyph, cSmallGlyph);  
    egdGrid .. egdWindowRound: Result := Size(cLargeGlyph, cLargeGlyph);  
  end;
end;

procedure TCanvasHelper.SetFontParams(AOrientation: Integer; ASize: Integer; AStyle: TFontStyles);
begin
  with Font do
    begin
      Orientation:=AOrientation;
      Size:=ASize;
      Style:=AStyle;
    end;
end;

procedure TCanvasHelper.SetRealGlyphColor(AGlyphColor: TColor; AState: TItemState);
begin
  AGlyphColor := GetColorResolvingDefault(AGlyphColor, clBtnText);
  if AState in [eisHighlighted, eisPushedHihlighted] 
    then AGlyphColor := GetMergedColor(clWhite, AGlyphColor, 0.27)
    else if AState in [eisDisabled, eisPushedDisabled] then
           AGlyphColor := GetMergedColor(Pixels[Width div 2, Height div 2], AGlyphColor, 0.67);     
  Brush.Color := AGlyphColor;
  Pen.Color := AGlyphColor;
end;      

{ TBitmapHelper }

procedure TBitmapHelper.SetProperties(AWidth, AHeight: Integer);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Pen.Style := psSolid;
  Transparent := True;
  TransparentMode := tmFixed;
  SetSize(AWidth, AHeight);
end;

procedure TBitmapHelper.TransparentClear;
var aTransparentColor: TColor;
begin
  aTransparentColor := TransparentColor;
  TransparentColor := clSilver;      
  Canvas.Brush.Color := aTransparentColor;
  Canvas.FillRect(0, 0, Width, Height);
  TransparentColor := aTransparentColor;
end;

{ TFontOptions }

constructor TFontOptions.Create(AParent: TControl);
begin
  Parent := AParent;
  FFontColor := clDefault;
  if assigned(AParent) then
    with AParent do
      begin
        FFontStyles := Font.Style;
        FFontSize := Font.Size;
      end
end;

procedure TFontOptions.RecalcRedraw;
begin
  if assigned(OnRecalcRedraw) then OnRecalcRedraw;
end;

procedure TFontOptions.Redraw;
begin
  if assigned(OnRedraw) then OnRedraw;
end;

procedure TFontOptions.SetFontColor(const AValue: TColor);
begin
  if FFontColor = AValue then exit;
  FFontColor := AValue;
  Redraw;
end;

procedure TFontOptions.SetFontSize(const AValue: SmallInt);
begin
  if FFontSize = AValue then exit;
  FFontSize := AValue;
  RecalcRedraw;
end;

procedure TFontOptions.SetFontStyles(const AValue: TFontStyles);
begin
  if FFontStyles = AValue then exit;
  FFontStyles := AValue;
  RecalcRedraw;
end;

{ TECBaseControl }

constructor TECBaseControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csParentBackground, csReplicatable] - [csOpaque];
  FBevelInner := bvNone;
  FBevelOuter := bvRaised;
  FBevelWidth := 1;           
  Color := clDefault;   
  FColor3DDark:=clDefault;
  FColor3DLight:=clDefault;
end;   

procedure TECBaseControl.BeginUpdate;
begin
  inc(UpdateCount);
end; 

procedure TECBaseControl.EndUpdate(Recalculate: Boolean = True);
begin
  dec(UpdateCount);
  if UpdateCount <= 0 then
    begin
      UpdateCount := 0;
      if Recalculate
        then RecalcRedraw
        else Redraw;
    end;
end;   

function TECBaseControl.GetBorderWidth: Integer;
var i: Integer;
begin
  i := 0;
  if BevelOuter <> bvNone then inc(i);
  if BevelInner <> bvNone then inc(i);
  Result := BevelSpace + i*BevelWidth;
end;   

function TECBaseControl.HasCaption: Boolean;
begin
  Result := (Caption <> ''); 
end;       

procedure TECBaseControl.InvalidateNonUpdated;
begin
  if UpdateCount = 0 then Invalidate;
end;    
   
procedure TECBaseControl.OrientationChanged(AValue: TObjectOrientation);
begin
  RecalcRedraw;
end;   

procedure TECBaseControl.SetAutoSize(Value: Boolean);
begin
  inherited SetAutoSize(Value);
  if Value then
    begin
      InvalidatePreferredSize;
      AdjustSize;
    end; 
end;   

procedure TECBaseControl.StyleChanged(AValue: TObjectStyle);
begin
  Redraw;
end;     

procedure TECBaseControl.WMPaint(var Message: TLMPaint);
begin
  if (RedrawMode < ermFreeRedraw) and 
    ((Message.PaintStruct^.rcPaint.Left < FInvalidRect.Left) 
    or (Message.PaintStruct^.rcPaint.Top < FInvalidRect.Top)
    or (Message.PaintStruct^.rcPaint.Right > FInvalidRect.Right) 
    or (Message.PaintStruct^.rcPaint.Bottom > FInvalidRect.Bottom))
    then RedrawMode := ermFreeRedraw;  
  inherited WMPaint(Message);
end;     

{ TECBaseControl.Setters }

procedure TECBaseControl.SetBevelInner(const AValue: TBevelCut);
begin
  if FBevelInner = AValue then exit;
  FBevelInner := AValue;
  RecalcRedraw;
end;

procedure TECBaseControl.SetBevelOuter(const AValue: TBevelCut);
begin
  if FBevelOuter = AValue then exit;
  FBevelOuter := AValue;
  RecalcRedraw;
end;

procedure TECBaseControl.SetBevelSpace(const AValue: SmallInt);
begin
  if FBevelSpace = AValue then exit;
  FBevelSpace := AValue;
  RecalcRedraw;
end;

procedure TECBaseControl.SetBevelWidth(const AValue: SmallInt);
begin
  if FBevelWidth = AValue then exit;
  FBevelWidth := AValue;
  RecalcRedraw;
end;             

procedure TECBaseControl.SetColor3DDark(const AValue: TColor);
begin
  if FColor3DDark = AValue then exit;
  FColor3DDark := AValue;
  Redraw3DColorAreas;
end;

procedure TECBaseControl.SetColor3DLight(const AValue: TColor);
begin
  if FColor3DLight = AValue then exit;
  FColor3DLight := AValue;
  Redraw3DColorAreas; 
end;

procedure TECBaseControl.SetOrientation(const AValue: TObjectOrientation);
begin
  if FOrientation = AValue then exit;
  FOrientation := AValue;
  OrientationChanged(AValue);
end;       

procedure TECBaseControl.SetStyle(AValue: TObjectStyle);
begin
  if FStyle = AValue then exit;
  FStyle := AValue;
  StyleChanged(AValue);
end;       

{ TECCustomKnob }

constructor TECCustomKnob.Create(AParent: TECBaseControl);
begin
  inherited Create;
  Parent := AParent;  { don't change order ! }
  FBevelWidth := cDefBevelWidth;
  FColor := clDefault;
  FCursor := crHandPoint;
  FHeight := cDefKnobHeight;
  FTickMarkCount := cDefTickMarkCount;
  FTickMarkDesign := cDefTickDesign;
  FTickMarkSpacing := cDefTickMarkSpacing;
  FWidth := cDefKnobWidth;
  KnobDisabled := TBitmap.Create;
  KnobDisabled.SetProperties(self.FWidth, self.FHeight);
  KnobNormal := TBitmap.Create;
  KnobNormal.SetProperties(self.FWidth, self.FHeight);
  KnobHighlighted := TBitmap.Create;
  KnobHighlighted.SetProperties(self.FWidth, self.FHeight);
end;

destructor TECCustomKnob.Destroy;
begin
  FreeAndNil(KnobDisabled);
  FreeAndNil(KnobNormal);
  FreeAndNil(KnobHighlighted);
  inherited Destroy;
end;

procedure TECCustomKnob.BeginUpdate;
begin
  inc(UpdateCount);
end;     

procedure TECCustomKnob.DrawKnobs;
var aColor: TColor;
    aHeight, aWidth, h, i, j, k: Integer;
    aLight, aVert: Boolean;
    aRect: TRect;

  procedure DrawPanelBevel(AKnob: TBitmap);
  var aColor3DDark, aColor3DLight: TColor;
  begin
    with AKnob.Canvas do
      begin
        aColor3DDark := Parent.FColor3DDark;
        aColor3DLight := Parent.FColor3DLight;
        if (aColor3DDark = clDefault) and (aColor3DLight = clDefault) then
          begin
            Frame3D(aRect, BevelWidth, bvRaised);
          end else
          begin
            aColor3DDark := GetColorResolvingDefault(aColor3DDark, clBtnShadow);
            aColor3DLight := GetColorResolvingDefault(aColor3DLight, clBtnHilight);
            Frame3D(aRect, aColor3DLight, aColor3DDark, BevelWidth);
          end;
      end;
  end;

  function ModifyBrightness(AColor: TColor; ABrighness: Single): TColor;
  var r, g, b: Integer;
  begin
    GetRGBIntValues(AColor, r, g, b);
    b := round(b*ABrighness);
    if b > 255 then b := 255;
    g := round(g*ABrighness);
    if g > 255 then g := 255;
    r:=round(r*ABrighness);
    if r > 255 then r := 255;
    Result:=RGBToColor(r, g, b);
  end;

  procedure DrawTick(AKnob: TBitmap; AEnabled: Boolean = True);
  var { aLight scheme, aEnabled, Normal Line=0, or Lowered=1, Raised=2 }
      aBrightness: array [False..True, False..True, 0..2] of Single =
        (((2, 0.8, 1.2), (3, 0.67, 1.4)), ((0.67, 0.8, 1.2), (0.4, 0.67, 1.4)));
         { Dark Disabled, Dark Enabled,     Light Disabled,   Light Enabled }

    procedure DrawLine(x1, y1, x2: Integer; ABrightness: Single);
    var l: Integer;
    begin
      with AKnob.Canvas do
        begin
          if TickMarkStyle = etsSolid then
            begin  { etsSolid }
              if aVert then  { Horizontal tick (vertical slider) }
                for l := x1 to x2 - 1 do
                  Pixels[l, y1] := ModifyBrightness(Pixels[l, y1], ABrightness)
                else         { Vertical tick (horizontal slider) }
                for l := x1 to x2 - 1 do
                  Pixels[y1, l] := ModifyBrightness(Pixels[y1, l], ABrightness);
            end else
            begin  { etsDotted }
              if aVert then  { Horizontal tick (vertical slider) }
                for l := x1 to x2 - 1 do
                  begin
                    if ((l - x1) mod 3) = 0 then Pixels[l, y1] := ModifyBrightness(Pixels[l, y1], ABrightness);
                  end
                else         { Vertical tick (horizontal slider) }
                for l := x1 to x2 - 1 do
                  if ((l - x1) mod 3) = 0 then Pixels[y1, l] := ModifyBrightness(Pixels[y1, l], ABrightness);
            end;
        end;
    end;

  begin
    with AKnob.Canvas do
      begin
        case FTickMarkDesign of
          etdSimple: DrawLine(i, h, j, aBrightness[aLight, AEnabled, 0]);
          etdThick:
            begin
              if TickMarkStyle = etsSolid then
                begin 
                  DrawLine(i, h-1, j, aBrightness[aLight, AEnabled, 0]);
                  DrawLine(i, h, j, aBrightness[aLight, AEnabled, 0]);
                end else
                begin
                  DrawLine(i, h, j, aBrightness[aLight, AEnabled, 1]);
                  DrawLine(i + 1, h, j + 1, aBrightness[aLight, AEnabled, 1]);
                  DrawLine(i, h + 1, j, aBrightness[aLight, AEnabled, 1]);
                end;
            end;
          etd3DLowered:
            begin
              if TickMarkStyle = etsSolid then
                begin
                  DrawLine(i, h, j, aBrightness[aLight, AEnabled, 1]);
                  DrawLine(i, h + 1, j, aBrightness[aLight, AEnabled, 2]);
                end else
                begin
                  DrawLine(i, h, j, aBrightness[aLight, AEnabled, 1]);
                  DrawLine(i + 1, h + 1, j + 1, aBrightness[aLight, AEnabled, 2]);  
                end;
            end;
          etd3DRaised:
            begin
              if TickMarkStyle = etsSolid then
                begin 
                  DrawLine(i, h, j, aBrightness[aLight, AEnabled, 1]);
                  DrawLine(i, h - 1, j, aBrightness[aLight, AEnabled, 2]);
                end else
                begin
                   DrawLine(i, h, j, aBrightness[aLight, AEnabled, 1]);
                   DrawLine(i - 1, h - 1, j - 1, aBrightness[aLight, AEnabled, 2]); 
                end;
            end;
        end;
      end;
  end;

begin
  {$IFDEF DBGLINE} DebugLn('DrawKnobs'); {$ENDIF}
  if (UpdateCount = 0) and assigned(Parent) and assigned(Parent.Parent) then
    begin
      KnobHighlighted.BeginUpdate(True);
      KnobNormal.BeginUpdate(True);
      aRect := Rect(0, 0, Width, Height);
      case FStyle of
        eosButton:
          begin
            KnobDisabled.TransparentClear;
            KnobDisabled.Canvas.DrawButtonBackground(aRect, eisDisabled);
            KnobNormal.TransparentClear;      
            KnobNormal.Canvas.DrawButtonBackground(aRect, eisEnabled);
            KnobHighlighted.TransparentClear;
            KnobHighlighted.Canvas.DrawButtonBackground(aRect, eisHighlighted);
          end;    
        eosPanel:
          begin
            DrawPanelBevel(KnobDisabled);
            aRect := Rect(0, 0, Width, Height);
            DrawPanelBevel(KnobNormal);
            aRect := Rect(0, 0, Width, Height);
            DrawPanelBevel(KnobHighlighted);               
            i := BevelWidth;
            aRect := Rect(i, i, Width - i, Height - i);
            KnobNormal.Canvas.Brush.Color := GetColorResolvingDefault(Color, BackgroundColor);
            KnobNormal.Canvas.FillRect(aRect);
            KnobDisabled.Canvas.Brush.Color := ModifyBrightness(ColorToRGB(KnobNormal.Canvas.Brush.Color), 0.97);
            KnobDisabled.Canvas.FillRect(aRect);
            KnobHighlighted.Canvas.Brush.Color := ModifyBrightness(ColorToRGB(KnobNormal.Canvas.Brush.Color), 1.07);
            KnobHighlighted.Canvas.FillRect(aRect);
          end;
      end;
      aVert := (Parent.FOrientation = eooVertical);
      if aVert then  { Parent is Vertical }
        begin
          aHeight := FHeight;
          aWidth := FWidth;
        end else
        begin
          aWidth := FHeight;
          aHeight := FWidth;
        end;
      if (TickMarkCount > 0) and (aWidth >= 10) then
        begin
          aColor := ColorToRGB(clBtnText);   { detect Light or Dark scheme }
          aLight := ((aColor and $FF) + ((aColor shr 8) and $FF) + ((aColor shr 16) and $FF)) < 384;    
          i := BevelWidth + TickMarkSpacing;
          j := aWidth - i;
          if TickMarkStyle = etsDotted then
            begin
              k := (aWidth - 2*i) mod 3;
              if k < 2 then i := i + 1;
              if k = 0 then j := j + 1;
            end;
          if (TickMarkCount mod 2) = 0 then
            for k := 1 to (TickMarkCount div 2) do
              begin
                h := (aHeight div 2) - 2 + 3*k;
                DrawTick(KnobDisabled, False);
                DrawTick(KnobNormal);
                DrawTick(KnobHighlighted);
                h := (aHeight div 2) + 1 - 3*k;
                DrawTick(KnobDisabled, False);
                DrawTick(KnobNormal);
                DrawTick(KnobHighlighted);
              end
            else
            begin
              h := aHeight div 2;
              DrawTick(KnobDisabled, False);
              DrawTick(KnobNormal);
              DrawTick(KnobHighlighted);
              for k := 1 to (FTickMarkCount div 2) do
                begin
                  h := (aHeight div 2) + 3*k;
                  DrawTick(KnobDisabled, False);
                  DrawTick(KnobNormal);
                  DrawTick(KnobHighlighted);
                  h := (aHeight div 2) - 3*k;
                  DrawTick(KnobDisabled, False);
                  DrawTick(KnobNormal);
                  DrawTick(KnobHighlighted);
                end;
            end;
        end;
      KnobDisabled.Mask(KnobDisabled.TransparentColor);
      KnobHighlighted.Mask(KnobHighlighted.TransparentColor);
      KnobNormal.Mask(KnobNormal.TransparentColor);  
      KnobHighlighted.EndUpdate(False);
      KnobNormal.EndUpdate(False);
    end;
end;

procedure TECCustomKnob.EndUpdate;
begin
  dec(UpdateCount);
  if UpdateCount = 0 then DrawKnobs;
end;

procedure TECCustomKnob.RecalcRedraw;
begin
  if assigned(Parent) then Parent.RecalcRedraw;
end;

procedure TECCustomKnob.SetSize(AWidth, AHeight: Integer);
begin
  if Height <> AHeight then 
    begin
      FWidth := AWidth;
      Height := AHeight;
    end else
    Width := AWidth;  
  if AWidth = AHeight then DrawKnobs;
end;

{ TECCustomKnob.Setters }

procedure TECCustomKnob.SetBackgroundColor(AValue: TColor);
var aTransColor: TColor;
begin
  if FBackgroundColor = AValue then exit;
  FBackgroundColor := AValue;
  aTransColor := ColorToRGB(AValue) and $FAFCFE + $020301;
  KnobDisabled.TransparentColor := aTransColor;
  KnobHighlighted.TransparentColor := aTransColor;
  KnobNormal.TransparentColor := aTransColor;
  DrawKnobs;
end;             
        
procedure TECCustomKnob.SetBevelWidth(const AValue: SmallInt);
begin
  if FBevelWidth = AValue then exit;
  FBevelWidth := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetColor(const AValue: TColor);
begin
  if FColor = AValue then exit;
  FColor := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetCursor(const AValue: TCursor);
begin
  if FCursor = AValue then exit;
  FCursor := AValue;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetHeight(const AValue: Integer);
var aWidth: Integer;
begin
  if (AValue < 1) or (FHeight = AValue) then exit;
  FHeight := AValue;
  aWidth := FWidth;
  KnobDisabled.SetSize(aWidth, AValue);
  KnobNormal.SetSize(aWidth, AValue);
  KnobHighlighted.SetSize(aWidth, AValue);
  DrawKnobs;
  RecalcRedraw;
end;

procedure TECCustomKnob.SetStyle(const AValue: TObjectStyle);
begin
  if FStyle = AValue then exit;
  FStyle := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;  

procedure TECCustomKnob.SetTickMarkCount(const AValue: SmallInt);
begin
  if FTickMarkCount = AValue then exit;
  FTickMarkCount := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetTickMarkDesign(const AValue: TTickDesign);
begin
  if FTickMarkDesign = AValue then exit;
  FTickMarkDesign := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetTickMarkSpacing(const AValue: SmallInt);
begin
  if FTickMarkSpacing = AValue then exit;
  FTickMarkSpacing := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetTickMarkStyle(const AValue: TTickStyle);
begin
  if FTickMarkStyle = AValue then exit;
  FTickMarkStyle := AValue;
  DrawKnobs;
  if assigned(Parent) then Parent.InvalidateCustomRect(False);
end;

procedure TECCustomKnob.SetWidth(const AValue: Integer);
var aHeight: Integer;
begin
  if (AValue < 1) or (FWidth = AValue) then exit;
  FWidth := AValue;
  aHeight := FHeight;
  KnobDisabled.SetSize(AValue, aHeight);
  KnobNormal.SetSize(AValue, aHeight);
  KnobHighlighted.SetSize(AValue, aHeight);  
  DrawKnobs;
  RecalcRedraw;
end; 

{ TBaseScrollControl }

constructor TBaseScrollControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAreaHeight:=-1;
  FAreaWidth:=-1;
  { scrollbars }
  SetDefaultScrollParams;
end;   

procedure TBaseScrollControl.BeginUpdate;
begin
  inc(UpdateCount);
end; 

procedure TBaseScrollControl.CreateWnd;
begin
  inherited CreateWnd;
  FClientAreaLeft:=ClientRect.Left;
  FClientAreaTop:=ClientRect.Top;
  FScrollInfoHor.fMask:=SIF_RANGE or SIF_PAGE or SIF_POS or SIF_DISABLENOSCROLL;  
  FScrollInfoHor.nMax:=0;
  FScrollInfoHor.nMin:=0;
  FScrollInfoHor.nPos:=0;
  FScrollInfoVert:=FScrollInfoHor;  
  FScrollInfoHor.nPage:=ClientWidth;
  FScrollInfoVert.nPage:=ClientHeight;
end;   

procedure TBaseScrollControl.EndUpdate;
begin
  dec(UpdateCount);
  if UpdateCount=0 then Invalidate;
end;
        
procedure TBaseScrollControl.InvalidateNonUpdated;
begin
  if UpdateCount=0 then Invalidate;
end;

procedure TBaseScrollControl.SetDefaultScrollParams;
begin
  FIncrementX:=1;
  FIncrementY:=1;
  FScrollBars:=ssAutoBoth;
end;     
           
procedure TBaseScrollControl.UpdateScrollBars(AValue: TScrollStyle);
begin
  case AValue of
  ssNone: 
    begin
      ShowScrollBar(Handle, SB_HORZ, False);
      ShowScrollBar(Handle, SB_VERT, False);
    end; 
  ssHorizontal: 
    begin
      ShowScrollBar(Handle, SB_HORZ, True);
      ShowScrollBar(Handle, SB_VERT, False);
    end;    
  ssVertical: 
    begin
      ShowScrollBar(Handle, SB_HORZ, False);
      ShowScrollBar(Handle, SB_VERT, True);
    end;  
  ssBoth: 
    begin
      ShowScrollBar(Handle, SB_HORZ, True);
      ShowScrollBar(Handle, SB_VERT, True);
    end;
  ssAutoHorizontal: 
    begin
      ShowScrollBar(Handle, SB_HORZ, FRequiredArea.X>ClientWidth);
      ShowScrollBar(Handle, SB_VERT, False);
    end;     
  ssAutoVertical: 
    begin
      ShowScrollBar(Handle, SB_HORZ, False);
      ShowScrollBar(Handle, SB_VERT, FRequiredArea.Y>ClientHeight);
    end;   
  ssAutoBoth: 
    begin
      ShowScrollBar(Handle, SB_HORZ, FRequiredArea.X>ClientWidth);
      ShowScrollBar(Handle, SB_VERT, FRequiredArea.Y>ClientHeight);
    end;
  end;
  UpdateScrollInfoHor;
  UpdateScrollInfoVert;
end;  

procedure TBaseScrollControl.UpdateScrollInfoHor;
begin
  FScrollInfoHor.nPos:=ClientAreaLeft;
  FScrollInfoHor.nMax:=FullAreaWidth;
  SetScrollInfo(Handle, SB_Horz, FScrollInfoHor, False);
end;

procedure TBaseScrollControl.UpdateScrollInfoVert;
begin
  FScrollInfoVert.nPos:=ClientAreaTop;
  FScrollInfoVert.nMax:=FullAreaHeight;
  SetScrollInfo(Handle, SB_Vert, FScrollInfoVert, False);
end;             

procedure TBaseScrollControl.WMHScroll(var Msg: TWMScroll);
begin
  { modify ClientArea and its setter will adjust scrollbar }
  {$IFDEF DEBUG} DebugLn('TBaseECScheme.WMHScroll'); {$ENDIF}
  case Msg.ScrollCode of
    SB_LINELEFT: ClientAreaLeft:=ClientAreaLeft-IncrementX;
    SB_LINERIGHT: ClientAreaLeft:=ClientAreaLeft+IncrementX;  
    SB_PAGELEFT: ClientAreaLeft:=ClientAreaLeft-ClientWidth;  
    SB_PAGERIGHT: ClientAreaLeft:=ClientAreaLeft+ClientWidth;
    SB_THUMBPOSITION, SB_THUMBTRACK: ClientAreaLeft:=Msg.Pos;
    SB_LEFT: ClientAreaLeft:=0;
    SB_RIGHT: ClientAreaLeft:=FullAreaWidth;
  end;
end;

procedure TBaseScrollControl.WMSize(var Message: TLMSize);
var aCW, aCH: Integer;
begin
  {$IFDEF DEBUG} DebugLn('WMSize W: ', inttostr(Width), ', H: ', inttostr(Height)); {$ENDIF}
  inherited WMSize(Message); 
  aCW:=ClientWidth;
  aCH:=ClientHeight;
  FScrollInfoHor.nPage:=aCW;
  FScrollInfoVert.nPage:=aCH;
  if (AreaWidth>-1) and (AreaWidth<aCW) then AreaWidth:=aCW;
  if (AreaHeight>-1) and (AreaHeight<aCH) then AreaHeight:=aCH;
  ClientAreaLeft:=Math.min(ClientAreaLeft, FRequiredArea.X-aCW);
  ClientAreaTop:=Math.min(ClientAreaTop, FRequiredArea.Y-aCH);
  UpdateScrollBars(ScrollBars);      
  Invalidate;
end;

procedure TBaseScrollControl.WMVScroll(var Msg: TWMScroll); 
begin
  {$IFDEF DEBUG} DebugLn('TBaseECScheme.WMVScroll'); {$ENDIF}
  case Msg.ScrollCode of
    SB_LINEUP: ClientAreaTop:=ClientAreaTop-IncrementY;
    SB_LINEDOWN: ClientAreaTop:=ClientAreaTop+IncrementY;
    SB_PAGEUP: ClientAreaTop:=ClientAreaTop-ClientHeight;
    SB_PAGEDOWN: ClientAreaTop:=ClientAreaTop+ClientHeight;
    SB_THUMBPOSITION, SB_THUMBTRACK: ClientAreaTop:=Msg.Pos;
    SB_TOP: ClientAreaTop:=0;
    SB_BOTTOM: ClientAreaTop:=FullAreaHeight;
  end;    
end;   

{ TBaseScrollControl.Setters }

function TBaseScrollControl.GetFullAreaHeight: Integer;
begin
  Result:=Math.max(ClientHeight, FRequiredArea.Y);
end;

function TBaseScrollControl.GetFullAreaWidth: Integer;
begin
  Result:=Math.max(ClientWidth, FRequiredArea.X);
end; 
         
procedure TBaseScrollControl.SetAreaHeight(AValue: Integer);
begin
  if AValue>=0 then AValue:=Math.max(AValue, ClientHeight);
  if (FAreaHeight=AValue) or ((AValue<0) and (FAreaHeight<0)) then exit;
  FAreaHeight:=AValue;
  UpdateRequiredAreaHeight;
  UpdateScrollBars(ScrollBars);
  Invalidate;
end;

procedure TBaseScrollControl.SetAreaWidth(AValue: Integer);
begin
  if AValue>=0 then AValue:=Math.max(AValue, ClientWidth);
  if (FAreaWidth=AValue) or ((AValue<0) and (FAreaWidth<0)) then exit;
  FAreaWidth:=AValue;
  UpdateRequiredAreaWidth;
  UpdateScrollBars(ScrollBars);
  Invalidate;
end; 

procedure TBaseScrollControl.SetClientAreaLeft(AValue: Integer);
begin
  if AValue<0 
    then AValue:=0
    else if AValue>(FullAreaWidth-ClientWidth) then AValue:=FullAreaWidth-ClientWidth;     
  if FClientAreaLeft=AValue then exit;
  FClientAreaLeft:=AValue;
  UpdateScrollBars(ScrollBars);
  InvalidateNonUpdated;  
end;
 
procedure TBaseScrollControl.SetClientAreaTop(AValue: Integer);
begin
  if AValue<0 
    then AValue:=0
    else if AValue>(FullAreaHeight-ClientHeight) then AValue:=FullAreaHeight-ClientHeight;
  if FClientAreaTop=AValue then exit;
  FClientAreaTop:=AValue;
  UpdateScrollBars(ScrollBars);
  InvalidateNonUpdated;  
end;
 

procedure TBaseScrollControl.SetScrollBars(AValue: TScrollStyle);
begin
  if FScrollBars=AValue then exit;
  FScrollBars:=AValue;
  UpdateScrollBars(AValue);
end;     

end.