{==============================================================================

  Custom Controls
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsControls;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
  KsUtils, KsBitmap;

const

  WM_FORMISBLEND                = WM_USER + 567;
  WM_UPDATETRANSCONTROL         = WM_USER + 568;

type

  TKsBarOrientation = (kboHorizontal, kboVertical);

  TKsScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition, scTrack, scTop, scBottom, scEndScroll);
  TKsScrollEvent = procedure (Sender: TObject; ScrollCode: TKsScrollCode; var ScrollPos: Integer) of object;

{ TKsCustomControl class }

{ TKsCustomControl is the base class for all KS Development contols that are support double buffering and blending. }
  TKsCustomControl = class(TWinControl)
  private
    FBuffer: TKsBitmap;
    FBack: TKsBitmap;
    FDimmension: integer;
    FFocused: boolean;
    FNeedUpdate: boolean;
    FTransparent: boolean;
    FBlend: boolean;
    FBlendValue: integer;
    FMouseInControl: Boolean;
    FHScrollBar, FVScrollBar: TControl;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FScrollBars: TScrollStyle;
    FDisableScrollBarUpdate: boolean;
    FFont: TFont;
    procedure SetTransparent(const Value: boolean);
    procedure SetBlend(const Value: boolean);
    procedure SetBlendValue(const Value: integer);
    procedure SetScrollBars(const Value: TScrollStyle);
    procedure SetFont(const Value: TFont);
    procedure PaintControls(DC: HDC);
  protected
    FWidth, FHeight: integer;
    { Windows }
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMWindowPosChanging(var Msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    { VCL }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    { For next }
    procedure PaintBuffer; virtual;
    { ScrollBars }
    procedure InitScrollBars;
    function CreateScrollBar: TControl; virtual;
    function GetScrollBarHeight: integer; virtual;
    procedure DoHScroll(Sender: TObject; ScrollCode: TKsScrollCode; var ScrollPos: Integer);
    procedure DoVScroll(Sender: TObject; ScrollCode: TKsScrollCode; var ScrollPos: Integer);
    { Event }
    procedure MouseEnter; dynamic;
    procedure MouseLeave; dynamic;
    procedure HasFocus; dynamic;
    procedure KillFocus; dynamic;
    { Protected }
    function IsOwnerBlend: boolean;
    procedure PaintOwnerBackground(Buffer: TKsBitmap);
    procedure ResizeBuffer;
    procedure UpdateBuffer;

    property Buffer: TKsBitmap read FBuffer;
    property NeedUpdate: boolean read FNeedUpdate write FNeedUpdate;
    property ControlFont: TFont read FFont write SetFont; 
    { Protected Propperty }
    property Focused: boolean read FFocused;
    property MouseInControl: boolean read FMouseInControl;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
    property HScrollBar: TControl read FHScrollBar; 
    property VScrollBar: TControl read FVScrollBar; 
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure Invalidate; override;
    procedure Repaint; override;
    procedure Resize; override;
    procedure ImmediatelyUpdate;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    function GetScrollPos(ScrollBar: integer): integer;
    procedure GetScrollRange(ScrollBar: integer; var Min, Max: integer);
    procedure SetScrollPos(ScrollBar, Pos: integer; Redraw: boolean);
    procedure SetScrollRange(ScrollBar, Min, Max: integer; Redraw: boolean);
  published
    property Constraints;
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property DragMode;
    { Check of the enable alpha-blending features. }
    property Blend: boolean read FBlend write SetBlend;
    { Value of the alpha channel, must between 0..255 }
    property BlendValue: integer read FBlendValue write SetBlendValue;
    property ParentBiDiMode;
    property ShowHint;
    { Specifies whether controls that sit below the control on a form can be seen through the control. }
    property Transparent: boolean read FTransparent write SetTransparent;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnKeyDown;
    property OnKeyUp;
    property OnKeyPress;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

{ TKsCustomControl class }

{ TKsGraphicControl is the base class for all KS Development contols that are support double buffering and blending. }
  TKsGraphicControl = class(TGraphicControl)
  private
    FBuffer: TKsBitmap;
    FBack: TKsBitmap;
    FDimmension: integer;
    FFocused: boolean;
    FNeedUpdate: boolean;
    FTransparent: boolean;
    FBlend: boolean;
    FBlendValue: integer;
    FMouseInControl: Boolean;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FFont: TFont;
    FDisableBackground: boolean;
    procedure SetTransparent(const Value: boolean);
    procedure SetBlend(const Value: boolean);
    procedure SetBlendValue(const Value: integer);
    procedure SetFont(const Value: TFont);
  protected
    FWidth, FHeight: integer;
    { Windows }
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    { For next }
    procedure PaintBuffer; virtual;
    { Event }
    procedure MouseEnter; dynamic;
    procedure MouseLeave; dynamic;
    { Protected }
    function IsOwnerBlend: boolean;
    procedure ResizeBuffer;
    procedure UpdateBuffer;
    property NeedUpdate: boolean read FNeedUpdate write FNeedUpdate;
    { Protected Propperty }
    property ControlFont: TFont read FFont write SetFont;
    property MouseInControl: boolean read FMouseInControl;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Paint; override;
    procedure Invalidate; override;
    procedure Loaded; override;
    procedure Resize; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    property Buffer: TKsBitmap read FBuffer;
  published
    property BiDiMode;
    { Check of the enable alpha-blending features. }
    property Blend: boolean read FBlend write SetBlend;
    { Value of the alpha channel, must between 0..255 }
    property BlendValue: integer read FBlendValue write SetBlendValue;
    property ParentBiDiMode;
    property ShowHint;
    { Specifies whether controls that sit below the control on a form can be seen through the control. }
    property Transparent: boolean read FTransparent write SetTransparent;
    property Visible;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

implementation {===============================================================}

uses KsScrollBars;

type
  TControlAccess = class(TControl)
  end;
  TParentControl = class(TWinControl);

{ TKsCustomControl }

constructor TKsCustomControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DoubleBuffered := false;

  FFont := TFont.Create;

  FScrollBars := ssNone;
  FBuffer := TKsBitmap.Create;
  FBack := TKsBitmap.Create;

  ControlStyle := ControlStyle + [csOpaque];

  FBlend := false;
  FBlendValue := 150;
  Color := clBtnFace;

  FDimmension := 30;
  SetBounds(0, 0, 100, 30);
end;

destructor TKsCustomControl.Destroy;
begin
  FFont.Free;
  FBack.Free;
  FBuffer.Free;
  inherited Destroy;
end;

procedure TKsCustomControl.Loaded;
begin
  inherited;
  ResizeBuffer;
end;

procedure TKsCustomControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WS_VSCROLL and not WS_HSCROLL;
end;

procedure TKsCustomControl.CreateWnd;
begin
  inherited CreateWnd;
  { Create ScrollBars }
  InitScrollBars;
end;

{ ScrollBars }

procedure TKsCustomControl.InitScrollBars;
begin
  if FHScrollBar <> nil then
  begin
    FHScrollBar.Free;
    FHScrollBar := nil;
  end;

  if FScrollBars in [ssHorizontal, ssBoth] then
  begin
    FHScrollBar := CreateScrollBar;

    with TKsCustomScrollBar(FHScrollBar) do
    begin
      BorderWidth := 0;
      Parent := Self;
      Kind := sbHorizontal;
      Height := GetScrollBarHeight;
      Visible := true;
      Transparent := false;
      OnScroll := DoHScroll;
    end;
  end;

  if FVScrollBar <> nil then
  begin
    FVScrollBar.Free;
    FVScrollBar := nil;
  end;

  if FScrollBars in [ssVertical, ssBoth] then
  begin
    FVScrollBar := CreateScrollBar;

    with TKsCustomScrollBar(FVScrollBar) do
    begin
      BorderWidth := 0;
      Parent := Self;
      Kind := sbVertical;
      Width := GetScrollBarHeight;
      Visible := true;
      Transparent := false;
      OnScroll := DoVScroll;
    end;
  end;
end;

function TKsCustomControl.CreateScrollBar: TControl;
begin
  Result := TKsCustomScrollBar.Create(Self);
end;

function TKsCustomControl.GetScrollBarHeight: integer;
begin
  Result := GetSystemMetrics(SM_CYVTHUMB);
end;

function TKsCustomControl.GetScrollPos(ScrollBar: integer): integer;
begin
  Result := 0;

  if (ScrollBar = SB_HORZ) and (FHScrollBar <> nil) then
  begin
    Result := TKsCustomScrollBar(FHScrollBar).Position;
  end;
  if (ScrollBar = SB_VERT) and (FVScrollBar <> nil) then
  begin
    Result := TKsCustomScrollBar(FVScrollBar).Position;
  end;
end;

procedure TKsCustomControl.GetScrollRange(ScrollBar: integer; var Min,
  Max: integer);
begin
  Min := 0;
  Max := 0;
  
  if (ScrollBar = SB_HORZ) and (FHScrollBar <> nil) then
  begin
    Min := TKsCustomScrollBar(FHScrollBar).Min;
    Max := TKsCustomScrollBar(FHScrollBar).Max;
  end;
  if (ScrollBar = SB_VERT) and (FVScrollBar <> nil) then
  begin
    Min := TKsCustomScrollBar(FVScrollBar).Min;
    Max := TKsCustomScrollBar(FVScrollBar).Max;
  end;
end;

procedure TKsCustomControl.SetScrollPos(ScrollBar, Pos: integer;
  Redraw: boolean);
begin
  if (ScrollBar = SB_HORZ) and (FHScrollBar <> nil) then
  begin
    TKsCustomScrollBar(FHScrollBar).Position := Pos;
  end;
  if (ScrollBar = SB_VERT) and (FVScrollBar <> nil) then
  begin
    TKsCustomScrollBar(FVScrollBar).Position := Pos;
  end;

  if Redraw then Invalidate;
end;

procedure TKsCustomControl.SetScrollRange(ScrollBar, Min, Max: integer;
  Redraw: boolean);
begin
  if (ScrollBar = SB_HORZ) and (FHScrollBar <> nil) then
  begin
    TKsCustomScrollBar(FHScrollBar).Min := Min;
    TKsCustomScrollBar(FHScrollBar).Max := Max;
  end;
  if (ScrollBar = SB_VERT) and (FVScrollBar <> nil) then
  begin
    TKsCustomScrollBar(FVScrollBar).Min := Min;
    TKsCustomScrollBar(FVScrollBar).Max := Max;
  end;

  if Redraw then Invalidate;
end;

procedure TKsCustomControl.DoHScroll(Sender: TObject; ScrollCode: TKsScrollCode; var ScrollPos: Integer);
var
  Code: integer;
begin
  if FDisableScrollBarUpdate then Exit;

  case ScrollCode of
    scLineUp: Code := SB_LINELEFT;
    scLineDown: Code := SB_LINERIGHT;
    scPageUp: Code := SB_PAGELEFT;
    scPageDown: Code := SB_PAGERIGHT;
    scPosition: Code := SB_THUMBPOSITION;
    scTrack: Code := SB_THUMBTRACK;
    scTop: Code := SB_LEFT;
    scBottom: Code := SB_RIGHT;
    scEndScroll: Code := SB_ENDSCROLL;
  end;

  Perform(WM_HSCROLL, Code, ScrollPos);

  ScrollPos := TKsCustomScrollBar(FHScrollBar).Position;
end;

procedure TKsCustomControl.DoVScroll(Sender: TObject; ScrollCode: TKsScrollCode; var ScrollPos: Integer);
var
  Code: integer;
begin
  if FDisableScrollBarUpdate then Exit;

  case ScrollCode of
    scLineUp: Code := SB_LINEUP;
    scLineDown: Code := SB_LINEDOWN;
    scPageUp: Code := SB_PAGEUP;
    scPageDown: Code := SB_PAGEDOWN;
    scPosition: Code := SB_THUMBPOSITION;
    scTrack: Code := SB_THUMBTRACK;
    scTop: Code := SB_TOP;
    scBottom: Code := SB_BOTTOM;
    scEndScroll: Code := SB_ENDSCROLL;
  end;

  Perform(WM_VSCROLL, Code, ScrollPos);

  ScrollPos := TKsCustomScrollBar(FVScrollBar).Position;
end;

{ Paint routines }

procedure TKsCustomControl.PaintBuffer;
begin
  if not FTransparent then
    Buffer.Clear(KColor(Color));
end;

procedure TKsCustomControl.MouseEnter;
begin
  FMouseInControl := true;

  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TKsCustomControl.MouseLeave;
begin
  FMouseInControl := false;

  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

procedure TKsCustomControl.KillFocus;
begin
  FFocused := false;
  Invalidate;
end;

procedure TKsCustomControl.HasFocus;
begin
  FFocused := true;
  Invalidate;
end;

{ Buffered Paint }

function TKsCustomControl.IsOwnerBlend: boolean;
var
  B: integer;
begin
  if csDesigning in ComponentState then
  begin
    Result := false;
  end
  else
    if (Owner <> nil) and (Owner is TWinControl) then
    begin
      B := SendMessage((Owner as TWinControl).Handle, WM_FORMISBLEND, 0, 0);
      if B = 0 then
        Result := false
      else
        Result := true;
    end
    else
      Result := false;
end;

procedure TKsCustomControl.PaintOwnerBackground(Buffer: TKsBitmap);
var
  P: TPoint;
  i, SaveIndex: Integer;
begin
  if Parent = nil then Exit;

  { Paint Owner Background }
  if FBlend and (FBlendValue < $FF) then
  begin
    { Blend }
    SaveIndex := SaveDC(Buffer.DC);
    try
      P := ClientOrigin;
      Windows.ScreenToClient(Parent.Handle, P);
      MoveWindowOrg(Buffer.DC, -P.X, -P.Y);

      SendMessage(Parent.Handle, WM_ERASEBKGND, Buffer.DC, BufferFlag or NoChildPaint);

      TParentControl(Parent).PaintControls(Buffer.DC, nil);
    finally
      RestoreDC(Buffer.DC, SaveIndex);
    end;
  end
  else
  begin
    { Normal }
    SaveIndex := SaveDC(Buffer.DC);
    try
      P := ClientOrigin;
      Windows.ScreenToClient(Parent.Handle, P);
      MoveWindowOrg(Buffer.DC, -P.X, -P.Y);

      SendMessage(Parent.Handle, WM_ERASEBKGND, Buffer.DC, BufferFlag or NoChildPaint);

      TParentControl(Parent).PaintControls(Buffer.DC, nil);
    finally
      RestoreDC(Buffer.DC, SaveIndex);
    end;
  end;
end;

procedure TKsCustomControl.UpdateBuffer;
var
  R: TRect;
begin
  if Parent = nil then Exit;
  if not (csDesigning in ComponentState) and (not Visible) then Exit;
  if FBuffer = nil then Exit;
  if FBuffer.Empty then Exit;
  if FBuffer.Width * FBuffer.Height = 0 then Exit;
  if FWidth*FHeight = 0 then Exit;
  if (FWidth < 0) or (FHeight < 0) then Exit;

  if csDesigning in ComponentState then
  else
    if (not FNeedUpdate) and (not IsOwnerBlend) then Exit;

  FFont.Assign(Self.Font);

  { Paint background }
  if FBlend then
  begin
    { Paint back }
    PaintOwnerBackground(FBack);
    FBack.SetAlpha(255);
    { Paint to Buffer }
    if FTransparent then
      FBack.Draw(FBuffer, 0, 0);

    PaintBuffer;

    FBuffer.SetAlpha(FBlendValue);
    { Blend }
    FBuffer.MergeDraw(FBack, 0, 0, Rect(0, 0, FBuffer.Width, FBuffer.Height));
  end
  else
  begin
    if FTransparent then
      PaintOwnerBackground(FBuffer);
    { Paint to Buffer }
    PaintBuffer;
    { Paint Grip }
    if (FHScrollBar <> nil) and (FVScrollBar <> nil) then
    begin
      Windows.GetClientRect(Handle, R);
      R.Left := R.Right - GetScrollBarHeight;
      R.Top := R.Bottom - GetScrollBarHeight;
      Buffer.FillRect(R, KColor(Self.Color));
    end;
  end;

  FNeedUpdate := false;
end;

procedure TKsCustomControl.ResizeBuffer;
var
  IsUpdate: boolean;
  R: TRect;
  HGrip, VGrip: integer;
begin
  if FBuffer = nil then Exit;
  if (FWidth < 0) or (FHeight < 0) then Exit;
  if FDimmension = 0 then Exit;

  { Update scrollbars }
  if Parent = nil then
    R := Rect(0, 0, FWidth, FHeight)
  else
    Windows.GetClientRect(Handle, R);
  { Update SizeGrip}
  HGrip := 0;
  VGrip := 0;
  if FHScrollBar <> nil then HGrip := FHScrollBar.Height;
  if FVScrollBar <> nil then VGrip := FVScrollBar.Width;
  { Update }
  if FHScrollBar <> nil then
    FHScrollBar.BoundsRect := Rect(R.Left, R.Bottom - HGrip, R.Right - VGrip, R.Bottom);
  if FVScrollBar <> nil then
    FVScrollBar.BoundsRect := Rect(R.Right-VGrip, 0, R.Right, R.Bottom - HGrip);

  if csDesigning in ComponentState then
  begin
    FBuffer.SetSize((FWidth div FDimmension + 1) * FDimmension,
      (FHeight div FDimmension + 1) * FDimmension);
    if FBlend then
      FBack.SetSize(FBuffer.Width, FBuffer.Height);

    FNeedUpdate := true;
    UpdateBuffer;
    
    Exit;
  end;
  
  IsUpdate := false;

  { Resize Buffer }
  if (FWidth > FBuffer.Width) or (FHeight > FBuffer.Height) then
  begin
    FBuffer.SetSize((FWidth div FDimmension + 1) * FDimmension,
      (FHeight div FDimmension + 1) * FDimmension);
    IsUpdate := true;
  end;

  if (FWidth < FBuffer.Width - FDimmension) or
     (FHeight < FBuffer.Height - FDimmension) then
  begin
    FBuffer.SetSize((FWidth div FDimmension + 1) * FDimmension,
      (FHeight div FDimmension + 1) * FDimmension);
    IsUpdate := true;
  end;

  if (FBlend) and ((FBack.Width <> FBuffer.Width) or
     (FBack.Height <> FBuffer.Height)) then
  begin
    FBack.SetSize(FBuffer.Width, FBuffer.Height);
    IsUpdate := true;
  end;

  { Update }
  if IsUpdate then
  begin
    { Update }
    FNeedUpdate := true;
    UpdateBuffer;
  end;
end;

procedure TKsCustomControl.PaintControls(DC: HDC);
var
  I, Count, SaveIndex: Integer;
  Ctrl: TKsGraphicControl;
  TempBuffer: TKsBitmap;
begin
  if DockSite and UseDockManager and (DockManager <> nil) then
    DockManager.PaintSite(DC);
  if ControlCount > 0 then
  begin
    I := 0;
    Count := ControlCount;
    while I < Count do
    begin
      Ctrl := nil;
      
      if Controls[i] is TKsGraphicControl then
      begin
        Ctrl := Controls[i] as TKsGraphicControl;

        { Disable background drawing }
        Ctrl.FDisableBackground := true;

        { Draw background }
        Buffer.Draw(Ctrl.Buffer, 0, 0, Ctrl.BoundsRect);

        { Draw control }
        Ctrl.FNeedUpdate := true;
        Ctrl.UpdateBuffer;
        Ctrl.Buffer.Draw(DC, Ctrl.Left, Ctrl.Top, Ctrl.ClientRect);
      end;

      if (Ctrl = nil) and (Controls[I] is TGraphicControl) then
      begin
        { Draw standard control }
        with TControl(Controls[I]) do
        begin
          if (Visible or (csDesigning in ComponentState) and
            not (csNoDesignVisible in ControlStyle)) and
            RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
          begin
            { Paint background }
            TempBuffer := TKsBitmap.Create;
            try
              TempBuffer.SetSize(Width, Height);
              TempBuffer.Clear(ckRed);

              Buffer.Draw(TempBuffer, 0, 0, BoundsRect);

              TempBuffer.Draw(DC, Left, Top);
            finally
              TempBuffer.Free;
            end;

            { Paint control }
            SaveIndex := SaveDC(DC);
            MoveWindowOrg(DC, Left, Top);
            IntersectClipRect(DC, 0, 0, Width, Height);
            Perform(WM_PAINT, DC, 0);
            RestoreDC(DC, SaveIndex);
          end;
        end
      end;

      if Ctrl <> nil then
      begin
        { Enable background drawing }
        Ctrl.FDisableBackground := false;
      end;

      Inc(I);
    end;
  end;
end;

{ Windows Messages }

procedure TKsCustomControl.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
var
  P: TPoint;
begin
  if (Msg.DC <> 0) and (FBuffer <> nil) then
  begin
    if BufferFlag and Msg.Unused <> 0 then
    begin
      { For external buffer }
{      FNeedUpdate := true; }
      UpdateBuffer;
      FBuffer.Draw(Msg.DC, 0, 0);
    end
    else
    begin
{      FNeedUpdate := true; }
      UpdateBuffer;
      FBuffer.Draw(Msg.DC, 0, 0);
    end;
  end;

  Msg.Result := 1;
end;

procedure TKsCustomControl.WMPaint(var Msg: TWMPaint);
var
  DC: HDC;
  PS: TPaintStruct;
begin
  DC := Msg.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  try
    if (FBuffer <> nil) and (not FBuffer.Empty) then
    begin
      FNeedUpdate := true;
      UpdateBuffer;
      PaintControls(FBuffer.DC);
      Buffer.Draw(DC, 0, 0);
    end;
    { Paint Controls }
{    PaintControls(DC); }
  finally
    EndPaint(Handle, PS);
  end;

  Msg.Result := 0;
end;

{ Inherited }

procedure TKsCustomControl.ImmediatelyUpdate;
 procedure ProcessPaintMessages;
 { Dispatches all pending WM_PAINT messages. In effect, this is like an
   'UpdateWindow' on all visible windows }
 var
   Msg: TMsg;
 begin
   while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do
   begin
     case Integer(GetMessage(Msg, 0, WM_PAINT, WM_PAINT)) of
       -1: Break; { if GetMessage failed }
       0: begin
            { Repost WM_QUIT messages }
            PostQuitMessage(Msg.WParam);
            Break;
          end;
     end;
     DispatchMessage(Msg);
   end;
 end;
begin
  Invalidate;
  ProcessPaintMessages;
end;

procedure TKsCustomControl.Invalidate;
begin
  if csDesigning in ComponentState then
  begin
    ResizeBuffer;
  end
  else
    FNeedUpdate := true;

  inherited;
end;

procedure TKsCustomControl.Repaint;
begin
  if csDesigning in ComponentState then
  begin
    ResizeBuffer;
  end
  else
    FNeedUpdate := true;
  inherited;
end;

procedure TKsCustomControl.Resize;
begin
  inherited;
end;

procedure TKsCustomControl.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited;
  FWidth := AWidth;
  FHeight := AHeight;
  ResizeBuffer;
end;

{ VCL Messages }

procedure TKsCustomControl.CMMouseEnter(var Msg: TMessage);
begin
  inherited ;
  MouseEnter;
end;

procedure TKsCustomControl.CMMouseLeave(var Msg: TMessage);
begin
  inherited ;
  MouseLeave;
end;

procedure TKsCustomControl.WMWindowPosChanging(var Msg: TWMWindowPosChanging);
begin
  if Msg.WindowPos^.flags and SWP_NOSIZE = 0 then
  begin
    FWidth := Msg.WindowPos^.cx;
    FHeight := Msg.WindowPos^.cy;
    ResizeBuffer;
  end;

  if (csDesigning in ComponentState) and FBlend then
    Msg.WindowPos^.flags := Msg.WindowPos^.flags or SWP_NOCOPYBITS;

  inherited ;
end;

procedure TKsCustomControl.CMEnter(var Message: TCMEnter);
begin
  HasFocus;
  inherited ;
end;

procedure TKsCustomControl.CMExit(var Message: TCMExit);
begin
  KillFocus;
  inherited ;
end;

{ Properties }

procedure TKsCustomControl.SetScrollBars(const Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    RecreateWnd;
  end;
end;

procedure TKsCustomControl.SetTransparent(const Value: boolean);
begin
  if Transparent <> Value then
  begin
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TKsCustomControl.SetBlend(const Value: boolean);
begin
  if FBlend <> Value then
  begin
    FBlend := Value;
    Invalidate;
  end;
end;

procedure TKsCustomControl.SetBlendValue(const Value: integer);
begin
  if FBlendValue <> Value then
  begin
    FBlendValue := Value;
    Invalidate;
  end;
end;

procedure TKsCustomControl.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;



{ TKsGraphicControl ============================================================}



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

  FFont := TFont.Create;

  FBuffer := TKsBitmap.Create;
  FBack := TKsBitmap.Create;

  FBlend := false;
  FBlendValue := 150;
  Color := clBtnFace;

  FDimmension := 30;
  SetBounds(0, 0, 100, 30);
end;

destructor TKsGraphicControl.Destroy;
begin
  FFont.Free;
  FBack.Free;
  FBuffer.Free;
  inherited Destroy;
end;

procedure TKsGraphicControl.Loaded;
begin
  inherited;
  Invalidate;
end;

procedure TKsGraphicControl.PaintBuffer;
begin
  if not FTransparent then
    Buffer.Clear(KColor(Color));
end;

procedure TKsGraphicControl.MouseEnter;
begin
  FMouseInControl := true;

  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TKsGraphicControl.MouseLeave;
begin
  FMouseInControl := false;

  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

{ Buffered Paint }

function TKsGraphicControl.IsOwnerBlend: boolean;
var
  B: integer;
begin
  if csDesigning in ComponentState then
  begin
    Result := false;
  end
  else
    if (Owner <> nil) and (Owner is TWinControl) then
    begin
      B := SendMessage((Owner as TWinControl).Handle, WM_FORMISBLEND, 0, 0);
      if B = 0 then
        Result := false
      else
        Result := true;
    end
    else
      Result := false;
end;

procedure TKsGraphicControl.UpdateBuffer;
begin
  if not (csDesigning in ComponentState) and (not Visible) then Exit;
  if FBuffer = nil then Exit;
  if FBuffer.Empty then Exit;
  if FBuffer.Width * FBuffer.Height = 0 then Exit;
  if FWidth*FHeight = 0 then Exit;
  if (FWidth < 0) or (FHeight < 0) then Exit;
  if not FNeedUpdate then Exit;

  FFont.Assign(Self.Font);

  { Paint background }
  if FBlend then
  begin
    { Paint back }
    KsUtils.PaintGraphicBackground(Self, FBack.DC, IsOwnerBlend);
    FBack.SetAlpha(255);
    { Paint to Buffer }
    if FTransparent then
      FBack.Draw(FBuffer, 0, 0);

    PaintBuffer;

    FBuffer.SetAlpha(FBlendValue);
    { Blend }
    FBuffer.MergeDraw(FBack, 0, 0, Rect(0, 0, FBuffer.Width, FBuffer.Height));
  end
  else
  begin
    if FTransparent and not FDisableBackground then
      KsUtils.PaintGraphicBackground(Self, FBuffer.DC, false);
    { Paint to Buffer }
    PaintBuffer;
  end;

  FNeedUpdate := false;
end;

procedure TKsGraphicControl.ResizeBuffer;
var
  IsUpdate: boolean;
begin
  if FBuffer = nil then Exit;
  if (FWidth < 0) or (FHeight < 0) then Exit;
  if FDimmension = 0 then Exit;

  if csDesigning in ComponentState then
  begin
    FBuffer.SetSize((FWidth div FDimmension + 1) * FDimmension,
      (FHeight div FDimmension + 1) * FDimmension);
    if FBlend then
      FBack.SetSize(FBuffer.Width, FBuffer.Height);
      
    FNeedUpdate := true;
    UpdateBuffer;
    
    Exit;
  end;
  
  IsUpdate := false;

  { Resize Buffer }
  if (FWidth > FBuffer.Width) or (FHeight > FBuffer.Height) then
  begin
    FBuffer.SetSize((FWidth div FDimmension + 1) * FDimmension,
      (FHeight div FDimmension + 1) * FDimmension);
    IsUpdate := true;
  end;

  if (FWidth < FBuffer.Width - FDimmension) or
     (FHeight < FBuffer.Height - FDimmension) then
  begin
    FBuffer.SetSize((FWidth div FDimmension + 1) * FDimmension,
      (FHeight div FDimmension + 1) * FDimmension);
    IsUpdate := true;
  end;

  if (FBlend) and ((FBack.Width <> FBuffer.Width) or
     (FBack.Height <> FBuffer.Height)) then
  begin
    FBack.SetSize(FBuffer.Width, FBuffer.Height);
    IsUpdate := true;
  end;

  { Update }
  if IsUpdate then
  begin
    { Update }
    FNeedUpdate := true;
    UpdateBuffer;
  end;
end;

{ Inherited }

procedure TKsGraphicControl.Paint;
begin
  { Draw Buffer }
  if (Buffer <> nil) and (not Buffer.Empty) then
  begin
    FNeedUpdate := true;
    UpdateBuffer;
    if not FNeedUpdate then
      Buffer.Draw(Canvas.Handle, 0, 0);
  end;
end;

procedure TKsGraphicControl.Invalidate;
var
  R: TRect;
begin
  if csDesigning in ComponentState then
    ResizeBuffer
  else
    FNeedUpdate := true;

  inherited Invalidate;
end;

procedure TKsGraphicControl.Resize;
begin
  inherited;
end;

procedure TKsGraphicControl.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited;
  FWidth := AWidth;
  FHeight := AHeight;
  ResizeBuffer;
end;

{ VCL Messages }

procedure TKsGraphicControl.CMMouseEnter(var Msg: TMessage);
begin
  inherited ;
  MouseEnter;
end;

procedure TKsGraphicControl.CMMouseLeave(var Msg: TMessage);
begin
  inherited ;
  MouseLeave;
end;

{ Properties }

procedure TKsGraphicControl.SetTransparent(const Value: boolean);
begin
  if Transparent <> Value then
  begin
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TKsGraphicControl.SetBlend(const Value: boolean);
begin
  if FBlend <> Value then
  begin
    FBlend := Value;
    Invalidate;
  end;
end;

procedure TKsGraphicControl.SetBlendValue(const Value: integer);
begin
  if FBlendValue <> Value then
  begin
    FBlendValue := Value;
    Invalidate;
  end;
end;

procedure TKsGraphicControl.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

end.
