1 |
|
---|
2 | {*****************************************************************************}
|
---|
3 | { }
|
---|
4 | { Tnt Delphi Unicode Controls }
|
---|
5 | { http://www.tntware.com/delphicontrols/unicode/ }
|
---|
6 | { Version: 2.3.0 }
|
---|
7 | { }
|
---|
8 | { Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
|
---|
9 | { }
|
---|
10 | {*****************************************************************************}
|
---|
11 |
|
---|
12 | unit TntStrEdit_Design;
|
---|
13 |
|
---|
14 | {$INCLUDE ..\Source\TntCompilers.inc}
|
---|
15 |
|
---|
16 | // The following unit is adapted from StrEdit.pas.
|
---|
17 |
|
---|
18 | interface
|
---|
19 |
|
---|
20 | uses
|
---|
21 | Windows, Classes, Graphics, Controls, Buttons, Menus, StdCtrls,
|
---|
22 | TntStdCtrls, ExtCtrls, DesignEditors, DesignIntf,
|
---|
23 | TntForms, TntMenus, TntClasses, TntDialogs;
|
---|
24 |
|
---|
25 | type
|
---|
26 | TTntStrEditDlg = class(TTntForm)
|
---|
27 | CodeWndBtn: TTntButton;
|
---|
28 | OpenDialog: TTntOpenDialog;
|
---|
29 | SaveDialog: TTntSaveDialog;
|
---|
30 | HelpButton: TTntButton;
|
---|
31 | OKButton: TTntButton;
|
---|
32 | CancelButton: TTntButton;
|
---|
33 | StringEditorMenu: TTntPopupMenu;
|
---|
34 | LoadItem: TTntMenuItem;
|
---|
35 | SaveItem: TTntMenuItem;
|
---|
36 | CodeEditorItem: TTntMenuItem;
|
---|
37 | TntGroupBox1: TTntGroupBox;
|
---|
38 | UnicodeEnabledLbl: TTntLabel;
|
---|
39 | Memo: TTntMemo;
|
---|
40 | LineCount: TTntLabel;
|
---|
41 | procedure FileOpenClick(Sender: TObject);
|
---|
42 | procedure FileSaveClick(Sender: TObject);
|
---|
43 | procedure HelpButtonClick(Sender: TObject);
|
---|
44 | procedure CodeWndBtnClick(Sender: TObject);
|
---|
45 | procedure FormCreate(Sender: TObject);
|
---|
46 | procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
47 | procedure UpdateStatus(Sender: TObject);
|
---|
48 | private
|
---|
49 | SingleLine: WideString;
|
---|
50 | MultipleLines: WideString;
|
---|
51 | protected
|
---|
52 | FModified: Boolean;
|
---|
53 | function GetLines: TTntStrings;
|
---|
54 | procedure SetLines(const Value: TTntStrings);
|
---|
55 | function GetLinesControl: TWinControl;
|
---|
56 | public
|
---|
57 | property Lines: TTntStrings read GetLines write SetLines;
|
---|
58 | procedure PrepareForWideStringEdit;
|
---|
59 | end;
|
---|
60 |
|
---|
61 | type
|
---|
62 | TWideStringListProperty = class(TClassProperty)
|
---|
63 | protected
|
---|
64 | function EditDialog: TTntStrEditDlg; virtual;
|
---|
65 | function GetStrings: TTntStrings; virtual;
|
---|
66 | procedure SetStrings(const Value: TTntStrings); virtual;
|
---|
67 | public
|
---|
68 | function GetAttributes: TPropertyAttributes; override;
|
---|
69 | procedure Edit; override;
|
---|
70 | end;
|
---|
71 |
|
---|
72 | procedure Register;
|
---|
73 |
|
---|
74 | implementation
|
---|
75 |
|
---|
76 | {$R *.dfm}
|
---|
77 |
|
---|
78 | uses
|
---|
79 | ActiveX, Forms, SysUtils, DesignConst, ToolsAPI, IStreams, LibHelp,
|
---|
80 | StFilSys, TypInfo, TntSystem, TntDesignEditors_Design;
|
---|
81 |
|
---|
82 | procedure Register;
|
---|
83 | begin
|
---|
84 | RegisterPropertyEditor(TypeInfo(TTntStrings), nil, '', TWideStringListProperty);
|
---|
85 | end;
|
---|
86 |
|
---|
87 | {$IFDEF COMPILER_10_UP}
|
---|
88 | type
|
---|
89 | TStringsModuleCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator)
|
---|
90 | private
|
---|
91 | FFileName: AnsiString;
|
---|
92 | FStream: TStringStream{TNT-ALLOW TStringStream};
|
---|
93 | FAge: TDateTime;
|
---|
94 | public
|
---|
95 | constructor Create(const FileName: AnsiString; Stream: TStringStream{TNT-ALLOW TStringStream}; Age: TDateTime);
|
---|
96 | destructor Destroy; override;
|
---|
97 | { IOTACreator }
|
---|
98 | function GetCreatorType: AnsiString;
|
---|
99 | function GetExisting: Boolean;
|
---|
100 | function GetFileSystem: AnsiString;
|
---|
101 | function GetOwner: IOTAModule;
|
---|
102 | function GetUnnamed: Boolean;
|
---|
103 | { IOTAModuleCreator }
|
---|
104 | function GetAncestorName: AnsiString;
|
---|
105 | function GetImplFileName: AnsiString;
|
---|
106 | function GetIntfFileName: AnsiString;
|
---|
107 | function GetFormName: AnsiString;
|
---|
108 | function GetMainForm: Boolean;
|
---|
109 | function GetShowForm: Boolean;
|
---|
110 | function GetShowSource: Boolean;
|
---|
111 | function NewFormFile(const FormIdent, AncestorIdent: AnsiString): IOTAFile;
|
---|
112 | function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
|
---|
113 | function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: AnsiString): IOTAFile;
|
---|
114 | procedure FormCreated(const FormEditor: IOTAFormEditor);
|
---|
115 | end;
|
---|
116 |
|
---|
117 | TOTAFile = class(TInterfacedObject, IOTAFile)
|
---|
118 | private
|
---|
119 | FSource: AnsiString;
|
---|
120 | FAge: TDateTime;
|
---|
121 | public
|
---|
122 | constructor Create(const ASource: AnsiString; AAge: TDateTime);
|
---|
123 | { IOTAFile }
|
---|
124 | function GetSource: AnsiString;
|
---|
125 | function GetAge: TDateTime;
|
---|
126 | end;
|
---|
127 |
|
---|
128 | { TOTAFile }
|
---|
129 |
|
---|
130 | constructor TOTAFile.Create(const ASource: AnsiString; AAge: TDateTime);
|
---|
131 | begin
|
---|
132 | inherited Create;
|
---|
133 | FSource := ASource;
|
---|
134 | FAge := AAge;
|
---|
135 | end;
|
---|
136 |
|
---|
137 | function TOTAFile.GetAge: TDateTime;
|
---|
138 | begin
|
---|
139 | Result := FAge;
|
---|
140 | end;
|
---|
141 |
|
---|
142 | function TOTAFile.GetSource: AnsiString;
|
---|
143 | begin
|
---|
144 | Result := FSource;
|
---|
145 | end;
|
---|
146 |
|
---|
147 | { TStringsModuleCreator }
|
---|
148 |
|
---|
149 | constructor TStringsModuleCreator.Create(const FileName: AnsiString; Stream: TStringStream{TNT-ALLOW TStringStream};
|
---|
150 | Age: TDateTime);
|
---|
151 | begin
|
---|
152 | inherited Create;
|
---|
153 | FFileName := FileName;
|
---|
154 | FStream := Stream;
|
---|
155 | FAge := Age;
|
---|
156 | end;
|
---|
157 |
|
---|
158 | destructor TStringsModuleCreator.Destroy;
|
---|
159 | begin
|
---|
160 | FStream.Free;
|
---|
161 | inherited;
|
---|
162 | end;
|
---|
163 |
|
---|
164 | procedure TStringsModuleCreator.FormCreated(const FormEditor: IOTAFormEditor);
|
---|
165 | begin
|
---|
166 | { Nothing to do }
|
---|
167 | end;
|
---|
168 |
|
---|
169 | function TStringsModuleCreator.GetAncestorName: AnsiString;
|
---|
170 | begin
|
---|
171 | Result := '';
|
---|
172 | end;
|
---|
173 |
|
---|
174 | function TStringsModuleCreator.GetCreatorType: AnsiString;
|
---|
175 | begin
|
---|
176 | Result := sText;
|
---|
177 | end;
|
---|
178 |
|
---|
179 | function TStringsModuleCreator.GetExisting: Boolean;
|
---|
180 | begin
|
---|
181 | Result := True;
|
---|
182 | end;
|
---|
183 |
|
---|
184 | function TStringsModuleCreator.GetFileSystem: AnsiString;
|
---|
185 | begin
|
---|
186 | Result := sTStringsFileSystem;
|
---|
187 | end;
|
---|
188 |
|
---|
189 | function TStringsModuleCreator.GetFormName: AnsiString;
|
---|
190 | begin
|
---|
191 | Result := '';
|
---|
192 | end;
|
---|
193 |
|
---|
194 | function TStringsModuleCreator.GetImplFileName: AnsiString;
|
---|
195 | begin
|
---|
196 | Result := FFileName;
|
---|
197 | end;
|
---|
198 |
|
---|
199 | function TStringsModuleCreator.GetIntfFileName: AnsiString;
|
---|
200 | begin
|
---|
201 | Result := '';
|
---|
202 | end;
|
---|
203 |
|
---|
204 | function TStringsModuleCreator.GetMainForm: Boolean;
|
---|
205 | begin
|
---|
206 | Result := False;
|
---|
207 | end;
|
---|
208 |
|
---|
209 | function TStringsModuleCreator.GetOwner: IOTAModule;
|
---|
210 | begin
|
---|
211 | Result := nil;
|
---|
212 | end;
|
---|
213 |
|
---|
214 | function TStringsModuleCreator.GetShowForm: Boolean;
|
---|
215 | begin
|
---|
216 | Result := False;
|
---|
217 | end;
|
---|
218 |
|
---|
219 | function TStringsModuleCreator.GetShowSource: Boolean;
|
---|
220 | begin
|
---|
221 | Result := True;
|
---|
222 | end;
|
---|
223 |
|
---|
224 | function TStringsModuleCreator.GetUnnamed: Boolean;
|
---|
225 | begin
|
---|
226 | Result := False;
|
---|
227 | end;
|
---|
228 |
|
---|
229 | function TStringsModuleCreator.NewFormFile(const FormIdent,
|
---|
230 | AncestorIdent: AnsiString): IOTAFile;
|
---|
231 | begin
|
---|
232 | Result := nil;
|
---|
233 | end;
|
---|
234 |
|
---|
235 | function TStringsModuleCreator.NewImplSource(const ModuleIdent, FormIdent,
|
---|
236 | AncestorIdent: AnsiString): IOTAFile;
|
---|
237 | begin
|
---|
238 | Result := TOTAFile.Create(FStream.DataString, FAge);
|
---|
239 | end;
|
---|
240 |
|
---|
241 | function TStringsModuleCreator.NewIntfSource(const ModuleIdent, FormIdent,
|
---|
242 | AncestorIdent: AnsiString): IOTAFile;
|
---|
243 | begin
|
---|
244 | Result := nil;
|
---|
245 | end;
|
---|
246 | {$ENDIF}
|
---|
247 |
|
---|
248 | { TTntStrEditDlg }
|
---|
249 |
|
---|
250 | procedure TTntStrEditDlg.FormCreate(Sender: TObject);
|
---|
251 | begin
|
---|
252 | HelpContext := hcDStringListEditor;
|
---|
253 | OpenDialog.HelpContext := hcDStringListLoad;
|
---|
254 | SaveDialog.HelpContext := hcDStringListSave;
|
---|
255 | SingleLine := srLine;
|
---|
256 | MultipleLines := srLines;
|
---|
257 | UnicodeEnabledLbl.Visible := IsWindowUnicode(Memo.Handle);
|
---|
258 | end;
|
---|
259 |
|
---|
260 | procedure TTntStrEditDlg.PrepareForWideStringEdit;
|
---|
261 | begin
|
---|
262 | Caption := 'WideString Editor';
|
---|
263 | CodeWndBtn.Visible := False;
|
---|
264 | CodeEditorItem.Visible := False;
|
---|
265 | end;
|
---|
266 |
|
---|
267 | procedure TTntStrEditDlg.FileOpenClick(Sender: TObject);
|
---|
268 | begin
|
---|
269 | with OpenDialog do
|
---|
270 | if Execute then Lines.LoadFromFile(FileName);
|
---|
271 | end;
|
---|
272 |
|
---|
273 | procedure TTntStrEditDlg.FileSaveClick(Sender: TObject);
|
---|
274 | begin
|
---|
275 | SaveDialog.FileName := OpenDialog.FileName;
|
---|
276 | with SaveDialog do
|
---|
277 | if Execute then Lines.SaveToFile(FileName);
|
---|
278 | end;
|
---|
279 |
|
---|
280 | procedure TTntStrEditDlg.HelpButtonClick(Sender: TObject);
|
---|
281 | begin
|
---|
282 | Application.HelpContext(HelpContext);
|
---|
283 | end;
|
---|
284 |
|
---|
285 | procedure TTntStrEditDlg.CodeWndBtnClick(Sender: TObject);
|
---|
286 | begin
|
---|
287 | ModalResult := mrYes;
|
---|
288 | end;
|
---|
289 |
|
---|
290 | function TTntStrEditDlg.GetLinesControl: TWinControl;
|
---|
291 | begin
|
---|
292 | Result := Memo;
|
---|
293 | end;
|
---|
294 |
|
---|
295 | procedure TTntStrEditDlg.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
296 | begin
|
---|
297 | if Key = VK_ESCAPE then CancelButton.Click;
|
---|
298 | end;
|
---|
299 |
|
---|
300 | procedure TTntStrEditDlg.UpdateStatus(Sender: TObject);
|
---|
301 | var
|
---|
302 | Count: Integer;
|
---|
303 | LineText: WideString;
|
---|
304 | begin
|
---|
305 | if Sender = Memo then FModified := True;
|
---|
306 | Count := Lines.Count;
|
---|
307 | if Count = 1 then LineText := SingleLine
|
---|
308 | else LineText := MultipleLines;
|
---|
309 | LineCount.Caption := WideFormat('%d %s', [Count, LineText]);
|
---|
310 | end;
|
---|
311 |
|
---|
312 | function TTntStrEditDlg.GetLines: TTntStrings;
|
---|
313 | begin
|
---|
314 | Result := Memo.Lines;
|
---|
315 | end;
|
---|
316 |
|
---|
317 | procedure TTntStrEditDlg.SetLines(const Value: TTntStrings);
|
---|
318 | begin
|
---|
319 | Memo.Lines.Assign(Value);
|
---|
320 | end;
|
---|
321 |
|
---|
322 | { TWideStringListProperty }
|
---|
323 |
|
---|
324 | function TWideStringListProperty.EditDialog: TTntStrEditDlg;
|
---|
325 | begin
|
---|
326 | Result := TTntStrEditDlg.Create(Application);
|
---|
327 | end;
|
---|
328 |
|
---|
329 | function TWideStringListProperty.GetAttributes: TPropertyAttributes;
|
---|
330 | begin
|
---|
331 | Result := inherited GetAttributes + [paDialog] - [paSubProperties];
|
---|
332 | end;
|
---|
333 |
|
---|
334 | function TWideStringListProperty.GetStrings: TTntStrings;
|
---|
335 | begin
|
---|
336 | Result := TTntStrings(GetOrdValue);
|
---|
337 | end;
|
---|
338 |
|
---|
339 | procedure TWideStringListProperty.SetStrings(const Value: TTntStrings);
|
---|
340 | begin
|
---|
341 | SetOrdValue(Longint(Value));
|
---|
342 | end;
|
---|
343 |
|
---|
344 | procedure TWideStringListProperty.Edit;
|
---|
345 | {$IFDEF COMPILER_10_UP}
|
---|
346 | const
|
---|
347 | DotSep = '.'; // Temp fix for opening the strings in the editor.
|
---|
348 | var
|
---|
349 | Ident: AnsiString;
|
---|
350 | Component: TComponent;
|
---|
351 | Module: IOTAModule;
|
---|
352 | Editor: IOTAEditor;
|
---|
353 | ModuleServices: IOTAModuleServices;
|
---|
354 | Stream: TStringStream{TNT-ALLOW TStringStream};
|
---|
355 | Age: TDateTime;
|
---|
356 | {$ENDIF}
|
---|
357 | begin
|
---|
358 | {$IFDEF COMPILER_10_UP}
|
---|
359 | Component := TComponent(GetComponent(0));
|
---|
360 | ModuleServices := BorlandIDEServices as IOTAModuleServices;
|
---|
361 | if (TObject(Component) is TComponent)
|
---|
362 | and (Component.Owner = Self.Designer.GetRoot)
|
---|
363 | and (Self.Designer.GetRoot.Name <> '')
|
---|
364 | then begin
|
---|
365 | Ident := Self.Designer.GetRoot.Name + DotSep +
|
---|
366 | Component.Name + DotSep + GetName;
|
---|
367 | Ident := Self.Designer.GetDesignerExtension + DotSep + Ident;
|
---|
368 | Module := ModuleServices.FindModule(Ident);
|
---|
369 | end else begin
|
---|
370 | Ident := '';
|
---|
371 | Module := nil;
|
---|
372 | end;
|
---|
373 | if (Module <> nil) and (Module.GetModuleFileCount > 0) then
|
---|
374 | Module.GetModuleFileEditor(0).Show
|
---|
375 | else
|
---|
376 | {$ENDIF}
|
---|
377 | with EditDialog do
|
---|
378 | try
|
---|
379 | if GetObjectInspectorForm <> nil then
|
---|
380 | Font.Assign(GetObjectInspectorForm.Font);
|
---|
381 | Lines := GetStrings;
|
---|
382 | UpdateStatus(nil);
|
---|
383 | FModified := False;
|
---|
384 | ActiveControl := GetLinesControl;
|
---|
385 | {$IFDEF COMPILER_10_UP}
|
---|
386 | CodeEditorItem.Enabled := Ident <> '';
|
---|
387 | CodeWndBtn.Enabled := Ident <> '';
|
---|
388 | {$ENDIF}
|
---|
389 | case ShowModal of
|
---|
390 | mrOk: SetStrings(Lines);
|
---|
391 | {$IFDEF COMPILER_10_UP}
|
---|
392 | mrYes:
|
---|
393 | begin
|
---|
394 | // this used to be done in LibMain's TLibrary.Create but now its done here
|
---|
395 | // the unregister is done over in ComponentDesigner's finalization
|
---|
396 | //StFilSys.Register;
|
---|
397 | Stream := TStringStream{TNT-ALLOW TStringStream}.Create(WideStringToUTF8(Lines.Text));
|
---|
398 | Stream.Position := 0;
|
---|
399 | Age := Now;
|
---|
400 | Module := ModuleServices.CreateModule(
|
---|
401 | TStringsModuleCreator.Create(Ident, Stream, Age));
|
---|
402 | if Module <> nil then
|
---|
403 | begin
|
---|
404 | with StringsFileSystem.GetTStringsProperty(Ident, Component, GetName) do
|
---|
405 | DiskAge := DateTimeToFileDate(Age);
|
---|
406 | Editor := Module.GetModuleFileEditor(0);
|
---|
407 | if FModified then
|
---|
408 | Editor.MarkModified;
|
---|
409 | Editor.Show;
|
---|
410 | end;
|
---|
411 | end;
|
---|
412 | {$ENDIF}
|
---|
413 | end;
|
---|
414 | finally
|
---|
415 | Free;
|
---|
416 | end;
|
---|
417 | end;
|
---|
418 |
|
---|
419 | end.
|
---|