Componentes.Terceros.DevExpressVCL/internal/x.44/1/ExpressLayout Control 2/Sources/dxControlSelection.pas

{********************************************************************}
{                                                                    }
{           Developer Express Visual Component Library               }
{           ExpressLayoutControl common routines                     }
{                                                                    }
{           Copyright (c) 2001-2009 Developer Express Inc.           }
{           ALL RIGHTS RESERVED                                      }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSLAYOUTCONTROL AND ALL          }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM       }
{   ONLY.                                                            }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit dxControlSelection;

{$I cxVer.inc}

interface

uses
  Windows, Messages, Graphics, Classes, Controls, cxClasses, cxGraphics;

type

  { TdxSelectionLayer }

  TdxSelectionLayer = class(TCustomControl)
  private
    FSelectionImage: TcxAlphaBitmap;
    FWindowCanvas: TcxCanvas;
    FParentControl: TWinControl;
    FOnHide: TNotifyEvent;
    FOnShow: TNotifyEvent;
    function GetWindowCanvas: TcxCanvas;
    procedure SetParentControl(AValue: TWinControl);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure CreateParams(var Params: TCreateParams); override;

    procedure DoHide; virtual;
    procedure DoShow; virtual;
    procedure InternalPaint; virtual;
    property WindowCanvas: TcxCanvas read GetWindowCanvas;
  public
    constructor Create(AParentControl: TWinControl; AParentWindow: HWND); reintroduce; virtual;
    destructor Destroy; override;

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

    procedure MoveTo(const P: TPoint);
    procedure Hide;
    procedure Show;

    property SelectionImage: TcxAlphaBitmap read FSelectionImage;
    property ParentControl: TWinControl read FParentControl write SetParentControl;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
  end;

implementation

uses
  SysUtils, Types, cxGeometry;

{ TdxSelectionLayer }

constructor TdxSelectionLayer.Create(AParentControl: TWinControl; AParentWindow: HWND);
begin
  CreateParented(AParentWindow);
  FSelectionImage := TcxAlphaBitmap.Create;
  FWindowCanvas := TcxCanvas.Create(inherited Canvas);
  Visible := False;
  ParentControl := AParentControl;
end;

destructor TdxSelectionLayer.Destroy;
begin
  FreeAndNil(FWindowCanvas);
  FreeAndNil(FSelectionImage);
  inherited Destroy;
end;

procedure TdxSelectionLayer.Paint;
begin
  inherited;
  InternalPaint;
end;

procedure TdxSelectionLayer.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SelectionImage.SetSize(Width, Height);
end;

procedure TdxSelectionLayer.MoveTo(const P: TPoint);
begin
  SetBounds(P.X, P.Y, Width, Height);
end;

procedure TdxSelectionLayer.Hide;
begin
  if HandleAllocated then
  begin
    ShowWindow(Handle, SW_HIDE);
    DoHide;
  end;
end;

procedure TdxSelectionLayer.Show;
begin
  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  Update;
  Invalidate;
  BringWindowToTop(Handle);
  DoShow;
end;

procedure TdxSelectionLayer.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style and not WS_POPUP;
    ExStyle := ExStyle or WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
  end;
  if ParentControl <> nil then
    Params.WndParent := ParentControl.Handle;
end;

procedure TdxSelectionLayer.DoHide;
begin
  CallNotify(FOnHide, Self);
end;

procedure TdxSelectionLayer.DoShow;
begin
  CallNotify(FOnShow, Self);
end;

