?? dsnunit.pas
字號:
begin
if Agent.AgentList = nil then
Agent.AgentList:= TAgentList.Create;
Agent.AgentList.Add(AHandle);
BList:= TChildList.Create(nil,AHandle);
for j:= 0 to BList.Count -1 do
ProcB(BList[j].Handle, Agent);
BList.Free;
end;
begin
CanCover:= caAllAccept;
if Assigned(FDsnStage.OnCoverQuery) then
FDsnStage.OnCoverQuery(FDsnStage, AAParent, CanCover);
if CanCover = caAllAccept then
begin
DsnCtrl:= CreateSubCtrl(AAParent);
FDsnCtrlList.Add(DsnCtrl);
DsnCtrl.FDsnRegister:= Self;
end;
if not (CanCover = caNoAccept) then
begin
List:= TChildList.Create(AAParent,AAParent.Handle);
for i:= 0 to List.Count -1 do
begin
if List[i].Instance <> nil then
if List[i].Instance.Owner <> FDsnStage.Owner then
ProcB(List[i].Handle,DsnCtrl) // For Like Spinedit
else
ProcA(List[i].Instance);
if List[i].Instance = nil then
ProcB(List[i].Handle,DsnCtrl) // For Like Combobox
end;
List.Free;
end
end;
begin
ProcA(AParent);
end;
procedure TDsnRegister.CreateSubClass;
begin
if FDsnCtrlList = nil then
FDsnCtrlList:= CreateDsnList;
SetSubClass(FDsnStage);
end;
procedure TDsnRegister.CreateContextMenu;
var
i:integer;
CoverMenu:TPopupMenu;
Item:TMenuItem;
begin
if not Assigned(FDsnStage) then
Exit;
if (not Assigned(FDsnStage.CoverMenu)) and (FDsnStage.SelfProps.Count = 0) then
Exit;
FContextMenu:= TPopupMenu.Create(Owner);
FContextMenu.OnPopup:= FDsnStage.CoverMenu.OnPopup;
// Copy from CoverMenu
if Assigned(FDsnStage.CoverMenu) then
if Assigned(FDsnStage.CoverMenu) then
begin
CoverMenu:= FDsnStage.CoverMenu;
for i:= CoverMenu.Items.Count -1 downto 0 do
begin
{Item:= TMenuItem.Create(Owner);
Item.Caption:= CoverMenu.Items[i].Caption;
Item.OnClick:= CoverMenu.Items[i].OnClick;}
Item:= CoverMenu.Items[i];
CoverMenu.Items.Remove(Item);
FContextMenu.Items.Insert(0,Item);
end;
end;
//Input Fixed Items Count on Tag
FContextMenu.Tag:= FContextMenu.Items.Count;
end;
procedure TDsnRegister.MenuMethod(Sender:TObject);
var
Item:TDsnMenuItem;
Targets:TSelectedComponents;
begin
Item:= TDsnMenuItem(Sender);
if Assigned(FDsnStage) then
if Assigned(FDsnStage.OnMenuClick) then
begin
Targets:=TSelectedComponents.Create;
Targets.AssignList(FTargetList.List);
FDsnStage.OnMenuClick(FDsnStage,Targets,
Item.PropName,Item.Value);
SetProp(FTargetList.List,Item.PropName,Item.Value);
FTargetList.SetPosition;
Targets.Free;
end;
end;
function TDsnRegister.CreateSubCtrl(AParent:TWinControl):TDsnCtrl;
begin
Result:= TDsnCtrl.CreateInstance(AParent);
end;
procedure TDsnRegister.DestroySubClass;
var
i: integer;
begin
if Assigned(FDsnCtrlList) then
for i:= 0 to FDsnCtrlList.Count -1 do
TDsnCtrl(FDsnCtrlList[i]).Free;
FDsnCtrlList.Clear;
end;
procedure TDsnRegister.SelectByInspect(Control:TControl);
begin
if not Assigned(FTargetList) then
FTargetList:= CreateList;
FTargetList.Clear;
FTargetList.Add(Control);
FTargetList.SetPosition;
end;
procedure TDsnRegister.MouseDown(Client:TWinControl; Target:TComponent; MousePoint:TPoint; Shift: TShiftState);
var
Template:TControl;
begin
Template:= nil;
if Assigned(FDsnPanel) then
Template:= TControl(FDsnPanel.GetTemplate);
if Assigned(Template) then
MouseDownCreate(Client,Target,MousePoint,Shift)
else
MouseDownMove(Client,Target,MousePoint,Shift);
end;
procedure TDsnRegister.MouseDownMove(Client:TWinControl; Target:TComponent; MousePoint:TPoint; Shift: TShiftState);
var
n,i: integer;
CanSelect: TSelectAccept;
begin
CanSelect:= [saCreate, saMove];
if Assigned(FDsnStage) then
if Assigned(FDsnStage.OnSelectQuery) then
FDsnStage.OnSelectQuery(FDsnStage, Target, CanSelect);
if saMove in CanSelect then
begin
if Client = Target then
FParentCtrl:= Client.Parent
else
FParentCtrl:= Client;
if FTargetList = nil then
FTargetList:= CreateList;
n:= FTargetList.Count;
if n > 0 then
begin
n:= FTargetList.IndexOf(Target);
if (n = -1) or not SameParent then
begin
FTargetList.Clear;
FTargetList.Add(Target);
end;
end
else
begin
FTargetList.Add(Target);
end;
if Assigned(Target) then
begin
if SameParent then
begin
//Application.ProcessMessages;
CreateMoveShape;
FShape.Color:= Color;
FShape.PenWidth:= PenWidth;
Cutting(MousePoint.x,MousePoint.y);
FX:= MousePoint.x;
FY:= MousePoint.y;
MousePoint:= FParentCtrl.ClientToScreen(MousePoint);
FShape.Point:= MousePoint;
for i:= 0 to FTargetList.Count -1 do
FShape.Add(FTargetList[i]);
FShape.DrowOn(FParentCtrl);
end;
end;
end;
end;
procedure TDsnRegister.MouseDownCreate(Client:TWinControl; Target:TComponent; MousePoint:TPoint; Shift: TShiftState);
var
CanSelect: TSelectAccept;
begin
CanSelect:= [saCreate, saMove];
if Assigned(FDsnStage) then
if Assigned(FDsnStage.OnSelectQuery) then
FDsnStage.OnSelectQuery(FDsnStage, Target, CanSelect);
if saCreate in CanSelect then
begin
if csAcceptsControls in Client.ControlStyle then
FParentCtrl:= Client
else
begin
FParentCtrl:= Client.Parent;
Inc(MousePoint.x, Client.Left);
Inc(MousePoint.y, Client.Top);
end;
CreateCopyShape;
FShape.Color:= Color;
FShape.PenWidth:= PenWidth;
Cutting(MousePoint.x,MousePoint.y);
FX:= MousePoint.x;
FY:= MousePoint.y;
FShape.Point:= MousePoint;
FShape.AddNew;
FShape.DrowOn(FParentCtrl);
end;
end;
procedure TDsnRegister.MoseMove(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
Template:TControl;
begin
Template:= nil;
if Assigned(FDsnPanel) then
Template:= TControl(FDsnPanel.GetTemplate);
if Assigned(Template) then
MouseMoveCreate(Client,MousePoint,Shift)
else if ssLeft in Shift then
MouseMoveMove(Client,MousePoint,Shift)
else
begin
if Assigned(FShape) then
begin
FShape.DrowUp;
FShape.Free;
FShape:= nil;
end;
end;
end;
procedure TDsnRegister.MouseMoveMove(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
begin
if Assigned(FShape) then
begin
Cutting(MousePoint.x,MousePoint.y);
if SameParent then
begin
MousePoint:= FParentCtrl.ClientToScreen(MousePoint);
FShape.Drow(MousePoint);
end;
end;
end;
procedure TDsnRegister.MouseMoveCreate(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
begin
if Assigned(FShape) then
begin
Cutting(MousePoint.x,MousePoint.y);
if not (csAcceptsControls in Client.ControlStyle) then
begin
Inc(MousePoint.x,Client.Left);
Inc(MousePoint.y,Client.Top);
end;
FShape.SetWidth(MousePoint.x - FX);
FShape.SetHeight(MousePoint.y - FY);
MousePoint.x:= FX;
MousePoint.y:= FY;
MousePoint:= FParentCtrl.ClientToScreen(MousePoint);
FShape.Drow(MousePoint);
end;
end;
procedure TDsnRegister.MoseUp(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
Template:TControl;
begin
Template:= nil;
if Assigned(FDsnPanel) then
Template:= TControl(FDsnPanel.GetTemplate);
if Assigned(Template) then
MouseUpCreate(Client,MousePoint,Shift)
else
MouseUpMove(Client,MousePoint,Shift);
end;
procedure TDsnRegister.MouseUpMove(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
i,DX,DY:integer;
CanMove: Boolean;
begin
Cutting(MousePoint.x,MousePoint.y);
if SameParent then
if Assigned(FShape) then
begin
FShape.DrowUp;
FShape.Free;
FShape:= nil;
if Assigned(FTargetList) then
for i:= 0 to FTargetList.Count -1 do
begin
CanMove:= True;
if Assigned(FDsnStage.OnMoveQuery) then
FDsnStage.OnMoveQuery(FDsnStage,FTargetList[i],CanMove);
if CanMove then
begin
TControl(FTargetList[i]).Left:= TControl(FTargetList[i]).Left + (MousePoint.x - FX);
TControl(FTargetList[i]).Top:= TControl(FTargetList[i]).Top + (MousePoint.y - FY);
end;
end;
end;
DX:= FX- MousePoint.x;
DY:= FY- MousePoint.y;
if (DX <> 0) or (DY <> 0) then
Moved(DX,DY);
if Assigned(FTargetList) then
FTargetList.SetPosition;
end;
procedure TDsnRegister.MouseUpCreate(Client:TWinControl; MousePoint:TPoint; Shift: TShiftState);
var
NewWidth, NewHeight: Integer;
begin
Cutting(MousePoint.x, MousePoint.y);
if Assigned(FShape) then
begin
if not (csAcceptsControls in Client.ControlStyle) then
begin
Inc(MousePoint.x, Client.Left);
Inc(MousePoint.y, Client.Top);
end;
FShape.DrowUp;
FShape.Free;
FShape:= nil;
NewWidth:= MousePoint.x - FX;
NewHeight:= MousePoint.y - FY;
try
CopyPaste(TControl(FDsnPanel.GetTemplate),FParentCtrl);
except
end;
if Assigned(FDsnControl) then
begin
GiveName(FDsnControl);
if (NewWidth >=0) and (NewHeight >=0) then
TControl(FDsnControl).SetBounds(FX, FY, NewWidth, NewHeight);
if (NewWidth <0) and (NewHeight >=0) then
TControl(FDsnControl).SetBounds(FX + NewWidth, FY, -NewWidth, NewHeight);
if (NewWidth >=0) and (NewHeight <0) then
TControl(FDsnControl).SetBounds(FX, FY + NewHeight, NewWidth, -NewHeight);
if (NewWidth <0) and (NewHeight <0) then
TControl(FDsnControl).SetBounds(FX + NewWidth, FY + NewHeight, -NewWidth, -NewHeight);
if FTargetList = nil then
FTargetList:= CreateList;
if FDsnControl is TWinControl then
SetSubClass(TWinControl(FDsnControl));
FTargetList.Clear;
FTargetList.Add(FDsnControl);
// FLastTarget:= TControl(FDsnControl);
FTargetList.SetPosition;
{if Assigned(FDsnStage) then
if Assigned(FDsnStage.OnControlCreate) then
FDsnStage.OnControlCreate(FDsnStage, FDsnControl);}
end;
end;
if Assigned(FDsnPanel) then
FDsnPanel.EndCreating;
FDsnPanel.SetTemplate(nil);
FDsnControl:= nil;
end;
procedure TDsnRegister.Resized(Control:TControl;var Message: TResizeMessage);
begin
if Assigned(FProps) then
begin
FProps.GetValues;
FProps.SetPosition;
end;
end;
procedure TDsnRegister.Moved(DeltaX,DeltaY: Integer);
begin
if Assigned(FProps) then
FProps.GetValues;
end;
procedure TDsnRegister.Selected(Control:TControl;var Message: TMessage);
begin
end;
procedure TDsnRegister.ClearSelect;
begin
if Assigned(FTargetList) then
FTargetList.Clear;
end;
procedure TDsnRegister.DbClick(Target:TControl; var Message: TWMMouse);
begin
//ShowMessage(Target.Owner.Name);
if Assigned(FDsnStage) then
if Assigned(FDsnStage.OnCoverDblClick) then
FDsnStage.OnCoverDblClick(FDsnStage, Target);
end;
procedure TDsnRegister.RButtonDown(Client:TWinControl; Target:TControl; XPos,YPos: Integer);
var
n:integer;
CanSelect: TSelectAccept;
begin
CanSelect:= [saCreate, saMove];
if Assigned(FDsnStage) then
if Assigned(FDsnStage.OnSelectQuery) then
FDsnStage.OnSelectQuery(FDsnStage, Target, CanSelect);
if saMove in CanSelect then
begin
if Client = Target then
FParentCtrl:= Client.Parent
else
FParentCtrl:= Client;
if FTargetList = nil then
FTargetList:= CreateList;
n:= FTargetList.Count;
if n > 0 then
begin
n:= FTargetList.IndexOf(Target);
if (n = -1) or not SameParent then
begin
FTargetList.Clear;
FTargetList.Add(Target);
end;
end
else
begin
FTargetList.Add(Target);
end;
FTargetList.SetPosition;
end;
end;
procedure TDsnRegister.CallPopupMenu(Client:TWinControl; Target:TControl; XPos,YPos: Integer);
var
ContextProps:TContextProps;
i:integer;
Point:TPoint;
DsnMenuItem: TDsnMenuItem;
begin
RButtonDown(Client, Target, XPos,YPos);
if not Assigned(FContextMenu) then
Exit;
if not Assigned(FTargetList) then
Exit;
ContextProps:= TContextProps.Create;
ContextProps.CreateTable(FDsnStage.SelfProps,FDsnStage.OutProps,FTargetList.List);
for i:= 0 to FContextMenu.Items.Count - FContextMenu.Tag -1 do
FContextMenu.Items.Delete(FContextMenu.Tag);
if FContextMenu.Items.Count > 0 then
begin
DsnMenuItem:= TDsnMenuItem.Create(Owner);
DsnMenuItem.Caption:= '-';
FContextMenu.Items.Add(DsnMenuItem);
end;
for i:= 0 to ContextProps.PropList.Count -1 do
begin
DsnMenuItem:= TDsnMenuItem.Create(Owner);
DsnMenuItem.Caption:= ContextProps.Caption[i];
FContextMenu.Items.Add(DsnMenuItem);
DsnMenuItem.OnClick:= MenuMethod;
DsnMenuItem.PropName:= ContextProps.PropList[i];
DsnMenuItem.Value:= ContextProps.ValueList[i];
end;
if Assigned(FDsnStage.FOnPopup) then
FDsnStage.FOnPopup(FContextMenu);
Point.x:= Client.Left;
Point.y:= Client.Top;
Point:= Client.Parent.ClientToScreen(Point);
FContextMenu.PopUp(XPos+Point.x,YPos+Point.y);
ContextProps.Free;
end;
procedure TDsnRegister.GiveName(Component: TComponent);
var
S1,S2: String;
n:integer;
begin
S1:= Component.ClassName;
System.Delete(S1,1,1);
n:=1;
S2:=S1 + '1';
while Owner.FindComponent(S2) <> nil do
begin
Inc(n);
S2:=S1 + IntToStr(n);
end;
Component.Name:=S2;
end;
procedure TDsnRegister.CreateHandler;
begin
FHandler:= TMultiHandler.Create;
end;
function TDsnRegister.CreateProps:TMultiProps;
begin
Result:= TMultiProps.Create;
end;
procedure TDsnRegister.CreateCopyShape;
begin
FShape:= TMultiShape.Create;
end;
procedure TDsnRegister.CreateMoveShape;
begin
if Assigned(FShape) then
begin
FShape.DrowUp;
FShape.Free;
end;
FShape:= TMultiShape.Create;
end;
function TDsnRegister.CreateDsnList:TDsnList;
begin
Result:= TDsnList.Create;
end;
function TDsnRegister.CreateList:TTargetList;
var
InspectList:TStringList;
CaptionList:TStringList;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -