W
wr960204
Unregistered / Unconfirmed
GUEST, unregistred user!
{ *********************************************************************** }
{ 单元名称:UnitMyControl }
{ 功能:运行时可调整的控件的祖先类 }
{ }
{ wr960204 王锐 2002-2-1 }
{ }
{ *********************************************************************** }
unit UnitMyControl;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMyControl = class(TWinControl)
private
FPrecision: Integer;
FCanvas: TCanvas;
procedure WMMouseMove(var Message: TWMMouseMove);
message WM_MOUSEMOVE;
procedure WMPaint(var Message: TWMPaint);
message WM_PAINT;
public
property Precision: Integer read FPrecision write FPrecision;
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
end;
implementation
{ TMyControl }
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
FPrecision := 4;
end;
destructor TMyControl.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;
procedure TMyControl.WMMouseMove(var Message: TWMMouseMove);
var
SC_MANIPULATE : Word;
X, Y : Integer;
Shift : TShiftState;
begin
X := Message.XPos;
Y := Message.YPos;
Shift := KeysToShiftState(Message.Keys);
//光标在控件的最左侧****************
if (X <= FPrecision) and (Y > (Self.Height - FPrecision) div 2) and
(Y < (Self.Height + FPrecision) div 2) then
begin
SC_MANIPULATE := $F001;
Self.Cursor := crSizeWE;
end
//光标在控件的最右侧****************
else
if (X >= Self.Width - FPrecision) and (Y > (Self.Height - FPrecision) div 2)
and
(Y < (Self.Height + FPrecision) div 2) then
begin
SC_MANIPULATE := $F002;
Self.Cursor := crSizeWE;
end
//光标在控件的最上侧****************
else
if (X > (Self.Width - FPrecision) div 2) and (X < (Self.Width +
FPrecision) div 2) and (Y <= FPrecision) then
begin
SC_MANIPULATE := $F003;
Self.Cursor := crSizeNS;
end
//光标在控件的左上角****************
else
if (X <= FPrecision) and (Y <= FPrecision) then
begin
SC_MANIPULATE := $F004;
Self.Cursor := crSizeNWSE;
end
//光标在控件的右上角****************
else
if (X >= Self.Width - FPrecision) and (Y <= FPrecision) then
begin
SC_MANIPULATE := $F005;
Self.Cursor := crSizeNESW;
end
//光标在控件的最下侧****************
else
if (X > (Self.Width - FPrecision) div 2) and (X < (Self.Width +
FPrecision) div 2) and (Y >= Self.Height - FPrecision) then
begin
SC_MANIPULATE := $F006;
Self.Cursor := crSizeNS;
end
//光标在控件的左下角
else
if (X <= FPrecision) and (Y >= Self.Height - FPrecision) then
begin
SC_MANIPULATE := $F007;
Self.Cursor := crSizeNESW;
end
//光标在控件的右下角
else
if (X >= Self.Width - FPrecision) and
(Y >= Self.Height - FPrecision) then
begin
SC_MANIPULATE := $F008;
Self.Cursor := crSizeNWSE;
end
//光标在控件的客户区(移动整个控件)
else
if (X > 5) and (Y > 5) and (X < Self.Width - 5)
and (Y < Self.Height - 5) then
begin
SC_MANIPULATE := $F009;
Self.Cursor := crSizeAll;
end
else
begin
SC_MANIPULATE := $F000;
Self.Cursor := crDefault;
end;
if Shift = [ssLeft] then
begin
ReleaseCapture;
Self.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
end;
inherited;
end;
procedure TMyControl.WMPaint(var Message: TWMPaint);
const
do
tHeigh = 4;
var
OldColor : TColor;
do
t : TRect;
begin
inherited;
//画出边角的小黑点
OldColor := FCanvas.Brush.Color;
FCanvas.Brush.Color := clBlack;
do
t := Bounds(0, 0,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds(0, (Self.Height -do
tHeigh) div 2,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh) div 2, 0,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh), (Self.Height -do
tHeigh),do
tHeigh,
do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh) div 2, (Self.Height -do
tHeigh),
do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh), (Self.Height -do
tHeigh) div 2,
do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh), 0,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds(0, (Self.Height -do
tHeigh),do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
FCanvas.Brush.Color := OldColor;
end;
end.
{ 单元名称:UnitMyControl }
{ 功能:运行时可调整的控件的祖先类 }
{ }
{ wr960204 王锐 2002-2-1 }
{ }
{ *********************************************************************** }
unit UnitMyControl;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMyControl = class(TWinControl)
private
FPrecision: Integer;
FCanvas: TCanvas;
procedure WMMouseMove(var Message: TWMMouseMove);
message WM_MOUSEMOVE;
procedure WMPaint(var Message: TWMPaint);
message WM_PAINT;
public
property Precision: Integer read FPrecision write FPrecision;
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
end;
implementation
{ TMyControl }
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
FPrecision := 4;
end;
destructor TMyControl.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;
procedure TMyControl.WMMouseMove(var Message: TWMMouseMove);
var
SC_MANIPULATE : Word;
X, Y : Integer;
Shift : TShiftState;
begin
X := Message.XPos;
Y := Message.YPos;
Shift := KeysToShiftState(Message.Keys);
//光标在控件的最左侧****************
if (X <= FPrecision) and (Y > (Self.Height - FPrecision) div 2) and
(Y < (Self.Height + FPrecision) div 2) then
begin
SC_MANIPULATE := $F001;
Self.Cursor := crSizeWE;
end
//光标在控件的最右侧****************
else
if (X >= Self.Width - FPrecision) and (Y > (Self.Height - FPrecision) div 2)
and
(Y < (Self.Height + FPrecision) div 2) then
begin
SC_MANIPULATE := $F002;
Self.Cursor := crSizeWE;
end
//光标在控件的最上侧****************
else
if (X > (Self.Width - FPrecision) div 2) and (X < (Self.Width +
FPrecision) div 2) and (Y <= FPrecision) then
begin
SC_MANIPULATE := $F003;
Self.Cursor := crSizeNS;
end
//光标在控件的左上角****************
else
if (X <= FPrecision) and (Y <= FPrecision) then
begin
SC_MANIPULATE := $F004;
Self.Cursor := crSizeNWSE;
end
//光标在控件的右上角****************
else
if (X >= Self.Width - FPrecision) and (Y <= FPrecision) then
begin
SC_MANIPULATE := $F005;
Self.Cursor := crSizeNESW;
end
//光标在控件的最下侧****************
else
if (X > (Self.Width - FPrecision) div 2) and (X < (Self.Width +
FPrecision) div 2) and (Y >= Self.Height - FPrecision) then
begin
SC_MANIPULATE := $F006;
Self.Cursor := crSizeNS;
end
//光标在控件的左下角
else
if (X <= FPrecision) and (Y >= Self.Height - FPrecision) then
begin
SC_MANIPULATE := $F007;
Self.Cursor := crSizeNESW;
end
//光标在控件的右下角
else
if (X >= Self.Width - FPrecision) and
(Y >= Self.Height - FPrecision) then
begin
SC_MANIPULATE := $F008;
Self.Cursor := crSizeNWSE;
end
//光标在控件的客户区(移动整个控件)
else
if (X > 5) and (Y > 5) and (X < Self.Width - 5)
and (Y < Self.Height - 5) then
begin
SC_MANIPULATE := $F009;
Self.Cursor := crSizeAll;
end
else
begin
SC_MANIPULATE := $F000;
Self.Cursor := crDefault;
end;
if Shift = [ssLeft] then
begin
ReleaseCapture;
Self.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
end;
inherited;
end;
procedure TMyControl.WMPaint(var Message: TWMPaint);
const
do
tHeigh = 4;
var
OldColor : TColor;
do
t : TRect;
begin
inherited;
//画出边角的小黑点
OldColor := FCanvas.Brush.Color;
FCanvas.Brush.Color := clBlack;
do
t := Bounds(0, 0,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds(0, (Self.Height -do
tHeigh) div 2,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh) div 2, 0,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh), (Self.Height -do
tHeigh),do
tHeigh,
do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh) div 2, (Self.Height -do
tHeigh),
do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh), (Self.Height -do
tHeigh) div 2,
do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds((Self.Width -do
tHeigh), 0,do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
do
t := Bounds(0, (Self.Height -do
tHeigh),do
tHeigh,do
tHeigh);
FCanvas.Rectangle(Dot);
FCanvas.Brush.Color := OldColor;
end;
end.