?? dsnunit.pas
字號:
end;
inherited ;
end;
function TDsnStage.GetCanCopy:Boolean;
begin
Result:= False;
if Assigned(FDsnRegister) then
Result:= FDsnRegister.CanCopy;
end;
function TDsnStage.GetCanPaste:Boolean;
begin
Result:= False;
if Assigned(FDsnRegister) then
Result:= FDsnRegister.CanPaste;
end;
procedure TDsnStage.Delete;
begin
if Assigned(FDsnRegister) then
FDsnRegister.Delete;
end;
procedure TDsnStage.Cut;
begin
if Assigned(FDsnRegister) then
FDsnRegister.Cut;
end;
procedure TDsnStage.Copy;
begin
if Assigned(FDsnRegister) then
FDsnRegister.Copy;
end;
procedure TDsnStage.Paste;
begin
if Assigned(FDsnRegister) then
FDsnRegister.Paste;
end;
procedure TDsnStage.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = FCoverMenu then
FCoverMenu := nil;
end;
procedure TDsnStage.SaveToFile(FileName:String);
var
FS:TStream;
WR:TWriter;
i:integer;
begin
if Assigned(FDsnRegister) then
FDsnRegister.ClearSelect;
FS:=TFileStream.Create(FileName, fmCreate);
try
WR:=TWriter.Create(FS,4096);
try
for i:=0 to ControlCount-1 do
begin
WriteComponents(FS,Controls[i]);
WR.WriteListEnd;
end;
finally
WR.Free;
end;
finally
FS.Free;
end;
end;
procedure TDsnStage.SaveToStream(Stream:TStream);
var
WR:TWriter;
i:integer;
begin
if Assigned(FDsnRegister) then
FDsnRegister.ClearSelect;
WR:=TWriter.Create(Stream,4096);
try
for i:=0 to ControlCount-1 do
WriteComponents(Stream,Controls[i]);
WR.WriteListEnd;
finally
WR.Free;
end;
end;
procedure TDsnStage.LoadFromFile(FileName:String);
var
FS:TStream;
Flag: Boolean;
begin
{if Designing then
Raise Exception.Create(STG_ERRORREAD); }
Flag:= False;
if Assigned(FDsnRegister) then
begin
if FDsnRegister.Designing then
Flag:= True;
FDsnRegister.SetDesigning(False);
end;
try
FS:=TFileStream.Create(FileName, fmOpenRead);
try
ReadComponents(FS);
finally
FS.Free;
end;
except
Raise Exception.Create(FileName+ STG_ERRORREADFILE);
end;
if Flag then
FDsnRegister.SetDesigning(True);
end;
procedure TDsnStage.LoadFromStream(Stream:TStream);
var
Flag: Boolean;
begin
{ if Designing then
Raise Exception.Create(STG_ERRORREAD);}
Flag:= False;
if Assigned(FDsnRegister) then
begin
if FDsnRegister.Designing then
Flag:= True;
FDsnRegister.SetDesigning(False);
end;
ReadComponents(Stream);
if Flag then
FDsnRegister.SetDesigning(True);
end;
procedure TDsnStage.ComponentsProc(Component:TComponent);
begin
end;
procedure TDsnStage.WriteComponents(Stream:TStream;Control:TControl);
var
WR:TWriter;
begin
WR:=TWriter.Create(Stream,4096);
try
WR.RootAncestor := nil;
WR.Ancestor := nil;
WR.Root := Owner;
WR.WriteSignature;
WR.WriteComponent(Control);
finally
WR.Free;
end;
end;
procedure TDsnStage.ReadComponents(Stream:TStream);
var
RD:TReader;
i:integer;
begin
for i:=ControlCount-1 downto 0 do begin
Controls[i].Free;
end;
RD:=TReader.Create(Stream,4096);
try
RD.OnError:=ReadError;
RD.OnFindMethod:=FindMethod;
RD.OnSetName:=CheckName;
RD.Position:=0;
RD.ReadComponents(Owner,Self,ComponentsProc);
finally
RD.Free;
end;
end;
procedure TDsnStage.CheckName(Reader:TReader; Component:TComponent; var Name:String);
begin
DsnCheckName(Owner,Reader,Component,Name);
if Assigned(FOnControlLoading) then
FOnControlLoading(Self, Component);
PostMessage(Handle, DS_LOADED, Integer(Component),0)
end;
procedure TDsnStage.ReadError(Reader: TReader; const Message: string; var Handled: Boolean);
begin
Handled:=True;
end;
procedure TDsnStage.FindMethod(Reader: TReader; const MethodName: string;
var Address: Pointer; var Error: Boolean);
begin
if Error then
begin
Address:=nil;
Error:=False;
end;
end;
procedure TDsnStage.ControlCreated(var Message: TMessage);
var
Component:TComponent;
begin
Component:= TComponent(Message.WParam);
if Assigned(OnControlCreate) then
OnControlCreate(Self, Component);
end;
procedure TDsnStage.ControlLoaded(var Message: TMessage);
var
Component:TComponent;
begin
Component:= TComponent(Message.WParam);
if Assigned(OnControlLoaded) then
OnControlLoaded(Self, Component);
end;
{TDsnCtrl}
constructor TDsnCtrl.CreateInstance(AClient: TWinControl);
begin
inherited CreateInstance(AClient);
ClientDeath:= False;
end;
procedure TDsnCtrl.TakeInstance;
begin
if Assigned(Client) then
begin
Client.Cursor:= crArrow;
Client.Invalidate;
end;
end;
procedure TDsnCtrl.ReleaseInstance;
begin
if (Assigned(Client)) and (not ClientDeath) then
begin
Client.Cursor:= crDefault;
Client.Invalidate;
end;
end;
procedure TDsnCtrl.ClientMouseDown(var Message: TWMMouse);
var
Shift: TShiftState;
begin
FMousePoint := Point(Message.XPos, Message.YPos);
FTarget := nil;
FTarget := Client.ControlAtPos(FMousePoint, TRUE);
if FTarget = nil then
FTarget := Client;
if FTarget.Owner <> Client.Owner then
FTarget := Client; // For Like DBNavigator
Shift:= KeysToShiftState(Message.Keys);
SetCapture(Client.Handle);
FDsnRegister.MouseDown(Client, FTarget, FMousePoint, Shift);
FDsnRegister.FDsnStage.SetFocus;
end;
procedure TDsnCtrl.ClientMouseMove(var Message: TWMMouse);
var
Shift: TShiftState;
begin
FMousePoint := Point(Message.XPos, Message.YPos);
Shift:= KeysToShiftState(Message.Keys);
if Assigned(FTarget)then
FDsnRegister.MoseMove(Client, FMousePoint, Shift);
end;
procedure TDsnCtrl.ClientMouseUp(var Message: TWMMouse);
var
Shift: TShiftState;
begin
FMousePoint := Point(Message.XPos, Message.YPos);
Shift:= KeysToShiftState(Message.Keys);
if Assigned(FTarget)then
FDsnRegister.MoseUp(Client, FMousePoint, Shift);
ReleaseCapture;
end;
procedure TDsnCtrl.ClientCaptureChanged(var Message: TMessage);
begin
//FTarget := nil;
end;
procedure TDsnCtrl.ClientPaint(var Message: TWMPaint);
begin
with TMessage(Message) do Client.Perform(Msg, wParam, lParam);
end;
procedure TDsnCtrl.ClientWndProc(var Message: TMessage);
var
r:integer;
begin
case(Message.Msg)of
WM_LBUTTONDOWN:
begin
r:= SendMessage(Client.Handle,CM_DESIGNHITTEST,
TMessage(Message).WParam,TMessage(Message).LParam);
if r = 1 then
with Message do // for PageControl's Tab
Result := CallWindowProc(DefClientProc, Client.Handle,
Msg, WParam, LParam)
else;
ClientMouseDown(TWMMouse(Message));
end;
WM_LBUTTONUP: ClientMouseUp(TWMMouse(Message));
WM_MOUSEMOVE: ClientMouseMove(TWMMouse(Message));
WM_RBUTTONDOWN: ClientContextMenu(TWMMouse(Message));
WM_CAPTURECHANGED: ClientCaptureChanged(Message);
WM_PAINT: ClientPaint(TWMPaint(Message));
RM_START: ClientPreResize(TMessage(Message));
RM_FINISH: ClientResize(TResizeMessage(Message));
MH_SELECT: ClientSelect(TMessage(Message));
CI_SELECT: ClientSelectByInspect(TMessage(Message));
WM_SETFOCUS:ClientSetFocus(TMessage(Message));
WM_DESTROY:ClientHandleChange(TMessage(Message));
WM_LBUTTONDBLCLK:ClientDbClick(TWMMouse(Message));
WM_NCHITTEST:Message.Result:= HTCLIENT;
else
with Message do
Result := CallWindowProc(DefClientProc, Client.Handle,
Msg, WParam, LParam);
end;
end;
procedure TDsnCtrl.ClientDbClick(var Message: TWMMouse);
begin
FDsnRegister.DbClick(FTarget,TWMMouse(Message));
end;
procedure TDsnCtrl.ClientContextMenu(var Message: TWMMouse);
begin
TMessage(Message).WParam:= 0;
FMousePoint := Point(Message.XPos, Message.YPos);
FTarget := nil;
FTarget := Client.ControlAtPos(FMousePoint, TRUE);
if FTarget = nil then
FTarget := Client;
if FTarget.Owner <> Client.Owner then
FTarget := Client; // For Like DBNavigator
SetCapture(Client.Handle);
FDsnRegister.CallPopupMenu(Client, FTarget, Message.XPos, Message.YPos);
FDsnRegister.FDsnStage.SetFocus;
end;
procedure TDsnCtrl.ClientHandleChange(var Message: TMessage);
begin
EndSubClassing;
with Message do
Result := CallWindowProc(DefClientProc, Client.Handle,
Msg, WParam, LParam);
PostMessage(FDsnRegister.FDsnStage.Handle, AG_DESTROY, Integer(Self),0);
end;
procedure TDsnCtrl.ClientPreResize(var Message: TMessage);
begin
FTarget:= TControl(Message.WParam);
end;
procedure TDsnCtrl.ClientResize(var Message: TResizeMessage);
begin
FDsnRegister.Resized(FTarget,Message);
end;
procedure TDsnCtrl.ClientSelect(var Message: TMessage);
begin
FDsnRegister.Selected(FTarget,Message);
end;
procedure TDsnCtrl.ClientSelectByInspect(var Message: TMessage);
begin
FDsnRegister.SelectByInspect(TControl(Message.WParam));
end;
procedure TDsnCtrl.ClientSetFocus(var Message: TMessage);
begin
if not (Client is TDsnStage) then
FDsnRegister.FDsnStage.SetFocus
else
with Message do
Result := CallWindowProc(DefClientProc, Client.Handle,
Msg, WParam, LParam);
end;
{TDsnSwitch}
procedure TDsnSwitch.SetDsnRegister(Value:TDsnRegister);
begin
if Assigned(Value) then
FDsnRegister:= Value
else
FDsnRegister:= nil;
end;
procedure TDsnSwitch.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = FDsnRegister then FDsnRegister := nil;
end;
constructor TDsnSwitch.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
DsnMessageFlg:=False;
DsnMessage:= DSNMES_START;
end;
procedure TDsnSwitch.Loaded;
begin
inherited;
GroupIndex:=DsnSwc_GrpIdx;
AllowAllUp:=True;
end;
procedure TDsnSwitch.Click;
begin
if Down and DsnMessageFlg then
ShowMessage(DsnMessage);
if FDsnRegister <> nil then
FDsnRegister.SetDesigning(Down);
inherited;
end;
procedure TDsnSwitch.DesignOn;
begin
if not Down then
begin
Down:= True;
Click;
end;
end;
procedure TDsnSwitch.DesignOff;
begin
if Down then
begin
Down:= False;
Click;
end;
end;
{ TDsnPartner }
function TDsnPartner.CheckCanSelect(Control: TControl): Boolean;
begin
if FDsnRegister <> nil then
Result:= FDsnRegister.CheckCanSelect(Control)
else
Result:= False;
end;
constructor TDsnPartner.Create(AOwner: TComponent);
begin
inherited;
FDesigning:= False;
end;
procedure TDsnPartner.CreateMoveShape;
var
i: integer;
begin
if FDsnRegister <> nil then
begin
FDsnRegister.CreateMoveShape;
FDsnRegister.FShape.Color:= FDsnRegister.Color;
FDsnRegister.FShape.PenWidth:= FDsnRegister.PenWidth;
for i:= 0 to FDsnRegister.FTargetList.Count -1 do
FDsnRegister.FShape.Add(FDsnRegister.FTargetList[i]);
end;
end;
procedure TDsnPartner.CreateTargetList;
begin
if FDsnRegister <> nil then
FDsnRegister.FTargetList:= FDsnRegister.CreateList;
end;
function TDsnPartner.GetDsnList: TDsnList;
begin
if FDsnRegister <> nil then
Result:= FDsnRegister.FDsnCtrlList
else
Result:= nil;
end;
function TDsnPartner.GetTargetList: TTargetList;
begin
if FDsnRegister <> nil then
Result:= FDsnRegister.FTargetList
else
Result:= nil;
end;
procedure TDsnPartner.SetDesigning(Value: Boolean);
begin
if Value <> FDesigning then
FDesigning:= Value;
end;
procedure TDsnPartner.SetDsnRegister(Value: TDsnRegister);
begin
if Assigned(Value) then
begin
FDsnRegister:=Value;
FDsnRegister.FreeNotification(Self);
FDsnRegister.AddPartners(Self);
end
else
FDsnRegister:=nil;
end;
procedure Register;
begin
RegisterComponents('DsnSys', [TDsnSwitch]);
RegisterComponents('DsnSys', [TDsnStage]);
RegisterComponents('DsnSys', [TDsnPanel]);
RegisterComponents('DsnSys', [TDsnInspector]);
RegisterComponents('DsnSys', [TDsnRegister]);
RegisterComponents('DsnSys', [TDsnDpRegister]);
RegisterComponents('DsnSys', [TDsnRSRegister]);
RegisterComponents('DsnSys', [TDsnClRegister]);
RegisterComponents('DsnSys', [TDsnSelect]);
end;
initialization
RegisterClass(TDsnButton);
RegisterClass(TArrowButton);
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -