안녕하세요. 최용일입니다.



소스입니다. TComponent에서 파생된 모든 객체에 크기조절과 이동을 할 수 있습니다.



몇가지 불완전한 부분은 처리를 해주세요.



unit CtrlSize;



interface



uses

Classes, Windows, Messages, Controls, StdCtrls;



const

sc_DragMove: Longint = $F012;



type

TControlSizer = class(TCustomControl)

private

FControl: TControl;

FRectList: array [1..8] of TRect;

FPosList: array [1..8] of Integer;

public

constructor Create(AOwner: TComponent; AControl: TControl);

procedure CreateParams(var Params: TCreateParams); override;

procedure CreateHandle; override;

procedure WmNcHitTest(var Msg: TWmNcHitTest); message WM_NCHITTEST;

procedure WmSize(var Msg: TWmSize); message WM_SIZE;

procedure WmLButtonDown(var Msg: TWmLButtonDown); message WM_LBUTTONDOWN;

procedure WmMove(var Msg: TWmMove); message WM_MOVE;

procedure Paint; override;

procedure ControlSizerExit(Sender: TObject);

end;



implementation



uses Graphics;



constructor TControlSizer.Create(AOwner: TComponent; AControl: TControl);

var

R: TRect;

begin

inherited Create(AOwner);

FControl := AControl;



OnExit := ControlSizerExit;



R := FControl.BoundsRect;

InflateRect(R, 2, 2);

BoundsRect := R;



Parent := FControl.Parent;



FPosList [1] := htTopLeft;

FPosList [2] := htTop;

FPosList [3] := htTopRight;

FPosList [4] := htRight;

FPosList [5] := htBottomRight;

FPosList [6] := htBottom;

FPosList [7] := htBottomLeft;

FPosList [8] := htLeft;

end;



procedure TControlSizer.CreateHandle;

begin

inherited CreateHandle;

SetFocus;

end;



procedure TControlSizer.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

Params.ExStyle := Params.ExStyle + ws_ex_Transparent;

end;



procedure TControlSizer.Paint;

var

I: Integer;

begin

Canvas.Brush.Color := clBlack;

for I := 1 to 8 do

Canvas.Rectangle(FRectList [I].Left, FRectList [I].Top,

FRectList [I].Right, FRectList [I].Bottom);

end;



procedure TControlSizer.WmNcHitTest(var Msg: TWmNcHitTest);

var

Pt: TPoint;

I: Integer;

begin

Pt := Point(Msg.XPos, Msg.YPos);

Pt := ScreenToClient(Pt);

Msg.Result := 0;

for I := 1 to 8 do

if PtInRect(FRectList [I], Pt) then

Msg.Result := FPosList [I];



if Msg.Result = 0 then

inherited;

end;



procedure TControlSizer.WmSize(var Msg: TWmSize);

var

R: TRect;

begin

R := BoundsRect;

InflateRect(R, -2, -2);

FControl.BoundsRect := R;



FRectList [1] := Rect(0, 0, 5, 5);

FRectList [2] := Rect(Width div 2 - 3, 0,

Width div 2 + 2, 5);

FRectList [3] := Rect(Width - 5, 0, Width, 5);

FRectList [4] := Rect(Width - 5, Height div 2 - 3,

Width, Height div 2 + 2);

FRectList [5] := Rect(Width - 5, Height - 5,

Width, Height);

FRectList [6] := Rect(Width div 2 - 3, Height - 5,

Width div 2 + 2, Height);

FRectList [7] := Rect(0, Height - 5, 5, Height);

FRectList [8] := Rect(0, Height div 2 - 3,

5, Height div 2 + 2);

end;



procedure TControlSizer.ControlSizerExit(Sender: TObject);

begin

Free;

end;



procedure TControlSizer.WmLButtonDown(var Msg: TWmLButtonDown);

begin

Perform(wm_SysCommand, sc_DragMove, 0);

end;



procedure TControlSizer.WmMove(var Msg: TWmMove);

var

R: TRect;

begin

R := BoundsRect;

InflateRect(R, -2, -2);

FControl.Invalidate;

FControl.BoundsRect := R;

end;



end.

홍세비 wrote:

> 안녕하세요. 홍세빕니다.

>

> 런타임시에 컨트롤을 움직이는 방법은 여러가지가 있더군요.

> 그런데 델파이 IDE에서 폼을 디자인할때처럼 컨트롤을 움직일때 그 컨트롤의

> 테투리를 자연스럽게 표시하고 싶습니다.

> 깜박거림이 없이요.

>

> 핸들이 없는 라벨컴포넌트 등도 적용될 수 있는 방법을 부탁드립니다.

>

> 혹시 방법을 아시는 고수님의 답변을 기다립니다.

>

> 그럼 즐거운 휴일되시길....