procedure TdxSelectionLayer.InternalPaint;

  procedure cxPaintControlTo(ADrawControl: TWinControl; ACanvas: TcxCanvas;
    AOffsetX, AOffsetY: Integer; ADrawRect: TRect);

    procedure DrawEdgesAndBorders;
    var
      AEdgeFlags, ABorderFlags: Integer;
      ABorderRect: TRect;
    begin
      ABorderFlags := 0;
      AEdgeFlags := 0;
      if GetWindowLong(ADrawControl.Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE <> 0 then
      begin
        AEdgeFlags := EDGE_SUNKEN;
        ABorderFlags := BF_RECT or BF_ADJUST
      end
      else
        if GetWindowLong(ADrawControl.Handle, GWL_STYLE) and WS_BORDER <> 0 then
        begin
          AEdgeFlags := BDR_OUTER;
          ABorderFlags := BF_RECT or BF_ADJUST or BF_MONO;
        end;
      if ABorderFlags <> 0 then
      begin
        ABorderRect := Rect(0, 0, ADrawControl.Width, ADrawControl.Height);
        DrawEdge(ACanvas.Handle, ABorderRect, AEdgeFlags, ABorderFlags);
        ACanvas.SetClipRegion(TcxRegion.Create(ABorderRect), roIntersect);
        MoveWindowOrg(ACanvas.Handle, ABorderRect.Left, ABorderRect.Top);
      end;
    end;

  var
    I: Integer;
    AChildControl: TControl;
    AWindowRegion: TcxRegion;
  begin
    ACanvas.SaveDC;
    try
      MoveWindowOrg(ACanvas.Handle, AOffsetX, AOffsetY);
      if not RectVisible(ACanvas.Handle, ADrawRect) then Exit;

      ACanvas.IntersectClipRect(ADrawRect);
      ADrawControl.ControlState := ADrawControl.ControlState + [csPaintCopy];
      try
        ACanvas.Canvas.Lock;
        try
          ACanvas.SaveClipRegion;
          try
            if ADrawControl.HandleAllocated then
            begin
              AWindowRegion := TcxRegion.Create;
              if GetWindowRgn(ADrawControl.Handle, AWindowRegion.Handle) in [SIMPLEREGION, COMPLEXREGION] then
                ACanvas.SetClipRegion(AWindowRegion, roIntersect, False);
              AWindowRegion.Free;
            end;

            ADrawControl.Perform(WM_ERASEBKGND, ACanvas.Handle, ACanvas.Handle);
            ADrawControl.Perform(WM_PAINT, ACanvas.Handle, 0);
          finally
            ACanvas.RestoreClipRegion;
          end;
        finally
          ACanvas.Canvas.Unlock;
        end;
        for I := 0 to ADrawControl.ControlCount - 1 do
        begin
          AChildControl := ADrawControl.Controls[I];
          if (AChildControl is TWinControl) and (AChildControl as TWinControl).Visible then
            cxPaintControlTo((AChildControl as TWinControl), ACanvas, AChildControl.Left, AChildControl.Top, Rect(0, 0, AChildControl.Width, AChildControl.Height));
        end;
      finally
        ADrawControl.ControlState := ADrawControl.ControlState - [csPaintCopy];
      end;
    finally
      ACanvas.RestoreDC;
    end;
  end;

var
  R: TRect;
  ABitmap: TcxBitmap32;
begin
  ABitmap := TcxBitmap32.CreateSize(ClientRect);
  try
    R := cxRectOffset(ClientRect, Left, Top);
    cxPaintControlTo(ParentControl, ABitmap.cxCanvas, -R.Left, -R.Top, R);
    cxAlphaBlend(ABitmap.cxCanvas.Handle, SelectionImage.cxCanvas.Handle, ClientRect, ClientRect);
    cxBitBlt(WindowCanvas.Handle, ABitmap.cxCanvas.Handle, ClientRect, cxNullPoint, SRCCOPY);
  finally
    ABitmap.Free;
  end;
end;

function TdxSelectionLayer.GetWindowCanvas: TcxCanvas;
begin
  Result := FWindowCanvas;
end;

procedure TdxSelectionLayer.SetParentControl(AValue: TWinControl);
begin
  if FParentControl <> AValue then
  begin
    FParentControl := AValue;
    RecreateWnd;
  end;
end;

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

procedure TdxSelectionLayer.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTTRANSPARENT;
end;

end.