1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Author: Maciej Izak
8
9 DaThoX 2004-2015
10 FreeSparta.com
11 }
12
13 unit DockedFormAccesses;
14
15 {$mode objfpc}{$H+}
16
17 interface
18
19 uses
20 Classes, SysUtils,
21 // LCL
22 Forms, Controls, LCLIntf, LCLType,
23 // IdeIntf
24 FormEditingIntf, SrcEditorIntf, ObjectInspector, ComponentEditors,
25 // DockedFormEditor
26 DockedBasicAnchorDesigner;
27
28 type
29
30 { TFormAccess }
31
32 TFormAccess = class
33 private
34 FForm: TCustomForm;
35 FOnChangeHackedBounds: TNotifyEvent;
36 FUpdate: Boolean;
37 protected
GetPublishedBoundsnull38 function GetPublishedBounds(AIndex: Integer): Integer;
39 procedure SetPublishedBounds(AIndex: Integer; AValue: Integer);
40 procedure DoChangeHackedBounds;
41 public
42 constructor Create(AForm: TCustomForm); virtual;
43 procedure BeginUpdate; virtual;
ClientOffsetnull44 function ClientOffset: TPoint;
45 procedure EndUpdate({%H-}AModified: Boolean = False); virtual;
46 procedure HideWindow;
47 procedure ShowWindow;
48 public
49 property Form: TCustomForm read FForm;
50 property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds;
51 property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds;
52 property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds;
53 property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds;
54 property OnChangeHackedBounds: TNotifyEvent read FOnChangeHackedBounds write FOnChangeHackedBounds;
55 property Update: Boolean read FUpdate;
56 end;
57
58 { TDesignFormIDE }
59
60 TDesignFormIDE = class(TFormAccess)
61 private
62 FAnchorDesigner: TBasicAnchorDesigner;
63 FLastActiveSourceWindow: TSourceEditorWindowInterface;
64 FSelectedControl: TControl;
GetCurrentObjectInspectornull65 function GetCurrentObjectInspector: TObjectInspectorDlg;
GetDesignernull66 function GetDesigner: TIDesigner;
GetDesignWinControlnull67 function GetDesignWinControl: TWinControl;
68 public
69 constructor Create(AForm: TCustomForm); override;
70 destructor Destroy; override;
71 procedure BeginUpdate; override;
72 procedure EndUpdate(AModified: Boolean = False); override;
IsAnchorDesignnull73 function IsAnchorDesign: Boolean;
MainMenuFakednull74 function MainMenuFaked: Boolean;
MainMenuHeightnull75 function MainMenuHeight: Integer;
76 public
77 property AnchorDesigner: TBasicAnchorDesigner read FAnchorDesigner write FAnchorDesigner;
78 property CurrentObjectInspector: TObjectInspectorDlg read GetCurrentObjectInspector;
79 property Designer: TIDesigner read GetDesigner;
80 property DesignWinControl: TWinControl read GetDesignWinControl;
81 property LastActiveSourceWindow: TSourceEditorWindowInterface read FLastActiveSourceWindow write FLastActiveSourceWindow;
82 property SelectedControl: TControl read FSelectedControl write FSelectedControl;
83 end;
84
85 implementation
86
87 type
88 THackForm = class(TForm);
89
90 { TDesignFormIDE }
91
GetPublishedBoundsnull92 function TFormAccess.GetPublishedBounds(AIndex: Integer): Integer;
93 begin
94 case AIndex of
95 0: Result := FForm.Left;
96 1: Result := FForm.Top;
97 2: Result := FForm.Width;
98 3: Result := FForm.Height;
99 end;
100 end;
101
102 procedure TFormAccess.SetPublishedBounds(AIndex: Integer; AValue: Integer);
103 const
104 cMinWidth = 135;
105 cMaxWidth = 5*1024; // huge Mac monitors have 5K pixels width
106 begin
107 if AIndex = 2 then
108 if AValue < cMinWidth then
109 AValue := cMinWidth;
110
111 if AIndex in [2, 3] then
112 if AValue > cMaxWidth then
113 AValue := cMaxWidth;
114
115 DoChangeHackedBounds;
116 end;
117
118 procedure TFormAccess.DoChangeHackedBounds;
119 begin
120 if not FUpdate and Assigned(FOnChangeHackedBounds) then
121 FOnChangeHackedBounds(FForm);
122 end;
123
124 constructor TFormAccess.Create(AForm: TCustomForm);
125 begin
126 FForm := AForm;
127 FUpdate := False;
128 end;
129
130 procedure TFormAccess.BeginUpdate;
131 begin
132 FUpdate := True;
133 end;
134
TFormAccess.ClientOffsetnull135 function TFormAccess.ClientOffset: TPoint;
136 begin
137 Result := Point(0, 0);
138 {$IF Defined(LCLWin32) or Defined(LCLWin64)}
139 Result.X := GetSystemMetrics(SM_CXSIZEFRAME);
140 Result.Y := GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYCAPTION);
141 {$ENDIF}
142 end;
143
144 procedure TFormAccess.EndUpdate(AModified: Boolean);
145 begin
146 FUpdate := False;
147 end;
148
149 procedure TFormAccess.HideWindow;
150 begin
151 if FForm.Parent = nil then
152 LCLIntf.ShowWindow(FForm.Handle, SW_HIDE);
153 end;
154
155 procedure TFormAccess.ShowWindow;
156 begin
157 if FForm.Parent = nil then
158 LCLIntf.ShowWindow(FForm.Handle, SW_SHOW);
159 end;
160
161 { TDesignFormIDE }
162
GetDesignernull163 function TDesignFormIDE.GetDesigner: TIDesigner;
164 begin
165 Result := FForm.Designer;
166 end;
167
TDesignFormIDE.GetCurrentObjectInspectornull168 function TDesignFormIDE.GetCurrentObjectInspector: TObjectInspectorDlg;
169 begin
170 if Assigned(FormEditingHook) and (FormEditingHook.GetCurrentDesigner = Designer) then
171 Result := FormEditingHook.GetCurrentObjectInspector
172 else
173 Result := nil;
174 end;
175
GetDesignWinControlnull176 function TDesignFormIDE.GetDesignWinControl: TWinControl;
177 begin
178 Result := Form;
179 if Form is TNonFormProxyDesignerForm then
180 if TNonFormProxyDesignerForm(Form).LookupRoot is TWinControl then
181 Result := TWinControl(TNonFormProxyDesignerForm(Form).LookupRoot)
182 else
183 Result := nil;
184 end;
185
186 constructor TDesignFormIDE.Create(AForm: TCustomForm);
187 begin
188 inherited Create(AForm);
189 FAnchorDesigner := nil;
190 FLastActiveSourceWindow := nil;
191 end;
192
193 destructor TDesignFormIDE.Destroy;
194 begin
195 FreeAndNil(FAnchorDesigner);
196 inherited Destroy;
197 end;
198
199 procedure TDesignFormIDE.BeginUpdate;
200 begin
201 THackForm(FForm).SetDesigning(False, False);
202 if Assigned(FAnchorDesigner) then
203 FAnchorDesigner.BeginUpdate;
204 inherited BeginUpdate;
205 end;
206
207 procedure TDesignFormIDE.EndUpdate(AModified: Boolean);
208 begin
209 THackForm(FForm).SetDesigning(True, False);
210 if Assigned(FAnchorDesigner) then
211 FAnchorDesigner.EndUpdate;
212 inherited EndUpdate(AModified);
213 if AModified and Assigned(CurrentObjectInspector) then
214 CurrentObjectInspector.RefreshPropertyValues;
215 end;
216
TDesignFormIDE.IsAnchorDesignnull217 function TDesignFormIDE.IsAnchorDesign: Boolean;
218 begin
219 Result := Assigned(DesignWinControl);
220 end;
221
MainMenuFakednull222 function TDesignFormIDE.MainMenuFaked: Boolean;
223 var
224 i: Integer;
225 begin
226 Result := False;
227 // {$IF DEFINED(LCLWin32) OR DEFINED(LCLWin64) OR DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)}
228 {$IF DEFINED(LCLQt) OR DEFINED(LCLQt5)}
229 // Menu is already shown in designer
230 Exit;
231 {$ENDIF}
232 if Assigned(Form.Menu)
233 and not (csDestroying in Form.Menu.ComponentState)
234 and (Form.Menu.Items.Count > 0)
235 then
236 for i := 0 to Form.Menu.Items.Count - 1 do
237 if Form.Menu.Items[i].Visible then
238 Exit(True);
239 end;
240
TDesignFormIDE.MainMenuHeightnull241 function TDesignFormIDE.MainMenuHeight: Integer;
242 begin
243 // some WS (Gtk2) return too big SM_CYMENU, just set it according to font height
244 // no problem, it is used only for the fake main menu
245 {$IFDEF LCLWin32}
246 Result := lclintf.GetSystemMetrics(SM_CYMENU);
247 {$ELSE}
248 if Form.HandleAllocated then
249 Result := Form.Canvas.TextHeight('Hg') * 4 div 3
250 else
251 Result := 20;
252 {$ENDIF}
253 end;
254
255 end.
256
257