tsize.pas

一个关于delphi控件

unit TSize;

interface
uses
  Windows,
  Messages,
  SysUtils,
  DsgnIntf,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  typinfo;
const sc_DragMove:Longint =$F012;

type
  TDdhSizerControl = class(TCustomControl)
private
  FControl:TControl;//Tcontrol
  FRectList: array[1..8] of TRect;
  FPosList:  array [1..8] of Integer;
  Fflag:^Boolean;
public
  constructor Create ( AOwner:  TComponent;
    AControl:TControl;var flag:Boolean);       //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 SizerControlExit ( Sender: TObject);
end;



implementation

constructor  TDdhSizerControl.Create(AOwner: TComponent;  AControl: TControl; var flag:Boolean); //Tcontrol
var
 R:TRect;
begin
   inherited Create (AOwner);
   Fflag:=@flag;
   Fflag^:=true;
   FControl :=AControl;
   OnExit:=SizerControlExit;
   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 TDdhSizerControl.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle:=Params.ExStyle  +  ws_ex_Transparent;
end;

procedure  TDdhSizerControl.CreateHandle;
begin

  inherited CreateHandle;
  SetFocus;

end;

procedure TDdhSizerControl.SizerControlExit(Sender:TObject);
begin
  Fflag^:=false;
  Free;
  self:=nil;
end;

procedure TDdhSizerControl.WmSize( var Msg:TWmSize);
var
 R:TRect;
begin

  R:=BoundsRect;
  InflateRect(R, -2 ,-2);
  FControl.BoundsRect:=R;

   R:=FControl.BoundsRect;
   InflateRect(R,2,2);
   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 TDdhSizerControl.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 TDdhSizerControl.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 TDdhSizerControl.WmLButtonDown(var Msg:TWmLButtonDown);
begin
  Perform(wm_SysCommand, sc_DragMove, 0);
end;

procedure TDdhSizerControl.WmMove(var Msg:TWmMove);
var
 R:TRect;
begin
  R:=BoundsRect;
  InflateRect(R, -2, -2);
  FControl.Invalidate;
  FControl.BoundsRect:=R;
end;





end.