为什么你实现了的东西我全都实现了？？？
给大家源码。。。
unit ControlEdit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, ExtCtrls, StdCtrls, Types, Math, Menus, Clipbrd;
const
PRASE_FLAG = 'Clipboard_';
type
TDragStyle = (dsMove, dsLeft, dsRight, dsTop, dsBottom, dsLeftTop,
dsRightTop, dsLeftBottom, dsRightBottom, dsUnknown);
TSide = (sLeft, sRight, sTop, sBottom, sCenter);
TCtrlKey = (ckCtrl, ckShift, ckAlt, ckNone);
TAlignStyle = (sHorizontal, sVertical);
TControlEvent = procedure (AControl: TControl;
var Allowed: Boolean) of object;
type
TSizeFrames = class;
TSizeFrame = class(TCustomControl)
private
FOwner: TSizeFrames;
FControl: TControl;
FBakWindowProc: TWndMethod;
FLastPos: TPoint;
FDragStyle: TDragStyle;
FDraging: Boolean;
FNewClient, FOldClient: TRect;
procedure SetCursor(DragStyle: TDragStyle);
function InSizeBox(Pos: TPoint): TDragStyle;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);
message WM_ERASEBKGND;
procedure WMGetDLGCode(var Message: TMessage);
message WM_GETDLGCODE;
procedure DrawFrame(Offset: TPoint;
DragStyle: TDragStyle);
procedure DrawBox;
procedure SetControl(const Value: TControl);
procedure RePaintChild(AControl: TControl);
function GetItemIndex: Integer;
procedure CMRelease(var Message: TMessage);
message CM_RELEASE;
function GetDragRect: TRect;
protected
procedure Paint;
override;
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure GetChildren(Proc: TGetChildProc;
Root: TComponent);
override;
procedure CreateParams(var Params: TCreateParams);
override;
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
override;
procedure MouseMove(Shift: TShiftState;
X, Y: Integer);
override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
override;
procedure DblClick;
override;
procedure KeyDown(var key: Word;
Shift: TShiftState);
override;
procedure ControlWindowProc(var Message: TMessage);
public
constructor Create(AOwner: TSizeFrames);
overload;
destructor Destroy;
override;
procedure Refresh;
procedure Release;
property Control: TControl read FControl write SetControl;
property ItemIndex: Integer read GetItemIndex;
property DragRect: TRect read GetDragRect;
end;
TSizeFrames = class(TComponent)
private
FCurFrame: TSizeFrame;
FFrameList: TList;
FPopupMenu: TPopupMenu;
FHintWindow: THintWindow;
FDragOffset: TPoint;
FSnapToGrid: Boolean;
FBoxWidth, FBoxHeight: Integer;
FBoxColor, FHighLightBoxColor: TColor;
FLocked: Boolean;
FGridX, FGridY: Integer;
FMoveHotKey, FReSizeHotKey: TCtrlKey;
FShowHint: Boolean;
FOnKeyDown: TKeyEvent;
FOnMouseDown: TMouseEvent;
FOnMouseUp: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnDblClick: TNotifyEvent;
function GetChildren(index: Integer): TControl;
function GetChildCount: Integer;
function GetSizeFrame(AControl: TControl): TSizeFrame;
procedure ShowHintMsg(AHint: string;
X, Y: Integer);//未实现
function GetSizeFrames(index: Integer): TSizeFrame;
function GetSideControl(Side: TSide): TControl;
//获得最临近的控件
function GetNearControl(ChildControl: TControl;
Side: TSide): TControl;
//控件所占高度（宽度）之和（不考虑重叠）
function SumOfChieldWidth: Integer;
function SumOfChieldHeight: Integer;
procedure SetPopupMenu(const Value: TPopupMenu);
protected
procedure Loaded;
override;
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
virtual;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
virtual;
procedure MouseMove(Shift: TShiftState;
X, Y: Integer);
virtual;
procedure KeyDown(var Key: Word;
Shift: TShiftState);
virtual;
procedure DblClick;
virtual;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure Refresh;
function IndexOf(AChild: TControl): Integer;
function AddChild(AChild: TControl): TSizeFrame;
procedure RemoveChild(AChild: TControl);
overload;
procedure RemoveChild(nIndex: Integer);
overload;
procedure Clear;
//按方向对齐
procedure AlignTo(Side: TSide;
AlignStyle: TAlignStyle = sHorizontal);
//等距排列
procedure SpaceEqu(AlignStyle: TAlignStyle);
//设置等高(等长)
procedure HeightEqu;
procedure WidthEqu;
property CurFrame: TSizeFrame read FCurFrame;
property ChildCount: Integer read GetChildCount;
property Children[index: Integer]: TControl read GetChildren;
property SizeFrames[index: Integer]: TSizeFrame read GetSizeFrames;
property MoveHotKey: TCtrlKey read FMoveHotKey write FMoveHotKey;
property ReSizeHotKey: TCtrlKey read FReSizeHotKey write FReSizeHotKey;
property Locked: Boolean read FLocked write FLocked;
property BoxWidth: Integer read FBoxWidth write FBoxWidth;
property BoxHeight: Integer read FBoxHeight write FBoxHeight;
property BoxColor: TColor read FBoxColor write FBoxColor;
property HighLightBoxColor: TColor read FHighLightBoxColor write FHighLightBoxColor;
property GridXSize: Integer read FGridX write FGridX;
property GridYSize: Integer read FGridY write FGridY;
property SnapToGrid: Boolean read FSnapToGrid write FSnapToGrid;
property ShowHint: Boolean read FShowHint write FShowHint;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
end;
TDragRectEvent = procedure(DragRect: TRect;
var AllowSelect: Boolean) of object;
TControlEdit = class(TSizeFrames)
private
FEditControl: TWinControl;
FBakAppMsg: TMessageEvent;
FOnSelect: TControlEvent;
FOnDisSelect: TControlEvent;
FBeforeDelete: TNotifyEvent;
FAfterDelete: TNotifyEvent;
FOnDragRect: TDragRectEvent;
FSelectionCount: Integer;
FMutiSelKey: TCtrlKey;
FDraging: Boolean;
FDragThreshold: Integer;
FEnable: Boolean;
PointStart, PointEnd: TPoint;
FNewRect, FOldRect: TRect;
FCopyPasteKey: Boolean;
FDelKey: Boolean;
//获得最临近的控件
function GetNearControl(ChildControl: TControl;
Side: TSide): TControl;
function GetSelections(index: Integer): TControl;
function GetSelected: TControl;
function GetSelectionCount: Integer;
procedure SetEditControl(const Value: TWinControl);
function GetControl(X, Y: Integer): TControl;
overload;
function GetControl(AHandel: HWND): TControl;
overload;
function ControlInRect(AControl: TControl;
ARect: TRect): Boolean;//屏幕坐标
function GetClicked: TControl;
procedure SetEnable(const Value: Boolean);
procedure ChangeParent(AControl: TControl;
NewParent: TWinControl);
function GetComponentName(OldName, ClassName: string): string;
function GetDragRect: TRect;
protected
procedure Loaded;
override;
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure DisSelectChild(AControl: TControl);
procedure MouseDown(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
override;
procedure MouseMove(Shift: TShiftState;
X, Y: Integer);
override;
procedure KeyDown(var key: Word;
Shift: TShiftState);
override;
procedure AppEventMessage(var Msg: TMsg;
var Handled: Boolean);
virtual;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
function CopyToClipboard: Boolean;
function PraseFromClipboard(AParent: TWinControl):Boolean;
procedure SelectChild(AControl: TControl);
procedure Delse
lected;
procedure RegChildClass;
property SelectionCount: Integer read GetSelectionCount;
property Selections[index: Integer]: TControl read GetSelections;
property Selected: TControl read GetSelected;
property Clicked: TControl read GetClicked;
property DragRect: TRect read GetDragRect;
published
property EditControl: TWinControl read FEditControl write SetEditControl;
property OnSelect: TControlEvent read FOnSelect write FOnSelect;
property OnDisSelect: TControlEvent read FOnDisSelect write FOnDisSelect;
property OnDragRect: TDragRectEvent read FOnDragRect write FOnDragRect;
property OnBeforeDelete: TNotifyEvent read FBeforeDelete write FBeforeDelete;
property OnAfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
property MutiSelKey: TCtrlKey read FMutiSelKey write FMutiSelKey default ckCtrl;
property Enable: Boolean read FEnable write SetEnable default True;
property CopyPasteKey: Boolean read FCopyPasteKey write FCopyPasteKey default False;
property DelKey: Boolean read FDelKey write FDelKey default False;
property DragThreshold: Integer read FDragThreshold write FDragThreshold default 3;
property MoveHotKey default ckCtrl;
property ReSizeHotKey default ckShift;
property Locked default False;
property SnapToGrid default True;
property GridXSize default 8;
property GridYSize default 8;
property ShowHint default False;
property PopupMenu;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnKeyDown;
property OnDblClick;
end;
procedure Register;
implementation
var
DataFormat: Cardinal;
procedure Register;
begin
RegisterComponents('FcControls', [TControlEdit]);
end;
{ TSizeFrame }
constructor TSizeFrame.Create(AOwner: TSizeFrames);
begin
inherited Create(nil);
ControlStyle := [csCaptureMouse, csDoubleClicks, csClickEvents];
FOwner := AOwner;
FDragStyle := dsUnknown;
FDraging := False;
end;
destructor TSizeFrame.Destroy;
begin
inherited;
if Assigned(FControl) then
begin
FControl.WindowProc := FBakWindowProc;
FControl.RemoveFreeNotification(Self);
end;
end;
function TSizeFrame.InSizeBox(Pos: TPoint): TDragStyle;
begin
if (Pos.X < FOwner.FBoxWidth) and (Pos.Y < FOwner.FBoxHeight) then
begin
Result := dsLeftTop;
Exit;
end;
if (Width - Pos.X < FOwner.FBoxWidth) and (Pos.Y < FOwner.FBoxHeight) then
begin
Result := dsRightTop;
Exit;
end;
if (Pos.X < FOwner.FBoxWidth) and (Height - Pos.Y < FOwner.FBoxHeight) then
begin
Result := dsLeftBottom;
Exit;
end;
if (Width - Pos.X < FOwner.FBoxWidth) and (Height - Pos.Y < FOwner.FBoxHeight) then
begin
Result := dsRightBottom;
Exit;
end;
if (Abs(2 * Pos.X - Width) < 2 * FOwner.FBoxWidth) and (Pos.Y < FOwner.FBoxHeight) then
begin
Result := dsTop;
Exit;
end;
if (Abs(2 * Pos.X - Width) < 2 * FOwner.FBoxWidth) and (Height - Pos.Y < FOwner.FBoxHeight) then
begin
Result := dsBottom;
Exit;
end;
if (Pos.X < FOwner.FBoxWidth) and (Abs(2 * Pos.Y - Height) < 2 * FOwner.FBoxHeight) then
begin
Result := dsLeft;
Exit;
end;
if (Width - Pos.X < FOwner.FBoxWidth) and (Abs(2 * Pos.Y - Height) < 2 * FOwner.FBoxHeight) then
begin
Result := dsRight;
Exit;
end;
Result := dsMove;
end;
procedure TSizeFrame.SetCursor(DragStyle: TDragStyle);
begin
case DragStyle of
dsLeft: Cursor := crSizeWE;
dsRight: Cursor := crSizeWE;
dsTop: Cursor := crSizeNS;
dsBottom: Cursor := crSizeNS;
dsLeftTop: Cursor := crSizeNWSE;
dsRightTop: Cursor := crSizeNESW;
dsLeftBottom: Cursor := crSizeNESW;
dsRightBottom: Cursor := crSizeNWSE;
else
Cursor := crDefault;
end;
end;
procedure TSizeFrame.DrawFrame(Offset: TPoint;
DragStyle: TDragStyle);
var
DC: HDC;
begin
FNewClient.TopLeft := Parent.ClientToScreen(Point(FControl.Left, FControl.Top));
FNewClient.BottomRight := Parent.ClientToScreen(Point(FControl.Left + FControl.Width, FControl.Top + FControl.Height));
if FOwner.FSnapToGrid then
begin
Offset.X := (Offset.X div FOwner.FGridX) * FOwner.FGridX;
Offset.Y := (Offset.Y div FOwner.FGridY) * FOwner.FGridY;
end;
case DragStyle of
dsMove:
begin
FNewClient.Left := FNewClient.Left + Offset.X;
FNewClient.Right := FNewClient.Right + Offset.X;
FNewClient.Top := FNewClient.Top + Offset.Y;
FNewClient.Bottom := FNewClient.Bottom + Offset.Y;
end;
dsLeft: FNewClient.Left := FNewClient.Left + Offset.X;
dsRight: FNewClient.Right := FNewClient.Right + Offset.X;
dsTop: FNewClient.Top := FNewClient.Top + Offset.Y;
dsBottom: FNewClient.Bottom := FNewClient.Bottom + Offset.Y;
dsLeftTop:
begin
FNewClient.Left := FNewClient.Left + Offset.X;
FNewClient.Top := FNewClient.Top + Offset.Y;
end;
dsRightTop:
begin
FNewClient.Right := FNewClient.Right + Offset.X;
FNewClient.Top := FNewClient.Top + Offset.Y;
end;
dsLeftBottom:
begin
FNewClient.Left := FNewClient.Left + Offset.X;
FNewClient.Bottom := FNewClient.Bottom + Offset.Y;
end;
dsRightBottom:
begin
FNewClient.Right := FNewClient.Right + Offset.X;
FNewClient.Bottom := FNewClient.Bottom + Offset.Y;
end;
else
begin
FNewClient.TopLeft := Point(0, 0);
FNewClient.BottomRight := Point(0, 0);
end;
end;
DC := GetDC(0);
DrawFocusRect(DC, FOldClient);
DrawFocusRect(DC, FNewClient);
FOldClient := FNewClient;
ReleaseDC(0, DC);
end;
procedure TSizeFrame.MouseDown(Button: TMouseButton;
Shift: TShiftState;
X,
Y: Integer);
var
i: Integer;
ARect: TRect;
begin
inherited;
FOwner.FCurFrame := Self;
FOwner.MouseDown(Button, Shift, X, Y);
SetFocus;
if FOwner.FLocked or (Button <> mbLeft) then
Exit;
FDraging := True;
ARect := Parent.ClientRect;
ARect.TopLeft := Parent.ClientToScreen(ARect.TopLeft);
ARect.BottomRight := Parent.ClientToScreen(ARect.BottomRight);
ClipCursor(@ARect);
FLastPos := Point(X, Y);
MouseCapture := True;
if FOwner.ChildCount = 1 then
begin
FDragStyle := InSizeBox(Point(X, Y));
end else
begin
for i := 0 to FOwner.ChildCount - 1do
FOwner.SizeFrames.FDragStyle := dsMove;
end;
for i := 0 to FOwner.ChildCount - 1do
begin
with FOwner.SizeFramesdo
begin
FDraging := True;
FNewClient.TopLeft := Parent.ClientToScreen(Point(FControl.Left, FControl.Top));
FNewClient.BottomRight := Parent.ClientToScreen(Point(FControl.Left + FControl.Width, FControl.Top + FControl.Height));
end;
end;
end;
procedure TSizeFrame.MouseMove(Shift: TShiftState;
X, Y: Integer);
var
i, MoveDistance: Integer;
begin
inherited;
FOwner.FCurFrame := Self;
FOwner.MouseMove(Shift, X, Y);
if FOwner.FLocked then
begin
Cursor := crNoDrop;
Exit;
end;
if not FDraging and (FOwner.ChildCount = 1) then
begin
FDragStyle := InSizeBox(Point(X, Y));
SetCursor(FDragStyle);
end;
if FDraging then
begin
MoveDistance := Abs(X - FLastPos.X);
if MoveDistance < Abs(Y - FLastPos.Y) then
MoveDistance := Abs(Y - FLastPos.Y);
if (FDragStyle = dsMove) and
(MoveDistance > TControlEdit(FOwner).FDragThreshold) then
Screen.Cursor := crDrag;
FOwner.FDragOffset := Point(X - FLastPos.X, Y - FLastPos.Y);
for i := 0 to FOwner.ChildCount - 1do
FOwner.SizeFrames.DrawFrame(FOwner.FDragOffset, FDragStyle);
end;
end;
procedure TSizeFrame.MouseUp(Button: TMouseButton;
Shift: TShiftState;
X,
Y: Integer);
var
ARect: TRect;
i: Integer;
begin
inherited;
FOwner.FCurFrame := Self;
FOwner.MouseUp(Button, Shift, X, Y);
if FOwner.FLocked or (Button <> mbLeft) then
Exit;
FDraging := False;
ClipCursor(nil);
MouseCapture := False;
Screen.Cursor := crDefault;
for i := 0 to FOwner.ChildCount - 1do
begin
with FOwner.SizeFramesdo
begin
ARect.TopLeft := Parent.ScreenToClient(FNewClient.TopLeft);
ARect.BottomRight := Parent.ScreenToClient(FNewClient.BottomRight);
FDragStyle := dsUnknown;
FDraging := False;
DrawFrame(FOwner.FDragOffset, FDragStyle);
//擦除边框
with ARectdo
begin
if Parent = FOwner.FCurFrame.Parent then
FControl.SetBounds(Left, Top, Right - Left, Bottom - Top);
end;
Refresh;
end;
end;
end;
procedure TSizeFrame.DrawBox;
var
BoxRect: TRect;
begin
if FDraging or (FOwner.ChildCount < 1) then
Exit;
if FOwner.ChildCount = 1 then
Canvas.Brush.Color := FOwner.FHighLightBoxColor
else
Canvas.Brush.Color := FOwner.FBoxColor;
BoxRect := Rect(0, 0, FOwner.FBoxWidth, FOwner.FBoxHeight);
Canvas.FillRect(BoxRect);
BoxRect := Rect(Width - FOwner.FBoxWidth, 0, Width, FOwner.FBoxHeight);
Canvas.FillRect(BoxRect);
BoxRect := Rect(0, Height - FOwner.FBoxHeight, FOwner.FBoxWidth, Height);
Canvas.FillRect(BoxRect);
BoxRect := Rect(Width - FOwner.FBoxWidth, Height - FOwner.FBoxHeight, Width, Height);
Canvas.FillRect(BoxRect);
if FOwner.ChildCount = 1 then
begin
BoxRect := Rect((Width - FOwner.FBoxWidth) div 2, 0,
(Width + FOwner.FBoxWidth) div 2, FOwner.FBoxHeight);
Canvas.FillRect(BoxRect);
BoxRect := Rect((Width - FOwner.FBoxWidth) div 2, Height - FOwner.FBoxHeight,
(Width + FOwner.FBoxWidth) div 2, Height);
Canvas.FillRect(BoxRect);
BoxRect := Rect(0, (Height - FOwner.FBoxHeight) div 2,
FOwner.FBoxWidth, (Height + FOwner.FBoxHeight) div 2);
Canvas.FillRect(BoxRect);
BoxRect := Rect(Width - FOwner.FBoxWidth, (Height - FOwner.FBoxHeight) div 2,
Width, (Height + FOwner.FBoxHeight) div 2);
Canvas.FillRect(BoxRect);
end;
end;
procedure TSizeFrame.Paint;
begin
inherited;
DrawBox;
end;
procedure TSizeFrame.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TSizeFrame.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TSizeFrame.SetControl(const Value: TControl);
begin
if Assigned(FControl) then
begin
FControl.WindowProc := FBakWindowProc;
FControl.RemoveFreeNotification(Self);
end;
FControl := Value;
if Assigned(FControl) then
begin
Parent := FControl.Parent;
FNewClient.TopLeft := Parent.ClientToScreen(Point(FControl.Left, FControl.Top));
FNewClient.BottomRight := Parent.ClientToScreen(Point(FControl.Left + FControl.Width, FControl.Top + FControl.Height));
SetBounds(FControl.Left - (FOwner.FBoxWidth div 2),
FControl.Top - (FOwner.FBoxHeight div 2),
FControl.Width + FOwner.FBoxWidth,
FControl.Height + FOwner.FBoxHeight);
FBakWindowProc := FControl.WindowProc;
FControl.WindowProc := ControlWindowProc;
FControl.FreeNotification(Self);
{if FControl is TWinControl then
begin
SetWindowPos(TWinControl(FControl).Handle ,Handle, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOREDRAW);
end;
}
end;
end;
procedure TSizeFrame.WMGetDLGCode(var Message: TMessage);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure TSizeFrame.KeyDown(var key: Word;
Shift: TShiftState);
var
i, j: Integer;
bMove: Boolean;
bChangeSize: Boolean;
begin
inherited;
FOwner.FCurFrame := Self;
FOwner.KeyDown(key, Shift);
case FOwner.FMoveHotKey of
ckCtrl: bMove := (ssCtrl in Shift);
ckAlt: bMove := (ssAlt in Shift);
ckShift: bMove := (ssShift in Shift);
else
bMove := False;
end;
case FOwner.FReSizeHotKey of
ckCtrl: bChangeSize := (ssCtrl in Shift);
ckAlt: bChangeSize := (ssAlt in Shift);
ckShift: bChangeSize := (ssShift in Shift);
else
bChangeSize := False;
end;
if bMove then
for i := 0 to FOwner.ChildCount - 1do
with TSizeFrame(FOwner.FFrameList).FControldo
begin
case Key of
VK_UP: SetBounds(Left, Top - 1, Width, Height);
VK_DOWN: SetBounds(Left, Top + 1, Width, Height);
VK_LEFT: SetBounds(Left - 1, Top, Width, Height);
VK_RIGHT: SetBounds(Left + 1, Top, Width, Height);
else
Exit;
end;
end;
if bChangeSize then
for j := 0 to FOwner.ChildCount - 1do
with TSizeFrame(FOwner.FFrameList[j]).FControldo
begin
case Key of
VK_UP: SetBounds(Left, Top, Width, Height - 1);
VK_DOWN: SetBounds(Left, Top, Width, Height + 1);
VK_LEFT: SetBounds(Left, Top, Width - 1, Height);
VK_RIGHT: SetBounds(Left, Top, Width + 1, Height);
else
Exit;
end;
end;
end;
procedure TSizeFrame.DblClick;
begin
inherited;
FOwner.FCurFrame := Self;
FOwner.DblClick;
end;
procedure TSizeFrame.RePaintChild(AControl: TControl);
var
i: Integer;
begin
if not Assigned(AControl) then
Exit;
AControl.Repaint;
AControl.Perform(CM_BORDERCHANGED, 0, 0);
if AControl is TWinControl then
with TWinControl(AControl)do
for i := 0 to ControlCount - 1do
RePaintChild(Controls);
end;
function TSizeFrame.GetItemIndex: Integer;
begin
for Result := 0 to FOwner.ChildCount - 1do
begin
if FOwner.SizeFrames[Result] = Self then
Exit;
end;
Result := -1;
end;
procedure TSizeFrame.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (AComponent = FControl) and (Operation = opRemove) then
begin
FControl := nil;
Release;
end;
end;
//不要写入dfm文件
procedure TSizeFrame.GetChildren(Proc: TGetChildProc;
Root: TComponent);
begin
end;
procedure TSizeFrame.CMRelease(var Message: TMessage);
begin
Free;
end;
procedure TSizeFrame.Refresh;
begin
SetBounds(FControl.Left - (FOwner.FBoxWidth div 2),
FControl.Top- (FOwner.FBoxHeight div 2),
FControl.Width + FOwner.FBoxWidth,
FControl.Height + FOwner.FBoxHeight);
BringToFront;
FControl.Perform(CM_BORDERCHANGED, 0, 0);
FControl.Repaint;
Perform(CM_BORDERCHANGED, 0, 0);
Paint;
end;
procedure TSizeFrame.ControlWindowProc(var Message: TMessage);
begin
if Assigned(FBakWindowProc) then
FBakWindowProc(Message);
case Message.Msg of
WM_PAINT, WM_ENABLE, WM_SETTEXT:
begin
Repaint;
end;
WM_WINDOWPOSCHANGED:
begin
BringToFront;
SetBounds(FControl.Left - (FOwner.FBoxWidth div 2),
FControl.Top - (FOwner.FBoxHeight div 2),
FControl.Width + FOwner.FBoxWidth,
FControl.Height + FOwner.FBoxHeight);
Perform(CM_BORDERCHANGED, 0, 0);
end;
end;
end;
procedure TSizeFrame.Release;
begin
PostMessage(Handle, CM_RELEASE, 0, 0);
end;
function TSizeFrame.GetDragRect: TRect;
begin
if IsRectEmpty(FOldClient) then
Result := Rect(0, 0, 0, 0)
else
Result := FOldClient;
end;
{ TSizeFrames }
function TSizeFrames.AddChild(AChild: TControl): TSizeFrame;
begin
Result := nil;
if (AChild = nil) or (AChild is TSizeFrame) or (IndexOf(AChild) <> -1) then
Exit;
if AChild is TForm then
raise Exception.Create('不能加入Form对象');
Result := TSizeFrame.Create(Self);
FFrameList.Add(Result);
Result.Control := AChild;
Result.FreeNotification(Self);
Result.PopupMenu := FPopupMenu;
Result.SetFocus;
end;
procedure TSizeFrames.Clear;
var
i: Integer;
begin
for i := ChildCount - 1do
wnto 0do
RemoveChild(Children);
FFrameList.Clear;
end;
constructor TSizeFrames.Create(AOwner: TComponent);
begin
inherited;
FFrameList := TList.Create;
//FHintWindow := THintWindow.Create(nil);
//FHintWindow.Visible := False;
FBoxWidth := 5;
FBoxHeight := 5;
FBoxColor := clGray;
FHighLightBoxColor := clBlack;
FLocked := False;
FSnapToGrid := True;
FMoveHotKey := ckCtrl;
FReSizeHotKey := ckShift;
FShowHint := True;
FGridX := 8;
FGridY := 8;
end;
destructor TSizeFrames.Destroy;
begin
FFrameList.Free;
//FHintWindow.Free;
inherited;
end;
function TSizeFrames.GetChildren(index: Integer): TControl;
begin
if (index < FFrameList.Count) and (index >= 0) then
Result := TSizeFrame(FFrameList.Items[index]).FControl
else
Result := nil;
end;
procedure TSizeFrames.KeyDown(var Key: Word;
Shift: TShiftState);
begin
if Assigned(FOnKeyDown) then
FOnKeyDown(Self, Key, Shift);
end;
procedure TSizeFrames.Loaded;
begin
inherited;
end;
procedure TSizeFrames.MouseDown(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin
if Assigned(FOnMouseDown) then
FOnMouseDown(Self, Button, Shift, X, Y);
end;
procedure TSizeFrames.MouseMove(Shift: TShiftState;
X, Y: Integer);
begin
if Assigned(FOnMouseMove) then
FOnMouseMove(Self, Shift, X, Y);
end;
procedure TSizeFrames.MouseUp(Button: TMouseButton;
Shift: TShiftState;
X,
Y: Integer);
begin
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, Button, Shift, X, Y);
end;
procedure TSizeFrames.RemoveChild(nIndex: Integer);
begin
TSizeFrame(FFrameList.Items[nIndex]).Release;
end;
procedure TSizeFrames.RemoveChild(AChild: TControl);
var
ASizeFrame: TSizeFrame;
begin
ASizeFrame := GetSizeFrame(AChild);
if ASizeFrame = nil then
Exit;
ASizeFrame.Release;
end;
function TSizeFrames.GetChildCount: Integer;
begin
Result := FFrameList.Count;
end;
function TSizeFrames.GetSizeFrame(AControl: TControl): TSizeFrame;
var
i: Integer;
begin
Result := nil;
for i := 0 to ChildCount - 1do
begin
if TSizeFrame(FFrameList.Items).FControl = AControl then
begin
Result := TSizeFrame(FFrameList.Items);
Break;
end;
end;
end;
procedure TSizeFrames.DblClick;
begin
inherited;
if Assigned(FOnDblClick) then
FOnDblClick(Self);
end;
procedure TSizeFrames.ShowHintMsg(AHint: string;
X, Y: Integer);
var
pt: TPoint;
begin
if AHint = '' then
begin
FHintWindow.Hide;
Exit;
end;
FHintWindow.Parent := FCurFrame;
if FShowHint and (ChildCount = 1) then
begin
FHintWindow.Caption := AHint;
pt := FCurFrame.ClientToScreen(Point(X, Y));
FHintWindow.Left := pt.X;
FHintWindow.Top := pt.Y;
FHintWindow.Repaint;
FHintWindow.Show;
end else
FHintWindow.Hide;
end;
function TSizeFrames.GetSizeFrames(index: Integer): TSizeFrame;
begin
if (index < FFrameList.Count) and (index >= 0) then
Result := TSizeFrame(FFrameList[index])
else
Result := nil;
end;
procedure TSizeFrames.AlignTo(Side: TSide;
AlignStyle: TAlignStyle);
var
i, nSub: Integer;
AControl: TControl;
begin
if ChildCount < 2 then
Exit;
AControl := GetSideControl(Side);
case Side of
sLeft:
begin
for i := 0 to ChildCount - 1do
begin
nSub := Children.Left - AControl.Left;
if nSub <> 0 then
with Childrendo
Left := Left - nSub;
end;
end;
sRight:
begin
for i := 0 to ChildCount - 1do
begin
nSub := (Children.Left + Children.Width)
- (AControl.Left + AControl.Width);
if nSub <> 0 then
with Childrendo
Left := Left - nSub;
end;
end;
sTop:
begin
for i := 0 to ChildCount - 1do
begin
nSub := Children.Top - AControl.Top;
if nSub <> 0 then
with Childrendo
Top := Top - nSub;
end;
end;
sBottom:
begin
for i := 0 to ChildCount - 1do
begin
nSub := (Children.Top + Children.Height)
- (AControl.Top + AControl.Height);
if nSub <> 0 then
with Childrendo
Top := Top - nSub;
end;
end;
sCenter:
begin
case AlignStyle of
sHorizontal:
begin
for i := 0 to ChildCount - 1do
begin
nSub := (Children.Left + (Children.Width div 2))
- (AControl.Left + (AControl.Width div 2));
if nSub <> 0 then
with Childrendo
Left := Left - nSub;
end;
end;
sVertical:
begin
for i := 0 to ChildCount - 1do
begin
nSub := (Children.Top + (Children.Height div 2))
- (AControl.Top + (AControl.Height div 2));
if nSub <> 0 then
with Childrendo
Top := Top - nSub;
end;
end;
end;
end;
end;
Refresh;
end;
function TSizeFrames.GetNearControl(ChildControl: TControl;
Side: TSide): TControl;
var
i, nDistance: Integer;
begin
Result := nil;
if (ChildCount < 2) or (IndexOf(ChildControl) = -1) then
Exit;
nDistance := 32000;
case Side of
sLeft:
begin
for i := 0 to ChildCount - 1do
begin
if Children = ChildControl then
Continue;
if (Children.Left < ChildControl.Left)
and ((ChildControl.Left - Children.Left) < nDistance) then
begin
nDistance := ChildControl.Left - Children.Left;
Result := Children;
end;
end;
end;
sRight:
begin
for i := 0 to ChildCount - 1do
begin
if Children = ChildControl then
Continue;
if (Children.Left + Children.Width > ChildControl.Left + ChildControl.Width)
and ((Children.Left + Children.Width - ChildControl.Left - ChildControl.Width) < nDistance) then
begin
nDistance := Children.Left + Children.Width - ChildControl.Left - ChildControl.Width;
Result := Children;
end;
end;
end;
sTop:
begin
for i := 0 to ChildCount - 1do
begin
if Children = ChildControl then
Continue;
if (Children.Top < ChildControl.Top)
and ((ChildControl.Top - Children.Top) < nDistance) then
begin
nDistance := ChildControl.Top - Children.Top;
Result := Children;
end;
end;
end;
sBottom:
begin
for i := 0 to ChildCount - 1do
begin
if Children = ChildControl then
Continue;
if (Children.Top + Children.Height > ChildControl.Top + ChildControl.Height)
and ((Children.Top + Children.Height - ChildControl.Top - ChildControl.Height) < nDistance) then
begin
nDistance := Children.Top + Children.Height - ChildControl.Top - ChildControl.Height;
Result := Children;
end;
end;
end;
end;
end;
function TSizeFrames.GetSideControl(Side: TSide): TControl;
var
i: Integer;
AControl: TControl;
begin
Result := nil;
if ChildCount < 1 then
Exit;
AControl := Children[0];
case Side of
sLeft:
begin
for i := 1 to ChildCount - 1do
begin
if Children.Left < AControl.Left then
AControl := Children;
end;
end;
sRight:
begin
for i := 1 to ChildCount - 1do
begin
if (Children.Left + Children.Width)
> (AControl.Left + AControl.Width) then
AControl := Children;
end;
end;
sTop:
begin
for i := 1 to ChildCount - 1do
begin
if Children.Top < AControl.Top then
AControl := Children;
end;
end;
sBottom:
begin
for i := 1 to ChildCount - 1do
begin
if (Children.Top + Children.Height)
> (AControl.Top + AControl.Height) then
AControl := Children;
end;
end;
sCenter: AControl := Children[0];
end;
Result := AControl;
end;
procedure TSizeFrames.SpaceEqu(AlignStyle: TAlignStyle);
var
aControl, bControl, lastControl: TControl;
nAvg, nSpace: Integer;
begin
if ChildCount < 3 then
Exit;
case AlignStyle of
sHorizontal:
begin
aControl := GetSideControl(sLeft);
bControl := GetSideControl(sRight);
nSpace := bControl.Left + bControl.Width - aControl.Left - SumOfChieldWidth;
nAvg := nSpace div (GetChildCount - 1);
if nAvg < 1 then
Exit;
lastControl := aControl;
aControl := GetNearControl(aControl, sRight);
while (aControl <> nil) and (aControl <> bControl)do
begin
aControl.Left := lastControl.Left + lastControl.Width + nAvg;
lastControl := aControl;
aControl := GetNearControl(aControl, sRight);
end;
end;
sVertical:
begin
aControl := GetSideControl(sTop);
bControl := GetSideControl(sBottom);
nSpace := bControl.Top + bControl.Height - aControl.Top - SumOfChieldHeight;
nAvg := nSpace div (GetChildCount - 1);
if nAvg < 1 then
Exit;
lastControl := aControl;
aControl := GetNearControl(aControl, sBottom);
while (aControl <> nil) and (aControl <> bControl)do
begin
aControl.Top := lastControl.Top + lastControl.Height + nAvg;
lastControl := aControl;
aControl := GetNearControl(aControl, sBottom);
end;
end;
end;
Refresh;
end;
function TSizeFrames.SumOfChieldHeight: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to ChildCount - 1do
Result := Result + Children.Height;
end;
function TSizeFrames.SumOfChieldWidth: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to ChildCount - 1do
Result := Result + Children.Width;
end;
procedure TSizeFrames.HeightEqu;
var
i, nHeight: Integer;
begin
if ChildCount < 2 then
Exit;
nHeight := Children[0].Height;
for i := 1 to ChildCount - 1do
begin
Children.Height := nHeight;
end;
Refresh;
end;
procedure TSizeFrames.WidthEqu;
var
i, nWidth: Integer;
begin
if ChildCount < 2 then
Exit;
nWidth := Children[0].Width;
for i := 1 to ChildCount - 1do
begin
Children.Width := nWidth;
end;
Refresh;
end;
procedure TSizeFrames.Refresh;
var
i: Integer;
begin
for i := 0 to ChildCount - 1do
SizeFrames.Refresh;
end;
function TSizeFrames.IndexOf(AChild: TControl): Integer;
begin
for Result := 0 to ChildCount - 1do
if Children[Result] = AChild then
Exit;
Result := -1;
end;
procedure TSizeFrames.Notification(AComponent: TComponent;
Operation: TOperation);
var
i: Integer;
begin
inherited;
if (AComponent = FPopupMenu) and (Operation = opRemove) then
begin
FPopupMenu := nil;
for i := 0 to ChildCount - 1do
SizeFrames.PopupMenu := nil;
end;
if (AComponent is TSizeFrame) and (Operation = opRemove) then
begin
FFrameList.Remove(AComponent);
end;
end;
procedure TSizeFrames.SetPopupMenu(const Value: TPopupMenu);
var
i: Integer;
begin
if Assigned(FPopupMenu) then
FPopupMenu.RemoveFreeNotification(Self);
FPopupMenu := Value;
if Assigned(FPopupMenu) then
FPopupMenu.FreeNotification(Self);
for i := 0 to ChildCount - 1do
SizeFrames.PopupMenu := FPopupMenu;
end;
{ TControlEdit }
procedure TControlEdit.AppEventMessage(var Msg: TMsg;
var Handled: Boolean);
var
AControl: TControl;
CanDo: Boolean;
DC: HDC;
ARect: TRect;
ASizeFrame: TSizeFrame;
WMMouse: TWMMouse;
message: TMessage;
ChangedMsg: TMessage;
//转换消息包的鼠标位置信息，需要发送给子控件
function ChangeMousePos(MsgMouse: TWMMouse;
ScreenPos: TPoint;
NewCtrl: TControl): TMessage;
var
pt: TPoint;
begin
if NewCtrl <> nil then
pt := NewCtrl.ScreenToClient(ScreenPos);
MsgMouse.XPos := pt.X;
MsgMouse.YPos := pt.Y;
Result := TMessage(MsgMouse);
end;
//移除以前选择的控件（判断失去选择的事件）
procedure RemoveSelected;
var
i: Integer;
begin
if Assigned(FOnDisSelect) then
for i := ChildCount - 1do
wnto 0do
begin
FOnDisSelect(FCurFrame.FControl, CanDo);
if CanDo then
RemoveChild(i);
end else
Clear;
end;
//求两点之间的矩形框
function PointToRect(pt1, pt2: TPoint): TRect;
begin
if pt1.X < pt2.X then
begin
Result.Left := pt1.X;
Result.Right := pt2.X;
end else
begin
Result.Left := pt2.X;
Result.Right := pt1.X;
end;
if pt1.Y < pt2.Y then
begin
Result.Top := pt1.Y;
Result.Bottom := pt2.Y;
end else
begin
Result.Top := pt2.Y;
Result.Bottom := pt1.Y;
end;
end;
//选择特定矩形框内的控件
procedure AddRectControl(ARect: TRect);
var
i: Integer;
begin
for i := 0 to FEditControl.ControlCount - 1do
begin
if ControlInRect(FEditControl.Controls, ARect) then
AddChild(FEditControl.Controls);
end;
end;
//根据Handle获得Frame
function GetSizeFrame(AHandel: HWND): TSizeFrame;
var
i: Integer;
begin
Result := nil;
for i := 0 to ChildCount - 1do
if SizeFrames.Handle = AHandel then
begin
Result := SizeFrames;
Break;
end;
end;
begin
if Assigned(FBakAppMsg) then
FBakAppMsg(Msg, Handled);
if Handled or not FEnable then
Exit;
Handled := False;
message.Msg := Msg.message;
message.WParam := Msg.wParam;
message.LParam := Msg.lParam;
case Msg.message of
WM_LBUTTONDOWN:
begin
WMMouse := TWMMouse(message);
CanDo := True;
//初始化原矩形框
FOldRect := Rect(Msg.pt.X, Msg.pt.Y, Msg.pt.X - 1, Msg.pt.Y - 1);
AControl := GetControl(Msg.pt.X, Msg.pt.Y);
//如果不是在FEditControl或者其子控件上点击，则不进行处理
if (not (Msg.hwnd = FEditControl.Handle)
and (AControl = nil))
or (IndexOf(AControl) <> -1) then
Exit;
//如果是在SizeFrame上点击并且在SizeBox上点击时不进行处理
ASizeFrame := GetSizeFrame(Msg.hwnd);
if (ASizeFrame <> nil) and
(ASizeFrame.InSizeBox(FCurFrame.ScreenToClient(Msg.pt)) <> dsMove) then
Exit;
//如果不是在控件上点击清除所有选择,开始拖拽
if AControl = nil then
begin
//只有不处于多选状态时,才清除原来的选择
case FMutiSelKey of
ckCtrl: if GetKeyState(VK_CONTROL) >= 0 then
RemoveSelected;
ckShift: if GetKeyState(VK_SHIFT) >= 0 then
RemoveSelected;
ckAlt: if GetKeyState(VK_MENU) >= 0 then
RemoveSelected;
end;
FDraging := True;
PointStart := Msg.pt;
//屏幕坐标
ARect.TopLeft := FEditControl.ClientToScreen(Point(0, 0));
ARect.BottomRight := FEditControl.ClientToScreen(Point(FEditControl.Width, FEditControl.Height));
ClipCursor(@ARect);
Exit;
end;
case FMutiSelKey of
ckCtrl: if GetKeyState(VK_CONTROL) >= 0 then
RemoveSelected;
ckShift: if GetKeyState(VK_SHIFT) >= 0 then
RemoveSelected;
ckAlt: if GetKeyState(VK_MENU) >= 0 then
RemoveSelected;
else
Exit;
end;
CanDo := True;
if Assigned(FOnSelect) then
FOnSelect(AControl, CanDo);
if not CanDo then
Exit;
ASizeFrame := AddChild(AControl);
//发送单击消息以支持在此次点击后可直接拖拽
ChangedMsg := ChangeMousePos(WMMouse, Msg.pt, ASizeFrame);
ASizeFrame.Perform(ChangedMsg.Msg, ChangedMsg.WParam, ChangedMsg.LParam);
Handled := True;
end;
WM_MOUSEMOVE:
begin
WMMouse := TWMMouse(message);
if FDraging and (Msg.hwnd = FEditControl.Handle) then
begin
PointEnd := Msg.pt;
FNewRect := PointToRect(PointStart, PointEnd);
DC := GetDC(0);
DrawFocusRect(DC, FOldRect);
DrawFocusRect(DC, FNewRect);
ReleaseDC(0, DC);
FOldRect := FNewRect;
end;
end;
WM_LBUTTONUP:
begin
WMMouse := TWMMouse(message);
if FDraging and (Msg.hwnd = FEditControl.Handle) then
begin
FDraging := False;
ClipCursor(nil);
DC := GetDC(0);
DrawFocusRect(DC, FOldRect);
ReleaseDC(0, DC);
CanDo := True;
ARect := PointToRect(FEditControl.ScreenToClient(FOldRect.TopLeft),
FEditControl.ScreenToClient(FOldRect.BottomRight));
if Assigned(FOnDragRect) then
FOnDragRect(ARect, CanDo);
if CanDo then
AddRectControl(FOldRect);
FOldRect := Rect(Msg.pt.X, Msg.pt.Y, Msg.pt.X - 1, Msg.pt.Y - 1);
end;
end;
end;
end;
function TControlEdit.ControlInRect(AControl: TControl;
ARect: TRect): Boolean;
var
ControlRect: TRect;
begin
ControlRect.TopLeft := AControl.ClientToScreen(Point(0, 0));
ControlRect.BottomRight := AControl.ClientToScreen(Point(AControl.Width, AControl.Height));
if IntersectRect(ControlRect, ControlRect, ARect) then
Result := True
else
Result := False;
end;
constructor TControlEdit.Create(AOwner: TComponent);
begin
inherited;
FBakAppMsg := nil;
FEditControl := nil;
FSelectionCount := 0;
FDragThreshold := 3;
FShowHint := False;
FDraging := False;
FEnable := True;
FDelKey := False;
FNewRect := Rect(0, 0, 0, 0);
FOldRect := Rect(0, 0, 0, 0);
if DataFormat = 0 then
DataFormat := RegisterClipboardFormat(PChar('Control Data'));
end;
destructor TControlEdit.Destroy;
begin
inherited;
end;
procedure TControlEdit.DisSelectChild(AControl: TControl);
begin
RemoveChild(AControl);
end;
function TControlEdit.GetControl(X, Y: Integer): TControl;
function GetChildControl(Parent:TWinControl;
nX, nY: Integer): TControl;
var
i: Integer;
pt: TPoint;
AControl: TControl;
begin
Result := nil;
AControl := nil;
if Parent = nil then
Exit;
pt := Parent.ScreenToClient(Point(nX, nY));
with Parentdo
for i := 0 to ControlCount - 1do
begin
if Controls is TSizeFrame then
Continue;
if (pt.X >= Controls.Left)
and (pt.X <= Controls.Left + Controls.Width)
and (pt.Y >= Controls.Top)
and (pt.Y <= Controls.Top + Controls.Height) then
begin
AControl := Controls;
Result := AControl;
end;
end;
if (AControl <> nil) and (AControl is TWinControl) then
begin
AControl := GetChildControl(TWinControl(AControl), X, Y);
if AControl <> nil then
Result := AControl;
end;
end;
begin
Result := GetChildControl(FEditControl, X, Y);
end;
function TControlEdit.GetClicked: TControl;
begin
Result := FCurFrame.FControl;
end;
function TControlEdit.GetControl(AHandel: HWND): TControl;
function GetChildControl(hHandel: HWND;
AParent: TControl): TControl;
var
j: Integer;
begin
Result := nil;
if AParent is TWinControl then
with TWinControl(AParent)do
for j := 0 to ControlCount - 1do
begin
if Result <> nil then
Break;
if (Controls[j] is TWinControl) and not (Controls[j] is TSizeFrame) then
begin
if TWinControl(Controls[j]).Handle = AHandel then
begin
Result := Controls[j];
Break;
end else
if Controls[j] is TCustomCombo//Combo为组合型控件，需特殊处理
and (GetWindow(TWinControl(Controls[j]).Handle, GW_CHILD) = AHandel) then
begin
Result := Controls[j];
Break;
end else
begin
Result := GetChildControl(hHandel, Controls[j]);
end;
end;
end;
end;
begin
Result := GetChildControl(AHandel, FEditControl);
end;
function TControlEdit.GetNearControl(ChildControl: TControl;
Side: TSide): TControl;
var
i, nDistance: Integer;
function IndexOfControl(AControl: TControl): Integer;
var
j: Integer;
begin
Result := -1;
for j := 0 to ChildControl.Parent.ControlCount - 1do
if ChildControl.Parent.Controls[j] = AControl then
begin
Result := j;
Break;
end;
end;
function FilteControls(AControl: TControl;
AlignStyle: TAlignStyle): Boolean;
var
nLow, nHigh: Integer;
begin
if AControl is TSizeFrame then
begin
Result := False;
Exit;
end;
nLow := 0;
nHigh := 0;
Result := True;
case AlignStyle of
sHorizontal:
begin
if ChildControl.Top > AControl.Top then
nLow := ChildControl.Top
else
nLow := AControl.Top;
if ChildControl.Top + ChildControl.Height < AControl.Top + AControl.Height then
nHigh := ChildControl.Top + ChildControl.Height
else
nHigh := AControl.Top + AControl.Height;
end;
sVertical:
begin
if ChildControl.Left > AControl.Left then
nLow := ChildControl.Left
else
nLow := AControl.Left;
if ChildControl.Left + ChildControl.Width < AControl.Left + AControl.Width then
nHigh := ChildControl.Left + ChildControl.Width
else
nHigh := AControl.Left + AControl.Width;
end;
end;
if nLow > nHigh then
Result := False;
end;
begin
Result := nil;
if ChildControl.Parent.ControlCount < 2 then
Exit;
if IndexOfControl(ChildControl) = -1 then
Exit;
nDistance := 32000;
with ChildControl.Parentdo
begin
case Side of
sLeft:
begin
for i := 0 to ControlCount - 1do
begin
if (Controls = ChildControl) or not FilteControls(Controls, sHorizontal) then
Continue;
if (Controls.Left < ChildControl.Left)
and ((ChildControl.Left - Controls.Left) < nDistance) then
begin
nDistance := ChildControl.Left - Controls.Left;
Result := Controls;
end;
end;
end;
sRight:
begin
for i := 0 to ControlCount - 1do
begin
if (Controls = ChildControl) or not FilteControls(Controls, sHorizontal) then
Continue;
if (Controls.Left + Controls.Width > ChildControl.Left + ChildControl.Width)
and ((Controls.Left + Controls.Width - ChildControl.Left - ChildControl.Width) < nDistance) then
begin
nDistance := Controls.Left + Controls.Width - ChildControl.Left - ChildControl.Width;
Result := Controls;
end;
end;
end;
sTop:
begin
for i := 0 to ControlCount - 1do
begin
if (Controls = ChildControl) or not FilteControls(Controls, sVertical) then
Continue;
if (Controls.Top < ChildControl.Top)
and ((ChildControl.Top - Controls.Top) < nDistance) then
begin
nDistance := ChildControl.Top - Controls.Top;
Result := Controls;
end;
end;
end;
sBottom:
begin
for i := 0 to ControlCount - 1do
begin
if (Controls = ChildControl) or not FilteControls(Controls, sVertical) then
Continue;
if (Controls.Top + Controls.Height > ChildControl.Top + ChildControl.Height)
and ((Controls.Top + Controls.Height - ChildControl.Top - ChildControl.Height) < nDistance) then
begin
nDistance := Controls.Top + Controls.Height - ChildControl.Top - ChildControl.Height;
Result := Controls;
end;
end;
end;
end;
end;
end;
function TControlEdit.GetSelected: TControl;
begin
if ChildCount = 1 then
Result := Children[0]
else
Result := nil;
end;
function TControlEdit.GetSelectionCount: Integer;
begin
Result := ChildCount;
end;
function TControlEdit.GetSelections(index: Integer): TControl;
begin
Result := Children[index];
end;
procedure TControlEdit.KeyDown(var key: Word;
Shift: TShiftState);
var
i: Integer;
AControl: TControl;
CanDisSel, CanSel: Boolean;
begin
inherited;
if FDelKey and (Key = VK_DELETE) then
begin
if Assigned(FBeforeDelete) then
FBeforeDelete(Self);
for i := ChildCount - 1do
wnto 0do
begin
SizeFrames.Parent := TControlEdit(Self).FEditControl;
Children.Parent := TControlEdit(Self).FEditControl;
end;
for i := ChildCount - 1do
wnto 0do
Children.Free;
if Assigned(FAfterDelete) then
FAfterDelete(Self);
end;
AControl := nil;
if (ChildCount = 1) and (Shift = []) then
case Key of
VK_UP: AControl := GetNearControl(Selected, sTop);
VK_DOWN: AControl := GetNearControl(Selected, sBottom);
VK_LEFT: AControl := GetNearControl(Selected, sLeft);
VK_RIGHT: AControl := GetNearControl(Selected, sRight);
end;
if AControl <> nil then
begin
CanDisSel := True;
CanSel := True;
if Assigned(FOnDisSelect) then
FOnDisSelect(FCurFrame.FControl, CanDisSel);
if Assigned(FOnSelect) then
FOnSelect(AControl, CanSel);
if CanDisSel and CanSel then
SelectChild(AControl);
end;
if ssCtrl in Shift then
case Key of
VK_PRIOR:
begin
for i := 0 to ChildCount - 1do
Children.BringToFront;
end;
VK_NEXT:
begin
for i := 0 to ChildCount - 1do
Children.SendToBack;
end;
Ord('C'):
begin
if not FCopyPasteKey then
Exit;
CopyToClipboard;
end;
Ord('X'):
begin
if not FCopyPasteKey then
Exit;
CopyToClipboard;
Delse
lected;
end;
Ord('V'):
begin
if not FCopyPasteKey then
Exit;
if ChildCount = 1 then
begin
if Selected is TWinControl then
PraseFromClipboard(TWinControl(Selected))
else
PraseFromClipboard(FEditControl);
end;
end;
end;
end;
procedure TControlEdit.Loaded;
begin
inherited;
end;
procedure TControlEdit.MouseDown(Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin
inherited;
end;
procedure TControlEdit.MouseMove(Shift: TShiftState;
X, Y: Integer);
begin
inherited;
;
end;
procedure TControlEdit.MouseUp(Button: TMouseButton;
Shift: TShiftState;
X,
Y: Integer);
begin
inherited;
end;
procedure TControlEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (AComponent = FEditControl) and (Operation = opRemove) then
FEditControl := nil;
end;
procedure TControlEdit.Delse
lected;
var
i: Integer;
begin
for i := ChildCount - 1do
wnto 0do
begin
SizeFrames.Parent := FEditControl;
Children.Parent := FEditControl;
end;
for i := ChildCount - 1do
wnto 0do
Children.Free;
end;
procedure TControlEdit.SelectChild(AControl: TControl);
begin
if not Assigned(AControl) then
Exit;
Clear;
AddChild(AControl);
end;
procedure TControlEdit.SetEditControl(const Value: TWinControl);
begin
if FEditControl = Value then
Exit;
if not (csDesigning in ComponentState)
and Assigned(FEditControl) then
begin
Application.OnMessage := FBakAppMsg;
FBakAppMsg := nil;
FEditControl.RemoveFreeNotification(Self);
end;
FEditControl := Value;
if csDesigning in ComponentState then
Exit;
if Assigned(FEditControl) then
begin
FEditControl.FreeNotification(Self);
FBakAppMsg := Application.OnMessage;
Application.OnMessage := AppEventMessage;
end else
begin
Application.OnMessage := FBakAppMsg;
FBakAppMsg := nil;
end;
end;
procedure TControlEdit.SetEnable(const Value: Boolean);
begin
FEnable := Value;
if not FEnable then
Clear;
end;
procedure TControlEdit.ChangeParent(AControl: TControl;
NewParent: TWinControl);
begin
if AControl.Left + AControl.Width > NewParent.Width then
AControl.Left := NewParent.Width - AControl.Width;
if AControl.Top + AControl.Height > NewParent.Height then
AControl.Top := NewParent.Height - AControl.Height;
AControl.Parent := NewParent;
end;
function TControlEdit.GetComponentName(OldName, ClassName: string): string;
var
i, ID, NewID: Integer;
NameList: TStringList;
NewName: string;
bFlag: Boolean;
begin
if Owner.FindComponent(OldName) = nil then
Result := OldName
else
begin
NameList := TStringList.Create;
NewName := Copy(ClassName, 2, Length(ClassName) - 1);
for i := 0 to Owner.ComponentCount - 1do
begin
if Pos(NewName, Owner.Components.Name) <> 0 then
NameList.Add(Owner.Components.Name);
end;
NewID := 1;
bFlag := True;
while bFlagdo
begin
bFlag := False;
for i := NameList.Count - 1do
wnto 0do
if TryStrToInt(StringReplace(NameList, NewName, '', [rfReplaceAll]), ID)
and (NewID = ID) then
begin
Inc(NewID);
NameList.Delete(i);
bFlag := True;
end;
end;
NameList.Free;
Result := NewName + IntToStr(NewID);
end;
end;
function TControlEdit.CopyToClipboard: Boolean;
var
hBuf: THandle;
pBuf: Pointer;
ms: TMemoryStream;
AOwner, BakParent: TWinControl;
procedure SetChildOwner(AParent: TWinControl;
TheOwner: TComponent);
var
i: Integer;
begin
for i := 0 to AParent.ControlCount - 1do
begin
if AParent.Controls is TSizeFrame then
Continue;
if AParent.Controls is TWinControl then
SetChildOwner(TWinControl(AParent.Controls), TheOwner);
AParent.Controls.Owner.RemoveComponent(AParent.Controls);
TheOwner.InsertComponent(AParent.Controls);
end;
end;
procedure InitControl(TheOwner: TWinControl);
var
i: Integer;
AControl: TControl;
begin
BakParent := CurFrame.FControl.Parent;
for i := ChildCount - 1do
wnto 0do
begin
if Children.Parent <> BakParent then
begin
RemoveChild(Children);
end else
begin
if Children is TWinControl then
SetChildOwner(TWinControl(Children), TheOwner);
AControl := Children;
AControl.Owner.RemoveComponent(AControl);
TheOwner.InsertComponent(AControl);
AControl.Parent := TheOwner;
end;
end;
end;
procedure RestoreControl(TheOwner: TWinControl);
var
i: Integer;
AControl: TControl;
begin
for i := TheOwner.ComponentCount - 1do
wnto 0do
begin
AControl := TControl(TheOwner.Components);
TheOwner.RemoveComponent(AControl);
BakParent.Owner.InsertComponent(AControl);
if AControl.Parent = TheOwner then
AControl.Parent := BakParent;
end;
end;
begin
hBuf := 0;
ms := TMemoryStream.Create;
AOwner := TWinControl.Create(nil);
AOwner.Name := PRASE_FLAG;
AOwner.Parent := FEditControl;
try
InitControl(AOwner);
ms.WriteComponent(AOwner);
RestoreControl(AOwner);
try
hBuf := GlobalAlloc(GMEM_MOVEABLE, ms.Size);
try
pBuf := GlobalLock(hBuf);
Move(ms.Memory^, pBuf^, ms.Size);
Clipboard.SetAsHandle(DataFormat, hBuf);
finally
GlobalUnlock(hbuf);
end;
except
GlobalFree(hbuf);
end;
finally
AOwner.Free;
ms.Free;
end;
Result := True;
end;
function TControlEdit.PraseFromClipboard(AParent: TWinControl): Boolean;
var
hBuf: THandle;
pBuf: Pointer;
ms: TMemoryStream;
AOwner: TWinControl;
procedure FinalControl(TheOwner: TWinControl);
var
i: Integer;
AControl: TControl;
begin
Clear;
for i := TheOwner.ComponentCount - 1do
wnto 0do
begin
AControl := TControl(TheOwner.Components);
TheOwner.RemoveComponent(AControl);
AControl.Name := GetComponentName(AControl.Name, AControl.ClassName);
AParent.Owner.InsertComponent(AControl);
if AControl.Parent = TheOwner then
begin
ChangeParent(AControl, AParent);
AddChild(AControl);
end;
end;
end;
begin
Result := False;
hBuf := Clipboard.GetAsHandle(DataFormat);
if hBuf = 0 then
Exit;
pBuf := GlobalLock(hBuf);
if pBuf = nil then
begin
GlobalUnlock(hBuf);
Exit;
end;
AOwner := TWinControl.Create(nil);
AOwner.Parent := FEditControl;
ms := TMemoryStream.Create;
try
ms.WriteBuffer(pBuf^, GlobalSize(hbuf));
ms.Position := 0;
ms.ReadComponent(AOwner);
FinalControl(AOwner);
finally
AOwner.Free;
ms.Free;
GlobalUnlock(hBuf);
end;
Result := True;
end;
procedure TControlEdit.RegChildClass;
procedure RegisterChildrenClass(AParent: TWinControl);
var
i: Integer;
begin
if AParent = nil then
Exit;
for i := 0 to AParent.ControlCount - 1do
begin
RegisterClass(TPersistentClass(AParent.Controls.ClassType));
if AParent.Controls is TWinControl then
RegisterChildrenClass(TWinControl(AParent.Controls));
end;
end;
begin
RegisterChildrenClass(TWinControl(FEditControl));
end;
function TControlEdit.GetDragRect: TRect;
begin
if IsRectEmpty(FOldRect) then
Result := Rect(0, 0, 0, 0)
else
Result := FOldRect;
end;
end.
