1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Author: Shane Miller, Mattias Gaertner
8
9 Abstract:
10 Methods to access the form editing of the IDE.
11 }
12 unit FormEditingIntf;
13
14 {$mode objfpc}{$H+}
15
16 interface
17
18 uses
19 Classes, TypInfo, types, Math,
20 // LCL
21 LCLClasses, Forms, Controls,
22 // LazUtils
23 CompWriterPas, LazLoggerBase,
24 // IdeIntf
25 ComponentEditors, ObjectInspector, UnitResources;
26
27 const
28 ComponentPaletteImageWidth = 24;
29 ComponentPaletteImageHeight = 24;
30 ComponentPaletteBtnWidth = ComponentPaletteImageWidth + 3;
31 ComponentPaletteBtnHeight = ComponentPaletteImageHeight + 3;
32 DesignerBaseClassId_TForm = 0;
33 DesignerBaseClassId_TDataModule = 1;
34 DesignerBaseClassId_TFrame = 2;
35 NonControlProxyDesignerFormId = 0;
36 FrameProxyDesignerFormId = 1;
37
38 type
39 TDMCompAtPosFlag = (
40 dmcapfOnlyVisible,
41 dmcapfOnlySelectable
42 );
43 TDMCompAtPosFlags = set of TDMCompAtPosFlag;
44
45 TDesignerMediator = class;
46
47 INonFormDesigner = interface
48 ['{244DEC6B-80FB-4B28-85EF-FE613D1E2DD3}']
49 procedure Create;
50
GetLookupRootnull51 function GetLookupRoot: TComponent;
52 procedure SetLookupRoot(const AValue: TComponent);
53 property LookupRoot: TComponent read GetLookupRoot write SetLookupRoot;
54
55 procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer);
56 procedure Notification(AComponent: TComponent; AOperation: TOperation);
57 procedure Paint;
58
59 procedure DoSaveBounds;
60 procedure DoLoadBounds;
61 end;
62
63 IFrameDesigner = interface(INonFormDesigner)
64 ['{2B9442B0-6359-450A-88A1-BB6744F84918}']
65 end;
66
67 INonControlDesigner = interface(INonFormDesigner)
68 ['{5943A33C-F812-4052-BFE8-77AEA73199A9}']
GetMediatornull69 function GetMediator: TDesignerMediator;
70 procedure SetMediator(AValue: TDesignerMediator);
71 property Mediator: TDesignerMediator read GetMediator write SetMediator;
72 end;
73
74 { TNonFormProxyDesignerForm }
75
76 TNonFormProxyDesignerForm = class(TForm, INonFormDesigner)
77 private
78 FNonFormDesigner: INonFormDesigner;
79 FLookupRoot: TComponent;
80 protected
81 procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
82
83 procedure SetLookupRoot(AValue: TComponent); virtual;
GetPublishedBoundsnull84 function GetPublishedBounds(AIndex: Integer): Integer; virtual;
85 procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); virtual;
86 public
87 constructor Create(AOwner: TComponent; ANonFormDesigner: INonFormDesigner); virtual; reintroduce;
88 destructor Destroy; override;
89 procedure Paint; override;
90 procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
91 procedure SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight: integer);
92 procedure SetPublishedBounds(ALeft, ATop, AWidth, AHeight: integer);
93 procedure SetLookupRootBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
DockedDesignernull94 function DockedDesigner: boolean; virtual;
95
96 property NonFormDesigner: INonFormDesigner read FNonFormDesigner implements INonFormDesigner;
97 property LookupRoot: TComponent read FLookupRoot write SetLookupRoot;
98 published
99 property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds;
100 property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds;
101 property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds;
102 property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds;
103 property ClientWidth: Integer index 2 read GetPublishedBounds write SetPublishedBounds;
104 property ClientHeight: Integer index 3 read GetPublishedBounds write SetPublishedBounds;
105 end;
106
107 { TFrameProxyDesignerForm }
108
109 TFrameProxyDesignerForm = class(TNonFormProxyDesignerForm, IFrameDesigner)
110 private
GetFrameDesignernull111 function GetFrameDesigner: IFrameDesigner;
112 public
113 property FrameDesigner: IFrameDesigner read GetFrameDesigner implements IFrameDesigner;
114 end;
115
116 { TNonControlProxyDesignerForm }
117
118 TNonControlProxyDesignerForm = class(TNonFormProxyDesignerForm, INonControlDesigner)
119 private
120 FMediator: TDesignerMediator;
GetNonControlDesignernull121 function GetNonControlDesigner: INonControlDesigner;
122 protected
123 procedure SetMediator(AValue: TDesignerMediator); virtual;
124 public
125 property NonControlDesigner: INonControlDesigner read GetNonControlDesigner implements INonControlDesigner;
126 property Mediator: TDesignerMediator read FMediator write SetMediator;
127 end;
128
129 TNonFormProxyDesignerFormClass = class of TNonFormProxyDesignerForm;
130
131 { TDesignerMediator
132 To edit designer forms which do not use the LCL, register a TDesignerMediator,
133 which will emulate the painting, handle the mouse and editing bounds. }
134
135 TDesignerMediator = class(TComponent)
136 private
137 FDesigner: TComponentEditorDesigner;
138 FLCLForm: TForm;
139 FRoot: TComponent;
140 protected
141 FCollectedChildren: TFPList;
142 procedure SetDesigner(const AValue: TComponentEditorDesigner); virtual;
143 procedure SetLCLForm(const AValue: TForm); virtual;
144 procedure SetRoot(const AValue: TComponent); virtual;
145 procedure CollectChildren(Child: TComponent); virtual;
146 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
147 public
FormClassnull148 class function FormClass: TComponentClass; virtual; abstract;
CreateMediatornull149 class function CreateMediator(TheOwner, aForm: TComponent): TDesignerMediator; virtual;
150 class procedure InitFormInstance({%H-}aForm: TComponent); virtual; // called after NewInstance, before constructor
151 public
152 procedure SetBounds(AComponent: TComponent; NewBounds: TRect); virtual;
153 procedure GetBounds(AComponent: TComponent; out CurBounds: TRect); virtual;
154 procedure SetFormBounds(RootComponent: TComponent; NewBounds, ClientRect: TRect); virtual;
155 procedure GetFormBounds(RootComponent: TComponent; out CurBounds, CurClientRect: TRect); virtual;
156 procedure GetClientArea(AComponent: TComponent; out CurClientArea: TRect;
157 out ScrollOffset: TPoint); virtual;
GetComponentOriginOnFormnull158 function GetComponentOriginOnForm(AComponent: TComponent): TPoint; virtual;
ComponentIsIconnull159 function ComponentIsIcon({%H-}AComponent: TComponent): boolean; virtual;
ParentAcceptsChildnull160 function ParentAcceptsChild({%H-}Parent: TComponent; {%H-}Child: TComponentClass): boolean; virtual;
ComponentIsVisiblenull161 function ComponentIsVisible({%H-}AComponent: TComponent): Boolean; virtual;
ComponentIsSelectablenull162 function ComponentIsSelectable({%H-}AComponent: TComponent): Boolean; virtual;
ComponentAtPosnull163 function ComponentAtPos(p: TPoint; MinClass: TComponentClass;
164 Flags: TDMCompAtPosFlags): TComponent; virtual;
165 procedure GetChildComponents(Parent: TComponent; ChildComponents: TFPList); virtual;
UseRTTIForMethodsnull166 function UseRTTIForMethods({%H-}aComponent: TComponent): boolean; virtual; // false = use sources
167
168 // events
169 procedure InitComponent(AComponent, NewParent: TComponent; NewBounds: TRect); virtual;
170 procedure Paint; virtual;
171 procedure KeyDown(Sender: TControl; var {%H-}Key: word; {%H-}Shift: TShiftState); virtual;
172 procedure KeyUp(Sender: TControl; var {%H-}Key: word; {%H-}Shift: TShiftState); virtual;
173 procedure MouseDown({%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}p: TPoint; var {%H-}Handled: boolean); virtual;
174 procedure MouseMove({%H-}Shift: TShiftState; {%H-}p: TPoint; var {%H-}Handled: boolean); virtual;
175 procedure MouseUp({%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}p: TPoint; var {%H-}Handled: boolean); virtual;
176 procedure GetObjInspNodeImageIndex({%H-}APersistent: TPersistent; var {%H-}AIndex: integer); virtual;
177
178 property LCLForm: TForm read FLCLForm write SetLCLForm;
179 property Designer: TComponentEditorDesigner read FDesigner write SetDesigner;
180 property Root: TComponent read FRoot write SetRoot;
181 end;
182 TDesignerMediatorClass = class of TDesignerMediator;
183
184
185 { TAbstractFormEditor }
186
187 TAbstractFormEditor = class
188 private
189 FNonFormProxyDesignerFormClass: array[0..1] of TNonFormProxyDesignerFormClass;
190 protected
GetDesignerBaseClassesnull191 function GetDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
GetStandardDesignerBaseClassesnull192 function GetStandardDesignerBaseClasses(Index: integer): TComponentClass; virtual; abstract;
193 procedure SetStandardDesignerBaseClasses(Index: integer; AValue: TComponentClass); virtual; abstract;
GetDesignernull194 function GetDesigner(Index: integer): TIDesigner; virtual; abstract;
GetDesignerMediatorsnull195 function GetDesignerMediators(Index: integer): TDesignerMediatorClass; virtual; abstract;
GetNonFormProxyDesignerFormnull196 function GetNonFormProxyDesignerForm(Index: Integer): TNonFormProxyDesignerFormClass; virtual;
197 procedure SetNonFormProxyDesignerForm(Index: Integer; AValue: TNonFormProxyDesignerFormClass); virtual;
198 public
199 constructor Create;
200 // persistent
201 procedure RegisterDefineProperty(const APersistentClassName,
202 Identifier: string); virtual; abstract;
203
204 // components
FindComponentByNamenull205 function FindComponentByName(const Name: ShortString
206 ): TComponent; virtual; abstract;
207
CreateUniqueComponentNamenull208 function CreateUniqueComponentName(AComponent: TComponent): string; virtual; abstract;
CreateUniqueComponentNamenull209 function CreateUniqueComponentName(const AClassName: string;
210 OwnerComponent: TComponent): string; virtual; abstract;
GetDefaultComponentParentnull211 function GetDefaultComponentParent(TypeClass: TComponentClass
212 ): TComponent; virtual; abstract;
GetDefaultComponentPositionnull213 function GetDefaultComponentPosition(TypeClass: TComponentClass;
214 ParentComp: TComponent;
215 out X,Y: integer): boolean; virtual; abstract;
CreateComponentnull216 function CreateComponent(ParentComp: TComponent;
217 TypeClass: TComponentClass;
218 const AUnitName: shortstring;
219 X,Y,W,H: Integer;
220 DisableAutoSize: boolean): TComponent; virtual; abstract;
CreateComponentFromStreamnull221 function CreateComponentFromStream(BinStream: TStream;
222 UnitResourcefileFormat: TUnitResourcefileFormatClass;
223 AncestorType: TComponentClass;
224 const NewUnitName: ShortString;
225 Interactive: boolean;
226 Visible: boolean = true;
227 DisableAutoSize: boolean = false;
228 ContextObj: TObject = nil): TComponent; virtual; abstract;
229 procedure CreateChildComponentsFromStream(BinStream: TStream;
230 ComponentClass: TComponentClass; Root: TComponent;
231 ParentControl: TWinControl; NewComponents: TFPList); virtual; abstract;
232
233 // ancestors
GetAncestorLookupRootnull234 function GetAncestorLookupRoot(AComponent: TComponent): TComponent; virtual; abstract;
GetAncestorInstancenull235 function GetAncestorInstance(AComponent: TComponent): TComponent; virtual; abstract;
RegisterDesignerBaseClassnull236 function RegisterDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
DesignerBaseClassCountnull237 function DesignerBaseClassCount: Integer; virtual; abstract;
238 property DesignerBaseClasses[Index: integer]: TComponentClass read GetDesignerBaseClasses;
239 procedure UnregisterDesignerBaseClass(AClass: TComponentClass); virtual; abstract;
IndexOfDesignerBaseClassnull240 function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
DescendFromDesignerBaseClassnull241 function DescendFromDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
FindDesignerBaseClassByNamenull242 function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; virtual; abstract;
243
244 property StandardDesignerBaseClasses[Index: integer]: TComponentClass read GetStandardDesignerBaseClasses
245 write SetStandardDesignerBaseClasses;
StandardDesignerBaseClassesCountnull246 function StandardDesignerBaseClassesCount: Integer; virtual; abstract;
247
248 // designers
DesignerCountnull249 function DesignerCount: integer; virtual; abstract;
250 property Designer[Index: integer]: TIDesigner read GetDesigner;
GetCurrentDesignernull251 function GetCurrentDesigner: TIDesigner; virtual; abstract;
GetDesignerFormnull252 function GetDesignerForm(APersistent: TPersistent): TCustomForm; virtual; abstract;
GetDesignerByComponentnull253 function GetDesignerByComponent(AComponent: TComponent): TIDesigner; virtual; abstract;
NonFormProxyDesignerFormCountnull254 function NonFormProxyDesignerFormCount: integer; virtual;
255 property NonFormProxyDesignerForm[Index: integer]: TNonFormProxyDesignerFormClass read GetNonFormProxyDesignerForm
256 write SetNonFormProxyDesignerForm;
257
258 // mediators for non LCL forms
259 procedure RegisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; // auto calls RegisterDesignerBaseClass
260 procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; // auto calls UnregisterDesignerBaseClass
DesignerMediatorCountnull261 function DesignerMediatorCount: integer; virtual; abstract;
262 property DesignerMediators[Index: integer]: TDesignerMediatorClass read GetDesignerMediators;
GetDesignerMediatorByComponentnull263 function GetDesignerMediatorByComponent(AComponent: TComponent): TDesignerMediator; virtual; abstract;
264
265 // cut, copy, paste
SaveSelectionToStreamnull266 function SaveSelectionToStream(s: TStream): Boolean; virtual; abstract;
InsertFromStreamnull267 function InsertFromStream(s: TStream; Parent: TWinControl;
268 Flags: TComponentPasteSelectionFlags
269 ): Boolean; virtual; abstract;
ClearSelectionnull270 function ClearSelection: Boolean; virtual; abstract;
DeleteSelectionnull271 function DeleteSelection: Boolean; virtual; abstract;
CopySelectionToClipboardnull272 function CopySelectionToClipboard: Boolean; virtual; abstract;
CutSelectionToClipboardnull273 function CutSelectionToClipboard: Boolean; virtual; abstract;
PasteSelectionFromClipboardnull274 function PasteSelectionFromClipboard(Flags: TComponentPasteSelectionFlags
275 ): Boolean; virtual; abstract;
276 procedure SaveComponentAsPascal(aDesigner: TIDesigner; Writer: TCompWriterPas); virtual; abstract;
277
278 // designer tool windows
GetCurrentObjectInspectornull279 function GetCurrentObjectInspector: TObjectInspectorDlg; virtual; abstract;
280 end;
281
282 type
283 TDesignerIDECommandForm = class(TCustomForm)
284 // dummy form class, used by the IDE commands for keys in the designers
285 end;
286
287 var
288 FormEditingHook: TAbstractFormEditor; // will be set by the IDE
289
290 procedure GetComponentLeftTopOrDesignInfo(AComponent: TComponent; out aLeft, aTop: integer); // get properties if exists, otherwise get DesignInfo
291 procedure SetComponentLeftTopOrDesignInfo(AComponent: TComponent; aLeft, aTop: integer); // set properties if exists, otherwise set DesignInfo
TrySetOrdPropnull292 function TrySetOrdProp(Instance: TPersistent; const PropName: string;
293 Value: integer): boolean;
TryGetOrdPropnull294 function TryGetOrdProp(Instance: TPersistent; const PropName: string;
295 out Value: integer): boolean;
LeftFromDesignInfonull296 function LeftFromDesignInfo(ADesignInfo: LongInt): SmallInt; inline;
TopFromDesignInfonull297 function TopFromDesignInfo(ADesignInfo: LongInt): SmallInt; inline;
298 procedure SetDesignInfoLeft(AComponent: TComponent; const aLeft: SmallInt); inline;
299 procedure SetDesignInfoTop(AComponent: TComponent; const aTop: SmallInt); inline;
LeftTopToDesignInfonull300 function LeftTopToDesignInfo(const ALeft, ATop: SmallInt): LongInt; inline;
301 procedure DesignInfoToLeftTop(ADesignInfo: LongInt; out ALeft, ATop: SmallInt); inline;
LookupRootnull302 function LookupRoot(AForm: TCustomForm): TComponent;
303
304 implementation
305
306
307 procedure GetComponentLeftTopOrDesignInfo(AComponent: TComponent; out aLeft,
308 aTop: integer);
309 var
310 Info: LongInt;
311 begin
312 Info:=AComponent.DesignInfo;
313 if not TryGetOrdProp(AComponent,'Left',aLeft) then
314 aLeft:=LeftFromDesignInfo(Info);
315 if not TryGetOrdProp(AComponent,'Top',aTop) then
316 aTop:=TopFromDesignInfo(Info);
317 end;
318
319 procedure SetComponentLeftTopOrDesignInfo(AComponent: TComponent;
320 aLeft, aTop: integer);
321 var
322 HasLeft: Boolean;
323 HasTop: Boolean;
324 begin
325 HasLeft:=TrySetOrdProp(AComponent,'Left',aLeft);
326 HasTop:=TrySetOrdProp(AComponent,'Top',aTop);
327 if HasLeft and HasTop then exit;
328 ALeft := Max(Low(SmallInt), Min(ALeft, High(SmallInt)));
329 ATop := Max(Low(SmallInt), Min(ATop, High(SmallInt)));
330 AComponent.DesignInfo:=LeftTopToDesignInfo(aLeft,aTop);
331 end;
332
TrySetOrdPropnull333 function TrySetOrdProp(Instance: TPersistent; const PropName: string;
334 Value: integer): boolean;
335 var
336 PropInfo: PPropInfo;
337 begin
338 PropInfo:=GetPropInfo(Instance.ClassType,PropName);
339 if PropInfo=nil then exit(false);
340 SetOrdProp(Instance,PropInfo,Value);
341 Result:=true;
342 end;
343
TryGetOrdPropnull344 function TryGetOrdProp(Instance: TPersistent; const PropName: string; out
345 Value: integer): boolean;
346 var
347 PropInfo: PPropInfo;
348 begin
349 PropInfo:=GetPropInfo(Instance.ClassType,PropName);
350 if PropInfo=nil then exit(false);
351 Value:=GetOrdProp(Instance,PropInfo);
352 Result:=true;
353 end;
354
LeftFromDesignInfonull355 function LeftFromDesignInfo(ADesignInfo: LongInt): SmallInt;
356 begin
357 Result := LazLongRec(ADesignInfo).Lo;
358 end;
359
TopFromDesignInfonull360 function TopFromDesignInfo(ADesignInfo: LongInt): SmallInt;
361 begin
362 Result := LazLongRec(ADesignInfo).Hi;
363 end;
364
365 procedure SetDesignInfoLeft(AComponent: TComponent; const aLeft: SmallInt);
366 var
367 DesignInfo: LongInt;
368 begin
369 DesignInfo:=AComponent.DesignInfo;
370 LazLongRec(DesignInfo).Lo:=ALeft;
371 AComponent.DesignInfo:=DesignInfo;
372 end;
373
374 procedure SetDesignInfoTop(AComponent: TComponent; const aTop: SmallInt);
375 var
376 DesignInfo: LongInt;
377 begin
378 DesignInfo:=AComponent.DesignInfo;
379 LazLongRec(DesignInfo).Hi:=aTop;
380 AComponent.DesignInfo:=DesignInfo;
381 end;
382
LeftTopToDesignInfonull383 function LeftTopToDesignInfo(const ALeft, ATop: SmallInt): LongInt;
384 begin
385 LazLongRec(Result).Lo:=ALeft;
386 LazLongRec(Result).Hi:=ATop;
387 end;
388
389 procedure DesignInfoToLeftTop(ADesignInfo: LongInt; out ALeft, ATop: SmallInt);
390 begin
391 ALeft := LazLongRec(ADesignInfo).Lo;
392 ATop := LazLongRec(ADesignInfo).Hi;
393 end;
394
IsFormDesignFunctionnull395 function IsFormDesignFunction(AForm: TWinControl): boolean;
396 var
397 LForm: TCustomForm absolute AForm;
398 begin
399 if (AForm = nil) or not (AForm is TCustomForm) then
400 Exit(False);
401 Result := (csDesignInstance in LForm.ComponentState)
402 or ((csDesigning in LForm.ComponentState) and (LForm.Designer <> nil))
403 or (LForm is TNonFormProxyDesignerForm);
404 end;
405
LookupRootnull406 function LookupRoot(AForm: TCustomForm): TComponent;
407 begin
408 if AForm is TNonFormProxyDesignerForm then
409 Result := TNonFormProxyDesignerForm(AForm).LookupRoot
410 else if csDesignInstance in AForm.ComponentState then
411 Result := AForm
412 else
413 Result := nil;
414 end;
415
416 { TAbstractFormEditor }
417
TAbstractFormEditor.GetNonFormProxyDesignerFormnull418 function TAbstractFormEditor.GetNonFormProxyDesignerForm(Index: Integer
419 ): TNonFormProxyDesignerFormClass;
420 begin
421 Result := FNonFormProxyDesignerFormClass[Index];
422 end;
423
424 procedure TAbstractFormEditor.SetNonFormProxyDesignerForm(Index: Integer;
425 AValue: TNonFormProxyDesignerFormClass);
426 begin
427 FNonFormProxyDesignerFormClass[Index] := AValue;
428 end;
429
430 constructor TAbstractFormEditor.Create;
431 begin
432 FNonFormProxyDesignerFormClass[NonControlProxyDesignerFormId] := TNonControlProxyDesignerForm;
433 FNonFormProxyDesignerFormClass[FrameProxyDesignerFormId] := TFrameProxyDesignerForm;
434 end;
435
NonFormProxyDesignerFormCountnull436 function TAbstractFormEditor.NonFormProxyDesignerFormCount: integer;
437 begin
438 Result := Length(FNonFormProxyDesignerFormClass);
439 end;
440
441 { TNonControlProxyDesignerForm }
442
TNonControlProxyDesignerForm.GetNonControlDesignernull443 function TNonControlProxyDesignerForm.GetNonControlDesigner: INonControlDesigner;
444 begin
445 Result := FNonFormDesigner as INonControlDesigner;
446 end;
447
448 procedure TNonControlProxyDesignerForm.SetMediator(AValue: TDesignerMediator);
449 begin
450 FMediator := AValue;
451 end;
452
453 { TFrameProxyDesignerForm }
454
GetFrameDesignernull455 function TFrameProxyDesignerForm.GetFrameDesigner: IFrameDesigner;
456 begin
457 Result := FNonFormDesigner as IFrameDesigner;
458 end;
459
460 { TNonFormProxyDesignerForm }
461
462 constructor TNonFormProxyDesignerForm.Create(AOwner: TComponent;
463 ANonFormDesigner: INonFormDesigner);
464 begin
465 inherited CreateNew(AOwner, 1);
466 FNonFormDesigner := ANonFormDesigner;
467 FNonFormDesigner.Create;
468 end;
469
470 destructor TNonFormProxyDesignerForm.Destroy;
471 begin
472 inherited Destroy;
473 DebugLn(['TNonFormProxyDesignerForm.Destroy: Self=', Self, ', LookupRoot=', FLookupRoot]);
474 end;
475
476 procedure TNonFormProxyDesignerForm.Notification(AComponent: TComponent;
477 AOperation: TOperation);
478 begin
479 inherited Notification(AComponent, AOperation);
480 if Assigned(FNonFormDesigner) then
481 FNonFormDesigner.Notification(AComponent, AOperation);
482 end;
483
484 procedure TNonFormProxyDesignerForm.SetLookupRoot(AValue: TComponent);
485 begin
486 FLookupRoot := AValue;
487 end;
488
TNonFormProxyDesignerForm.GetPublishedBoundsnull489 function TNonFormProxyDesignerForm.GetPublishedBounds(AIndex: Integer): Integer;
490 begin
491 Result := 0;
492 case AIndex of
493 0: Result := inherited Left;
494 1: Result := inherited Top;
495 2: Result := inherited Width;
496 3: Result := inherited Height;
497 end;
498 end;
499
500 procedure TNonFormProxyDesignerForm.SetPublishedBounds(AIndex: Integer; AValue: Integer);
501 begin
502 case AIndex of
503 0: inherited Left := AValue;
504 1: inherited Top := AValue;
505 2: inherited Width := AValue;
506 3: inherited Height := AValue;
507 end;
508 end;
509
510 procedure TNonFormProxyDesignerForm.Paint;
511 begin
512 inherited Paint;
513 FNonFormDesigner.Paint;
514 end;
515
516 procedure TNonFormProxyDesignerForm.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
517 begin
518 inherited SetBounds(aLeft, aTop, aWidth, aHeight);
519 if Assigned(FNonFormDesigner) then
520 FNonFormDesigner.SetBounds(ALeft, ATop, AWidth, AHeight);
521 end;
522
523 procedure TNonFormProxyDesignerForm.SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight: integer);
524 begin
525 inherited SetBounds(aLeft, aTop, aWidth, aHeight);
526 end;
527
528 procedure TNonFormProxyDesignerForm.SetPublishedBounds(ALeft, ATop, AWidth, AHeight: integer);
529 begin
530 SetPublishedBounds(0, ALeft);
531 SetPublishedBounds(1, ATop);
532 SetPublishedBounds(2, AWidth);
533 SetPublishedBounds(3, AHeight);
534 end;
535
536 procedure TNonFormProxyDesignerForm.SetLookupRootBounds(ALeft, ATop, AWidth, AHeight: integer);
537 begin
538 if LookupRoot is TControl then
539 TControl(LookupRoot).SetBounds(ALeft, ATop, AWidth, AHeight);
540 end;
541
TNonFormProxyDesignerForm.DockedDesignernull542 function TNonFormProxyDesignerForm.DockedDesigner: boolean;
543 begin
544 Result := False;
545 end;
546
547 { TDesignerMediator }
548
549 procedure TDesignerMediator.SetRoot(const AValue: TComponent);
550 begin
551 if FRoot=AValue then exit;
552 if FRoot<>nil then
553 FRoot.RemoveFreeNotification(Self);
554 FRoot:=AValue;
555 if FRoot<>nil then
556 FRoot.FreeNotification(Self);
557 end;
558
559 procedure TDesignerMediator.CollectChildren(Child: TComponent);
560 begin
561 FCollectedChildren.Add(Child);
562 end;
563
564 procedure TDesignerMediator.Notification(AComponent: TComponent; Operation: TOperation);
565 begin
566 inherited Notification(AComponent, Operation);
567 if Operation=opRemove then begin
568 if AComponent=FLCLForm then FLCLForm:=nil;
569 if AComponent=FRoot then FRoot:=nil;
570 end;
571 end;
572
TDesignerMediator.CreateMediatornull573 class function TDesignerMediator.CreateMediator(TheOwner, aForm: TComponent
574 ): TDesignerMediator;
575 begin
576 Result:=Create(TheOwner);
577 Result.FRoot:=aForm;
578 end;
579
580 procedure TDesignerMediator.SetDesigner(const AValue: TComponentEditorDesigner);
581 begin
582 if FDesigner=AValue then exit;
583 //if FDesigner<>nil then begin
584 //end;
585 FDesigner:=AValue;
586 end;
587
588 procedure TDesignerMediator.SetLCLForm(const AValue: TForm);
589 begin
590 if FLCLForm=AValue then exit;
591 if FLCLForm<>nil then
592 FLCLForm.RemoveFreeNotification(Self);
593 FLCLForm:=AValue;
594 if FLCLForm<>nil then
595 FLCLForm.FreeNotification(Self);
596 end;
597
598 class procedure TDesignerMediator.InitFormInstance(aForm: TComponent);
599 begin
600
601 end;
602
603 procedure TDesignerMediator.SetBounds(AComponent: TComponent; NewBounds: TRect);
604 begin
605 SetComponentLeftTopOrDesignInfo(AComponent,NewBounds.Left,NewBounds.Top);
606 end;
607
608 procedure TDesignerMediator.GetBounds(AComponent: TComponent; out
609 CurBounds: TRect);
610 var
611 aLeft: integer;
612 aTop: integer;
613 begin
614 GetComponentLeftTopOrDesignInfo(AComponent,aLeft,aTop);
615 CurBounds:=Rect(aLeft,aTop,aLeft+ComponentPaletteBtnWidth,aTop+ComponentPaletteBtnHeight);
616 end;
617
618 procedure TDesignerMediator.SetFormBounds(RootComponent: TComponent; NewBounds,
619 ClientRect: TRect);
620 // default: use NewBounds as position and the ClientRect as size
621 var
622 r: TRect;
623 begin
624 r:=Bounds(NewBounds.Left,NewBounds.Top,
625 ClientRect.Right-ClientRect.Left,ClientRect.Bottom-ClientRect.Top);
626 //debugln(['TDesignerMediator.SetFormBounds NewBounds=',dbgs(NewBounds),' ClientRect=',dbgs(ClientRect),' r=',dbgs(r)]);
627 SetBounds(RootComponent,r);
628 end;
629
630 procedure TDesignerMediator.GetFormBounds(RootComponent: TComponent; out
631 CurBounds, CurClientRect: TRect);
632 // default: clientarea is whole bounds and CurBounds.Width/Height=0
633 // The IDE will use the clientarea to determine the size of the form
634 begin
635 GetBounds(RootComponent,CurBounds);
636 //debugln(['TDesignerMediator.GetFormBounds ',dbgs(CurBounds)]);
637 CurClientRect:=Rect(0,0,CurBounds.Right-CurBounds.Left,
638 CurBounds.Bottom-CurBounds.Top);
639 CurBounds.Right:=CurBounds.Left;
640 CurBounds.Bottom:=CurBounds.Top;
641 //debugln(['TDesignerMediator.GetFormBounds ',dbgs(CurBounds),' ',dbgs(CurClientRect)]);
642 end;
643
644 procedure TDesignerMediator.GetClientArea(AComponent: TComponent; out
645 CurClientArea: TRect; out ScrollOffset: TPoint);
646 // default: no ScrollOffset and client area is whole bounds
647 begin
648 GetBounds(AComponent,CurClientArea);
649 OffsetRect(CurClientArea,-CurClientArea.Left,-CurClientArea.Top);
650 ScrollOffset:=Point(0,0);
651 end;
652
GetComponentOriginOnFormnull653 function TDesignerMediator.GetComponentOriginOnForm(AComponent: TComponent): TPoint;
654 var
655 Parent: TComponent;
656 ClientArea: TRect;
657 ScrollOffset: TPoint;
658 CurBounds: TRect;
659 begin
660 if ComponentIsIcon(AComponent) then
661 begin
662 Result.X := LeftFromDesignInfo(AComponent.DesignInfo);
663 Result.Y := TopFromDesignInfo(AComponent.DesignInfo);
664 Exit;
665 end;
666 Result:=Point(0,0);
667 while AComponent<>nil do begin
668 Parent:=AComponent.GetParentComponent;
669 if Parent=nil then break;
670 GetBounds(AComponent,CurBounds);
671 inc(Result.X,CurBounds.Left);
672 inc(Result.Y,CurBounds.Top);
673 GetClientArea(Parent,ClientArea,ScrollOffset);
674 inc(Result.X,ClientArea.Left+ScrollOffset.X);
675 inc(Result.Y,ClientArea.Top+ScrollOffset.Y);
676 AComponent:=Parent;
677 end;
678 end;
679
680 procedure TDesignerMediator.Paint;
681 begin
682
683 end;
684
ComponentIsIconnull685 function TDesignerMediator.ComponentIsIcon(AComponent: TComponent): boolean;
686 begin
687 Result:=true;
688 end;
689
TDesignerMediator.ParentAcceptsChildnull690 function TDesignerMediator.ParentAcceptsChild(Parent: TComponent;
691 Child: TComponentClass): boolean;
692 begin
693 Result:=false;
694 end;
695
TDesignerMediator.ComponentIsVisiblenull696 function TDesignerMediator.ComponentIsVisible(AComponent: TComponent): Boolean;
697 begin
698 Result:=true;
699 end;
700
ComponentIsSelectablenull701 function TDesignerMediator.ComponentIsSelectable(AComponent: TComponent
702 ): Boolean;
703 begin
704 Result:=true;
705 end;
706
TDesignerMediator.ComponentAtPosnull707 function TDesignerMediator.ComponentAtPos(p: TPoint; MinClass: TComponentClass;
708 Flags: TDMCompAtPosFlags): TComponent;
709 var
710 i: Integer;
711 Child: TComponent;
712 ClientArea: TRect;
713 ScrollOffset: TPoint;
714 ChildBounds: TRect;
715 Found: Boolean;
716 Children: TFPList;
717 Offset: TPoint;
718 begin
719 Result:=Root;
720 while Result<>nil do begin
721 GetClientArea(Result,ClientArea,ScrollOffset);
722 Offset:=GetComponentOriginOnForm(Result);
723 //DebugLn(['TDesignerMediator.ComponentAtPos Parent=',DbgSName(Result),' Offset=',dbgs(Offset)]);
724 OffsetRect(ClientArea,Offset.X,Offset.Y);
725 Children:=TFPList.Create;
726 try
727 GetChildComponents(Result,Children);
728 //DebugLn(['TDesignerMediator.ComponentAtPos Result=',DbgSName(Result),' ChildCount=',children.Count,' ClientArea=',dbgs(ClientArea)]);
729 Found:=false;
730 // iterate backwards (z-order)
731 for i:=Children.Count-1 downto 0 do begin
732 Child:=TComponent(Children[i]);
733 //DebugLn(['TDesignerMediator.ComponentAtPos Child ',DbgSName(Child)]);
734 if (MinClass<>nil) and (not Child.InheritsFrom(MinClass)) then
735 continue;
736 if (dmcapfOnlyVisible in Flags) and (not ComponentIsVisible(Child)) then
737 continue;
738 if (dmcapfOnlySelectable in Flags)
739 and (not ComponentIsSelectable(Child)) then
740 continue;
741 GetBounds(Child,ChildBounds);
742 if ComponentIsIcon(Child) then
743 OffsetRect(ChildBounds,ScrollOffset.X,
744 ScrollOffset.Y)
745 else
746 OffsetRect(ChildBounds,ClientArea.Left+ScrollOffset.X,
747 ClientArea.Top+ScrollOffset.Y);
748 //DebugLn(['TDesignerMediator.ComponentAtPos ChildBounds=',dbgs(ChildBounds),' p=',dbgs(p)]);
749 if PtInRect(ChildBounds,p) then begin
750 Found:=true;
751 Result:=Child;
752 break;
753 end;
754 end;
755 if not Found then exit;
756 finally
757 Children.Free;
758 end;
759 end;
760 end;
761
762 procedure TDesignerMediator.GetChildComponents(Parent: TComponent;
763 ChildComponents: TFPList);
764 begin
765 FCollectedChildren:=ChildComponents;
766 try
767 TDesignerMediator(Parent).GetChildren(@CollectChildren,Root);
768 finally
769 FCollectedChildren:=nil;
770 end;
771 end;
772
TDesignerMediator.UseRTTIForMethodsnull773 function TDesignerMediator.UseRTTIForMethods(aComponent: TComponent): boolean;
774 begin
775 Result:=false;
776 end;
777
778 procedure TDesignerMediator.InitComponent(AComponent, NewParent: TComponent;
779 NewBounds: TRect);
780 begin
781 SetBounds(AComponent,NewBounds);
782 TDesignerMediator(AComponent).SetParentComponent(NewParent);
783 end;
784
785 procedure TDesignerMediator.KeyDown(Sender: TControl; var Key: word;
786 Shift: TShiftState);
787 begin
788
789 end;
790
791 procedure TDesignerMediator.KeyUp(Sender: TControl; var Key: word;
792 Shift: TShiftState);
793 begin
794
795 end;
796
797 procedure TDesignerMediator.MouseDown(Button: TMouseButton; Shift: TShiftState;
798 p: TPoint; var Handled: boolean);
799 begin
800
801 end;
802
803 procedure TDesignerMediator.MouseMove(Shift: TShiftState; p: TPoint;
804 var Handled: boolean);
805 begin
806
807 end;
808
809 procedure TDesignerMediator.MouseUp(Button: TMouseButton; Shift: TShiftState;
810 p: TPoint; var Handled: boolean);
811 begin
812
813 end;
814
815 procedure TDesignerMediator.GetObjInspNodeImageIndex(APersistent: TPersistent;
816 var AIndex: integer);
817 begin
818
819 end;
820
821 initialization
822 IsFormDesign := @IsFormDesignFunction;
823 end.
824
825