?? dsnhandle.pas
字號:
unit DsnHandle;
// Runtime Design System Version 2.x June/08/1998
// Copyright(c) 1998 Kazuhiro Sasaki.
interface
uses
Windows, Classes, Forms, Controls, Messages, Dialogs, Graphics,
StdCtrls, DsnShape, DsnList, DsnMes;
type
THandlerRect = class;
TMultiHandler = class(TReceiveTargets)
protected
FList: TList;
function CreateHandlerRect(Control:TControl):THandlerRect;virtual;
public
Size: Integer;
CutSizeX:Integer;
CutSizeY:Integer;
ColorSingle: TColor;
ColorMulti: TColor;
Color: TColor;
PenWidth:Integer;
constructor Create; virtual;
destructor Destroy; override;
procedure ItemDeath(Index:Integer); override;
procedure Add(Item:Pointer);override;
procedure Clear; override;
procedure Delete(Index:Integer); override;
procedure SetPosition; override;
end;
THandlerRect = class
private
ChildDeth:Boolean;
protected
SmallRects: TList;
SWidth: Integer;
SHeight: Integer;
SLeft: Integer;
STop: Integer;
procedure CreateSmallRect;virtual;
procedure SetControl;virtual;
public
Control:TControl;
Size: Integer;
CutSizeX:Integer;
CutSizeY:Integer;
ColorSingle: TColor;
ColorMulti: TColor;
Color: TColor;
PenWidth:Integer;
constructor Create(AControl:TControl;ASize,ACutSizeX,ACutSizeY,APenWidth:Integer;clMulti,clSingle,ShapeColor:TColor);
destructor Destroy; override;
procedure ChangeColorMulti;
end;
TSmallRect = class(TCustomControl)
private
HandlerRect: THandlerRect;
protected
FShape: TMultiShape;
FX: Integer;
FY: Integer;
procedure Cutting(var X, Y: Integer);
function CreateRectShape:TMultiShape;virtual;
public
Control:TControl;
Size: Integer;
CutSizeX:Integer;
CutSizeY:Integer;
ColorSingle: TColor;
ColorMulti: TColor;
ShapeColor: TColor;
PenWidth:Integer;
constructor Create2(AControl:TControl;ASize,ACutSizeX,ACutSizeY:Integer;clMulti,clSingle:TColor);
destructor Destroy; override;
procedure SetControl; virtual; abstract;
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
procedure ChangeColorMulti;
end;
TMigiueRect = class(TSmallRect)
public
procedure SetControl;override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
end;
TMigishitaRect = class(TSmallRect)
public
procedure SetControl;override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
end;
THidariueRect = class(TSmallRect)
public
procedure SetControl;override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
end;
THidarishitaRect = class(TSmallRect)
public
procedure SetControl;override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);override;
end;
implementation
{TMultiHandler}
constructor TMultiHandler.Create;
begin
Size:= 6;
CutSizeX:= 6;
CutSizeY:= 6;
PenWidth:= 2;
ColorSingle:= clBlack;
ColorMulti:= clGray;
Color:= clGray;
end;
destructor TMultiHandler.Destroy;
var
i:integer;
begin
if Assigned(FList) then
begin
for i:= 0 to FList.Count -1 do
THandlerRect(FList[i]).Free;
FList.Free;
end;
inherited Destroy;
end;
procedure TMultiHandler.ItemDeath(Index:Integer);
var
i:integer;
begin
if Assigned(FList) then
begin
THandlerRect(FList[Index]).Control:= nil;
if Assigned(THandlerRect(FList[Index]).SmallRects) then
for i:= 0 to THandlerRect(FList[Index]).SmallRects.Count -1 do
TSmallRect(THandlerRect(FList[Index]).SmallRects[i]).Control:= nil;
end;
end;
procedure TMultiHandler.Clear;
var
i:integer;
begin
if Assigned(FList) then
begin
for i:= 0 to FList.Count -1 do
THandlerRect(FList[i]).Free;
FList.Free;
FList:= nil;
end;
end;
procedure TMultiHandler.Delete(Index:Integer);
var
H:Integer;
P:Pointer;
begin
if Assigned(FList) then
begin
THandlerRect(FList[Index]).Free;
FList.Delete(Index);
if FList.Count = 1 then
begin
H:= 0;
try
if THandlerRect(FList[0]).Control is TWinControl then
H:= TWinControl(THandlerRect(FList[0]).Control).Handle
else
H:= THandlerRect(FList[0]).Control.Parent.Handle;
except
end;
if H > 0 then
begin
P:= THandlerRect(FList[0]).Control;
THandlerRect(FList[0]).Free;
FList.Free;
FList:= nil;
Add(TControl(P));
end;
end;
end;
end;
function TMultiHandler.CreateHandlerRect(Control:TControl):THandlerRect;
begin
Result:= THandlerRect.Create(Control,Size,CutSizeX,CutSizeY,PenWidth,ColorMulti,ColorSingle,Color);
end;
procedure TMultiHandler.Add(Item:Pointer);
var
HandlerRect: THandlerRect;
i:integer;
Control:TControl;
begin
Control:= TControl(Item);
if (Control = nil) or (Control is TSmallRect) then
Exit;
if FList = nil then
FList:= TList.Create;
for i:= 0 to FList.Count -1 do
if THandlerRect(FList[i]).Control = Control then
Exit;
HandlerRect:= CreateHandlerRect(Control);
FList.Add(HandlerRect);
if FList.Count = 2 then
THandlerRect(FList[0]).ChangeColorMulti;
if FList.Count > 1 then
HandlerRect.ChangeColorMulti;
if Control is TWinControl then
SendMessage(TWinControl(Control).Handle,MH_SELECT,MakeLong(HandlerRect.SLeft,HandlerRect.STop),MakeLong(HandlerRect.SWidth,HandlerRect.SHeight))
else
SendMessage(Control.Parent.Handle,MH_SELECT,MakeLong(HandlerRect.SLeft,HandlerRect.STop),MakeLong(HandlerRect.SWidth,HandlerRect.SHeight));
end;
procedure TMultiHandler.SetPosition;
var
i:integer;
begin
if Assigned(FList) then
for i:= 0 to FList.Count -1 do
THandlerRect(FList[i]).SetControl;
end;
{THandlerRect}
constructor THandlerRect.Create(AControl:TControl;ASize,ACutSizeX,ACutSizeY,APenWidth:Integer;clMulti,clSingle,ShapeColor:TColor);
var
i:integer;
begin
Size:= ASize;
Control:= AControl;
ColorMulti:= clMulti;
ColorSingle:= clSingle;
CutSizeX:= ACutSizeX;
CutSizeY:= ACutSizeY;
Color:= ShapeColor;
PenWidth:= APenWidth;
ChildDeth:= False;
SmallRects:= TList.Create;
CreateSmallRect;
for i:= 0 to SmallRects.Count -1 do
begin
TSmallRect(SmallRects[i]).Parent:= AControl.Parent;
TSmallRect(SmallRects[i]).HandlerRect:= Self;
TSmallRect(SmallRects[i]).ShapeColor:= ShapeColor;
TSmallRect(SmallRects[i]).PenWidth:= PenWidth;
end;
end;
procedure THandlerRect.CreateSmallRect;
var
SmallRect:TSmallRect;
begin
if Assigned(SmallRects) then
begin
SmallRect:= TMigishitaRect.Create2(Control,Size,CutSizeX,CutSizeY,ColorMulti,ColorSingle);
SmallRects.Add(SmallRect);
SmallRect:= TMigiueRect.Create2(Control,Size,CutSizeX,CutSizeY,ColorMulti,ColorSingle);
SmallRects.Add(SmallRect);
SmallRect:= THidariueRect.Create2(Control,Size,CutSizeX,CutSizeY,ColorMulti,ColorSingle);
SmallRects.Add(SmallRect);
SmallRect:= THidarishitaRect.Create2(Control,Size,CutSizeX,CutSizeY,ColorMulti,ColorSingle);
SmallRects.Add(SmallRect);
end;
end;
destructor THandlerRect.Destroy;
var
i:integer;
begin
if Assigned(SmallRects) then
begin
if not ChildDeth then
for i:= 0 to SmallRects.Count -1 do
TSmallRect(SmallRects[i]).Free;
SmallRects.Free;
end;
inherited Destroy;
end;
procedure THandlerRect.SetControl;
var
i:integer;
begin
for i:= 0 to SmallRects.Count -1 do
if not ChildDeth then
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -