研究心得------->开发一个可以在运行时调整的控件 (0分)

  • 主题发起人 wr960204
  • 开始时间
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.
 
弓虽
Thank you!
 
强悍阿,看不懂
 

Similar threads

I
回复
0
查看
540
import
I
I
回复
0
查看
577
import
I
I
回复
0
查看
822
import
I
I
回复
0
查看
405
import
I
I
回复
0
查看
608
import
I
顶部