{********************************************************************} { } { 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.