1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Authors: Maciej Izak
8 Michael W. Vogel
9
10 The PageControl shown in source editor window.
11 Every unit got a own pagecontrol
12
13 }
14
15 unit DockedSourcePageControl;
16
17 {$mode objfpc}{$H+}
18 { $define DEBUGDOCKEDFORMEDITOR}
19
20 interface
21
22 uses
23 // RTL
24 Classes, SysUtils, fgl,
25 // LCL
26 Forms, ComCtrls, Controls, LCLProc,
27 // IDEIntf
28 SrcEditorIntf, FormEditingIntf, LazIDEIntf,
29 // DockedFormEditor
30 DockedDesignForm, DockedResizer, DockedOptionsIDE, DockedAnchorDesigner,
31 {%H-}DockedTools, DockedStrConsts;
32
33 type
34
35 { TSourcePageControl }
36
37 TSourcePageControl = class(TPageControl)
38 private
39 FDesignerSetFocusAsyncCount: Integer;
40 FDesignForm: TDesignForm;
41 FResizer: TResizer;
42 FSourceEditor: TSourceEditorInterface;
43 FTabSheetAnchors: TTabSheet;
44 FTabSheetCode: TTabSheet;
45 FTabSheetDesigner: TTabSheet;
46 procedure AsyncDesignerSetFocus({%H-}Data: PtrInt);
GetActiveTabDisplayStatenull47 function GetActiveTabDisplayState: TTabDisplayState;
48 procedure SourcePageControlMouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
49 procedure OnAdjustPage(Sender: TObject);
50 protected
51 procedure SetDesignForm(const AValue: TDesignForm); virtual;
52 public
53 constructor Create(ASourceEditor: TSourceEditorInterface); reintroduce;
54 destructor Destroy; override;
55 procedure AdjustPage;
AnchorPageActivenull56 function AnchorPageActive: Boolean;
57 procedure CreateResizer;
58 procedure CreateTabSheetAnchors;
59 procedure CreateTabSheetDesigner;
60 procedure DesignerSetFocus;
61 procedure DesignerSetFocusAsync;
DesignerPageActivenull62 function DesignerPageActive: Boolean;
FormPageActivenull63 function FormPageActive: Boolean;
64 procedure RemoveDesignPages;
65 procedure RemoveTabSheetAnchors;
66 procedure InitPage;
67 procedure RefreshResizer;
68 procedure ShowCode;
69 procedure ShowDesigner(AIndex: Integer = 0);
70 public
71 property ActiveTabDisplayState: TTabDisplayState read GetActiveTabDisplayState;
72 property DesignForm: TDesignForm read FDesignForm write SetDesignForm;
73 property Resizer: TResizer read FResizer;
74 property SourceEditor: TSourceEditorInterface read FSourceEditor;
75 end;
76
77 { TSourcePageControls }
78
79 TSourcePageControls = class(specialize TFPGList<TSourcePageControl>)
80 private
GetPageControlnull81 function GetPageControl(ASrcEditor: TSourceEditorInterface): TSourcePageControl;
GetSourceEditornull82 function GetSourceEditor(APageControl: TSourcePageControl): TSourceEditorInterface;
83 public
Containsnull84 function Contains(APageControl: TSourcePageControl): Boolean;
Containsnull85 function Contains(ASrcEditor: TSourceEditorInterface): Boolean;
IndexOfnull86 function IndexOf(APageControl: TSourcePageControl): Integer; overload;
IndexOfnull87 function IndexOf(ASrcEditor: TSourceEditorInterface): Integer; overload;
88 procedure Remove(ASrcEditor: TSourceEditorInterface); overload;
89 public
90 property PageControl[ASrcEditor: TSourceEditorInterface]: TSourcePageControl read GetPageControl;
91 property SourceEditor[APageControl: TSourcePageControl]: TSourceEditorInterface read GetSourceEditor;
92 end;
93
94 implementation
95
96 { TSourcePageControl }
97
98 procedure TSourcePageControl.OnAdjustPage(Sender: TObject);
99 begin
100 AdjustPage;
101 end;
102
103 procedure TSourcePageControl.SourcePageControlMouseUp(Sender: TObject;
104 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
105 begin
106 if DesignerPageActive then
107 DesignerSetFocus;
108 end;
109
110 procedure TSourcePageControl.AsyncDesignerSetFocus(Data: PtrInt);
111 begin
112 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.AsyncDesignerSetFocus'); {$ENDIF}
113 DesignerSetFocus;
114 FDesignerSetFocusAsyncCount := 0;
115 end;
116
TSourcePageControl.GetActiveTabDisplayStatenull117 function TSourcePageControl.GetActiveTabDisplayState: TTabDisplayState;
118 begin
119 Result := tdsNone;
120 if ActivePage = FTabSheetCode then Exit(tdsCode)
121 else if Assigned(FTabSheetDesigner) and (ActivePage = FTabSheetDesigner) then Exit(tdsDesign)
122 else if Assigned(FTabSheetAnchors) and (ActivePage = FTabSheetAnchors) then Exit(tdsOther);
123 end;
124
125 procedure TSourcePageControl.SetDesignForm(const AValue: TDesignForm);
126 begin
127 if (AValue = FDesignForm) then
128 // for show lfm code, if we want after editing lfm go back to form without any error
129 // (when we restart IDE some error can be raised )
130 if (FResizer = nil)
131 or ((AValue <> nil) and (FResizer.DesignForm = AValue)) then
132 Exit;
133
134 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.SetDesignForm: ', DbgSName(AValue)); {$ENDIF}
135
136 FDesignForm := AValue;
137 if AValue = nil then
138 begin
139 if Assigned(FResizer) then
140 FResizer.DesignForm := nil;
141 end else begin
142 FDesignForm.OnAdjustPageNeeded := @OnAdjustPage;
143 AValue.LastActiveSourceWindow := Owner as TSourceEditorWindowInterface;
144 if Assigned(FResizer) then
145 FResizer.DesignForm := AValue;
146 AdjustPage;
147 end;
148 end;
149
150 constructor TSourcePageControl.Create(ASourceEditor: TSourceEditorInterface);
151 var
152 LParent: TWinControl;
153 begin
154 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.Create'); {$ENDIF}
155
156 inherited Create(ASourceEditor.EditorControl.Owner);
157 FSourceEditor := ASourceEditor;
158 FDesignerSetFocusAsyncCount := 0;
159 FResizer := nil;
160
161 TabPosition := DockedOptions.TabPosition;
162 Align := alClient;
163 ShowTabs := False;
164 OnMouseUp := @SourcePageControlMouseUp;
165
166 FTabSheetCode := TTabSheet.Create(Self);
167 FTabSheetCode.PageControl := Self;
168 FTabSheetCode.Caption := SCode;
169
170 // place SynEdit into code tab
171 LParent := ASourceEditor.EditorControl.Parent;
172 ASourceEditor.EditorControl.Parent := FTabSheetCode;
173 Parent := LParent;
174 end;
175
176 destructor TSourcePageControl.Destroy;
177 begin
178 DesignForm := nil;
179 inherited Destroy;
180 end;
181
182 procedure TSourcePageControl.AdjustPage;
183 begin
184 if not DesignerPageActive then Exit;
185 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.AdjustPage'); {$ENDIF}
186 if Assigned(FResizer) then
187 FResizer.AdjustResizer(nil);
188 end;
189
AnchorPageActivenull190 function TSourcePageControl.AnchorPageActive: Boolean;
191 begin
192 Result := ActivePage = FTabSheetAnchors;
193 end;
194
195 procedure TSourcePageControl.CreateResizer;
196 begin
197 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.CreateResizer'); {$ENDIF}
198 if Assigned(FResizer) then
199 raise Exception.Create('TSourcePageControl.CreateResizer: Resizer already created');
200 FResizer := TResizer.Create(Self);
201 if not Assigned(FTabSheetDesigner) then
202 CreateTabSheetDesigner;
203 FResizer.Parent := FTabSheetDesigner;
204 end;
205
206 procedure TSourcePageControl.CreateTabSheetAnchors;
207 begin
208 if not DockedOptions.AnchorTabVisible then Exit;
209 if Assigned(FTabSheetAnchors) then Exit;
210 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.CreateTabSheetAnchors'); {$ENDIF}
211 FTabSheetAnchors := TTabSheet.Create(Self);
212 FTabSheetAnchors.PageControl := Self;
213 FTabSheetAnchors.Caption := SAnchors;
214 end;
215
216 procedure TSourcePageControl.CreateTabSheetDesigner;
217 begin
218 if Assigned(FTabSheetDesigner) then Exit;
219 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.CreateTabSheetDesigner'); {$ENDIF}
220 FTabSheetDesigner := TTabSheet.Create(Self);
221 FTabSheetDesigner.PageControl := Self;
222 FTabSheetDesigner.Caption := SDesigner;
223 end;
224
225 procedure TSourcePageControl.DesignerSetFocus;
226 begin
227 if not Assigned(Resizer) then Exit;
228 if not Assigned(DesignForm) then Exit;
229 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControl.DesignerSetFocus'); {$ENDIF}
230 Resizer.DesignerSetFocus;
231 end;
232
233 procedure TSourcePageControl.DesignerSetFocusAsync;
234 begin
235 if FDesignerSetFocusAsyncCount = 0 then
236 Application.QueueAsyncCall(@AsyncDesignerSetFocus, 0);
237 Inc(FDesignerSetFocusAsyncCount);
238 end;
239
DesignerPageActivenull240 function TSourcePageControl.DesignerPageActive: Boolean;
241 begin
242 Result := (ActivePage = FTabSheetDesigner) or
243 (ActivePage = FTabSheetAnchors);
244 end;
245
TSourcePageControl.FormPageActivenull246 function TSourcePageControl.FormPageActive: Boolean;
247 begin
248 Result := ActivePage = FTabSheetDesigner;
249 end;
250
251 procedure TSourcePageControl.RemoveDesignPages;
252 begin
253 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControls.RemoveDesignPages'); {$ENDIF}
254 RemoveTabSheetAnchors;
255 FreeAndNil(FTabSheetDesigner);
256 ShowTabs := False;
257 end;
258
259 procedure TSourcePageControl.RemoveTabSheetAnchors;
260 begin
261 if not Assigned(FTabSheetAnchors) then Exit;
262 FreeAndNil(FTabSheetAnchors);
263 end;
264
265 procedure TSourcePageControl.InitPage;
266 begin
267 ShowTabs := PageCount > 1;
268 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControls.InitPage: ShowTabs[' + ShowTabs.ToString(TUseBoolStrs.True) + ']'); {$ENDIF}
269 if ActivePage = FTabSheetDesigner then
270 begin
271 Resizer.Parent := FTabSheetDesigner;
272 Resizer.ResizeControl.FormClient.Visible := True;
273 Resizer.ResizeControl.AnchorContainer.Visible := False;
274 end
275 else if ActivePage = FTabSheetAnchors then
276 begin
277 Resizer.Parent := FTabSheetAnchors;
278 Resizer.ResizeControl.FormClient.Visible := False;
279 Resizer.ResizeControl.AnchorContainer.Visible := True;
280 if not Assigned(DesignForm.AnchorDesigner) then
281 begin
282 DesignForm.AnchorDesigner := TAnchorDesigner.Create(DesignForm, Resizer.ResizeControl.AnchorContainer);
283 DesignForm.AnchorDesigner.OnDesignerSetFocus := @DesignerSetFocus;
284 end;
285 DesignForm.AnchorDesigner.Refresh;
286 end;
287 end;
288
289 procedure TSourcePageControl.RefreshResizer;
290 begin
291 if not Assigned(FResizer) then Exit;
292 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControls.RefreshResizer'); {$ENDIF}
293 FreeAndNil(FResizer);
294 CreateResizer;
295 end;
296
297 procedure TSourcePageControl.ShowCode;
298 begin
299 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControls.ShowCode'); {$ENDIF}
300 PageIndex := 0;
301 InitPage;
302 end;
303
304 procedure TSourcePageControl.ShowDesigner(AIndex: Integer);
305 begin
306 {$IFDEF DEBUGDOCKEDFORMEDITOR} DebugLn('TSourcePageControls.ShowDesigner'); {$ENDIF}
307 if (AIndex = 0) or not (Pages[AIndex].TabVisible) then
308 AIndex := 1;
309 if PageCount <= AIndex then Exit;
310 if not Pages[AIndex].TabVisible then Exit;
311 PageIndex := AIndex;
312 InitPage;
313 OnChange(Self);
314 end;
315
316 { TSourcePageControls }
317
GetPageControlnull318 function TSourcePageControls.GetPageControl(ASrcEditor: TSourceEditorInterface): TSourcePageControl;
319 var
320 LIndex: Integer;
321 begin
322 LIndex := IndexOf(ASrcEditor);
323 if LIndex >= 0 then
324 Result := Items[LIndex]
325 else
326 Result := nil;
327 end;
328
TSourcePageControls.GetSourceEditornull329 function TSourcePageControls.GetSourceEditor(APageControl: TSourcePageControl): TSourceEditorInterface;
330 var
331 LIndex: Integer;
332 begin
333 LIndex := IndexOf(APageControl);
334 if LIndex >= 0 then
335 Result := Items[LIndex].SourceEditor
336 else
337 Result := nil;
338 end;
339
Containsnull340 function TSourcePageControls.Contains(APageControl: TSourcePageControl): Boolean;
341 begin
342 Result := IndexOf(APageControl) >= 0;
343 end;
344
Containsnull345 function TSourcePageControls.Contains(ASrcEditor: TSourceEditorInterface): Boolean;
346 begin
347 Result := IndexOf(ASrcEditor) >= 0;
348 end;
349
IndexOfnull350 function TSourcePageControls.IndexOf(APageControl: TSourcePageControl): Integer;
351 var
352 i: Integer;
353 begin
354 Result := -1;
355 for i := 0 to Count - 1 do
356 if Items[i] = APageControl then
357 Exit(i);
358 end;
359
IndexOfnull360 function TSourcePageControls.IndexOf(ASrcEditor: TSourceEditorInterface): Integer;
361 var
362 i: Integer;
363 begin
364 Result := -1;
365 for i := 0 to Count - 1 do
366 if Items[i].SourceEditor = ASrcEditor then
367 Exit(i);
368 end;
369
370 procedure TSourcePageControls.Remove(ASrcEditor: TSourceEditorInterface);
371 var
372 LIndex: Integer;
373 begin
374 LIndex := IndexOf(ASrcEditor);
375 if LIndex < 0 then Exit;
376 Delete(LIndex);
377 end;
378
379 end.
380
381