以下直接加入你的程序就可以啦, 调用方法 var SizeControl: TSizerControl; SizeControl := TSizerControl.Create(self, sender as TLabel); //改变控件位置及大小 unit SizerControl; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TSizerControl = class(TCustomControl) private FControl: TControl; FRectList: Array [1..8] of TRect; FPosList: Array [1..8] of Integer; { Private declarations } protected { Protected declarations } 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 SizeControlExit(Sender: TObject); { Public declarations } published { Published declarations } end; const sc_DragMove: Longint = $F012; procedure Register; implementation uses djtool; constructor TSizerControl.Create(AOwner: TComponent; AControl: TControl); var R: TRect; begin inherited Create(AOwner); FControl := AControl; OnExit := SizeControlExit; 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 TSizerControl.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); //增加透明特性 Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT; end; procedure TSizerControl.Createhandle; begin inherited Createhandle; SetFocus; end; procedure TSizerControl.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 TSizerControl.WmSize(var Msg:TWmSize); var R: TRect; begin R := BoundsRect; InflateRect( R, -2, -2); FControl.BoundsRect := R; //计算8个黑方框 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); //-------------------------added by guozhaofeng 以下部分用于变动时实时显示高度和宽度 // djtool.EdtWit.Text:=templen; // Edtlen.Text:=inttostr(Width); end; procedure TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown); begin //执行拖动命令 Perform(Wm_SysCommand, sc_DragMove, 0); end; procedure TSizerControl.WmMove(var Msg: TWmMove); var R: TRect; begin R := BoundsRect; InflateRect( R, -2, -2); FControl.Invalidate; FControl.BoundsRect := R; end; procedure TSizerControl.Paint; var I: Integer; begin Canvas.Brush.Color := clBlack; for I := 1 to 8 do with FRectList[I] do Canvas.Rectangle (Left, Top, Right, Bottom); end; procedure TSizerControl.SizeControlExit(Sender: TObject); begin Free; end; procedure Register; begin RegisterNoicon([TSizerControl]); end; end.
时间: 2024-11-12 00:42:21