1 | unit dShared;
|
---|
2 | interface
|
---|
3 |
|
---|
4 | uses
|
---|
5 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
6 | ComCtrls, ImgList, uTemplates, ORFn, ORNet, ExtCtrls, ORCtrls, Richedit;
|
---|
7 |
|
---|
8 | type
|
---|
9 | TdmodShared = class(TDataModule)
|
---|
10 | imgTemplates: TImageList;
|
---|
11 | imgReminders: TImageList;
|
---|
12 | imgNotes: TImageList;
|
---|
13 | imgImages: TImageList;
|
---|
14 | imgReminders2: TImageList;
|
---|
15 | imgConsults: TImageList;
|
---|
16 | imgSurgery: TImageList;
|
---|
17 | procedure dmodSharedCreate(Sender: TObject);
|
---|
18 | procedure dmodSharedDestroy(Sender: TObject);
|
---|
19 | private
|
---|
20 | FTIUObjects: TStringList;
|
---|
21 | FInEditor: boolean;
|
---|
22 | FOnTemplateLock: TNotifyEvent;
|
---|
23 | FTagIndex: longint;
|
---|
24 | FDrawerTrees: TList;
|
---|
25 | FRefreshObject: boolean;
|
---|
26 | protected
|
---|
27 | procedure EncounterLocationChanged(Sender: TObject);
|
---|
28 | public
|
---|
29 | function ImgIdx(Node: TTreeNode): integer;
|
---|
30 | procedure AddTemplateNode(Tree: TTreeView; var EmptyCount: integer;
|
---|
31 | const tmpl: TTemplate; AllowInactive: boolean = FALSE;
|
---|
32 | const Owner: TTreeNode = nil);
|
---|
33 | function ExpandNode(Tree: TTreeView; Node: TTreeNode;
|
---|
34 | var EmptyCount: integer; AllowInactive: boolean = FALSE): boolean;
|
---|
35 | procedure Resync(SyncNode: TTreeNode; AllowInactive: boolean;
|
---|
36 | var EmptyCount: integer);
|
---|
37 | procedure AddDrawerTree(DrawerForm: TForm);
|
---|
38 | procedure RemoveDrawerTree(DrawerForm: TForm);
|
---|
39 | procedure Reload;
|
---|
40 | procedure LoadTIUObjects;
|
---|
41 | function BoilerplateOK(const Txt, CRDelim: string; ObjList: TStringList;
|
---|
42 | var Err: TStringList): boolean;
|
---|
43 | function TemplateOK(tmpl: TTemplate; Msg: string = ''): boolean;
|
---|
44 | function NeedsCollapsing(Tree: TTreeView): boolean;
|
---|
45 | procedure SelectNode(Tree: TORTreeView; GotoNodeID: string; var EmptyCount: integer);
|
---|
46 | procedure ExpandTree(Tree: TORTreeView; ExpandString: string; var EmptyCount: integer;
|
---|
47 | AllowInactive: boolean = FALSE);
|
---|
48 | function InDialog(Node: TTreeNode): boolean;
|
---|
49 | property InEditor: boolean read FInEditor write FInEditor;
|
---|
50 | property OnTemplateLock: TNotifyEvent read FOnTemplateLock write FOnTemplateLock;
|
---|
51 | property TIUObjects: TStringList read FTIUObjects;
|
---|
52 | property RefreshObject: boolean read FRefreshObject write FRefreshObject;
|
---|
53 | procedure FindRichEditText(AFindDialog: TFindDialog; ARichEdit: TRichEdit);
|
---|
54 | procedure ReplaceRichEditText(AReplaceDialog: TReplaceDialog; ARichEdit: TRichEdit);
|
---|
55 | end;
|
---|
56 |
|
---|
57 | var
|
---|
58 | dmodShared: TdmodShared;
|
---|
59 |
|
---|
60 | const
|
---|
61 | ObjMarker = '^@@^';
|
---|
62 | ObjMarkerLen = length(ObjMarker);
|
---|
63 | DlgPropMarker = '^@=';
|
---|
64 | DlgPropMarkerLen = length(DlgPropMarker);
|
---|
65 | NoTextMarker = '<@>';
|
---|
66 |
|
---|
67 | implementation
|
---|
68 |
|
---|
69 | uses fDrawers, rTemplates, uCore, uTemplateFields, uEventHooks;
|
---|
70 |
|
---|
71 | {$R *.DFM}
|
---|
72 |
|
---|
73 | const
|
---|
74 | TemplateImageIdx: array[TTemplateType, Boolean, Boolean] of integer =
|
---|
75 | // Personal Shared
|
---|
76 | // Closed Open Closed Open
|
---|
77 | ((( 0, 0), ( 0, 0)), // ttNone,
|
---|
78 | (( 0, 1), ( 0, 1)), // ttMyRoot
|
---|
79 | (( 0, 1), ( 0, 1)), // ttRoot
|
---|
80 | (( 0, 1), ( 0, 1)), // ttTitles
|
---|
81 | (( 0, 1), ( 0, 1)), // ttConsults
|
---|
82 | (( 0, 1), ( 0, 1)), // ttProcedures
|
---|
83 | (( 2, 3), ( 16, 17)), // ttClass
|
---|
84 | (( 4, 4), ( 10, 10)), // ttDoc
|
---|
85 | (( 5, 6), ( 11, 12)), // ttGroup
|
---|
86 | (( 7, 7), ( 13, 13)), // ttDocEx
|
---|
87 | (( 8, 9), ( 14, 15))); // ttGroupEx
|
---|
88 |
|
---|
89 | DialogConvMax = 7;
|
---|
90 | DialogImageXRef: array[0..DialogConvMax, Boolean] of integer =
|
---|
91 | ((5,18), (6,19),
|
---|
92 | (8,20), (9,21),
|
---|
93 | (11,22),(12,23),
|
---|
94 | (14,24),(15,25));
|
---|
95 |
|
---|
96 | RemDlgIdx: array[boolean] of integer = (26, 27);
|
---|
97 | COMObjIdx: array[boolean] of integer = (29, 28);
|
---|
98 |
|
---|
99 | function TdmodShared.ImgIdx(Node: TTreeNode): integer;
|
---|
100 | var
|
---|
101 | Typ: TTemplateType;
|
---|
102 | i: integer;
|
---|
103 |
|
---|
104 | begin
|
---|
105 | Result := -1;
|
---|
106 | if(assigned(Node.Data)) then
|
---|
107 | begin
|
---|
108 | with TTemplate(Node.Data) do
|
---|
109 | begin
|
---|
110 | if (RealType = ttDoc) and (IsReminderDialog) then
|
---|
111 | Result := RemDlgIdx[(PersonalOwner <= 0)]
|
---|
112 | else
|
---|
113 | if (RealType = ttDoc) and (IsCOMObject) then
|
---|
114 | Result := COMObjIdx[COMObjectOK(COMObject)]
|
---|
115 | else
|
---|
116 | begin
|
---|
117 | Typ := TemplateType;
|
---|
118 | if(Exclude and (Typ in [ttDocEx, ttGroupEx])) then
|
---|
119 | begin
|
---|
120 | if(not assigned(Node.Parent)) or (TTemplate(Node.Parent.Data).RealType <> ttGroup) then
|
---|
121 | begin
|
---|
122 | case Typ of
|
---|
123 | ttDocEx: Typ := ttDoc;
|
---|
124 | ttGroupEx: Typ := ttGroup;
|
---|
125 | end;
|
---|
126 | end;
|
---|
127 | end;
|
---|
128 | Result := TemplateImageIdx[Typ, (PersonalOwner <= 0),
|
---|
129 | (Node.Expanded and Node.HasChildren)];
|
---|
130 | if(Dialog and (Typ in [ttGroup, ttGroupEx])) then
|
---|
131 | begin
|
---|
132 | for i := 0 to DialogConvMax do
|
---|
133 | begin
|
---|
134 | if(Result = DialogImageXRef[i, FALSE]) then
|
---|
135 | begin
|
---|
136 | Result := DialogImageXRef[i, TRUE];
|
---|
137 | break;
|
---|
138 | end;
|
---|
139 | end;
|
---|
140 | end;
|
---|
141 | end;
|
---|
142 | end;
|
---|
143 | end;
|
---|
144 | end;
|
---|
145 |
|
---|
146 | procedure TdmodShared.AddTemplateNode(Tree: TTreeView; var EmptyCount: integer;
|
---|
147 | const tmpl: TTemplate; AllowInactive: boolean = FALSE;
|
---|
148 | const Owner: TTreeNode = nil);
|
---|
149 | var
|
---|
150 | Cur, Next: TTreeNode;
|
---|
151 | Done: boolean;
|
---|
152 | NewNode: TTreeNode;
|
---|
153 |
|
---|
154 | procedure AddChildObject(Owner: TTreeNode);
|
---|
155 | begin
|
---|
156 | NewNode := Tree.Items.AddChildObject(Owner, tmpl.PrintName, tmpl);
|
---|
157 | TORTreeNode(NewNode).StringData := tmpl.ID + U + tmpl.PrintName;
|
---|
158 | NewNode.Cut := not tmpl.Active;
|
---|
159 | tmpl.AddNode(NewNode);
|
---|
160 | Done := TRUE;
|
---|
161 | end;
|
---|
162 |
|
---|
163 | begin
|
---|
164 | if((assigned(tmpl)) and ((tmpl.Active) or AllowInactive)) then
|
---|
165 | begin
|
---|
166 | Done := FALSE;
|
---|
167 | NewNode := nil;
|
---|
168 | if(assigned(Owner)) then
|
---|
169 | begin
|
---|
170 | Cur := Owner.GetFirstChild;
|
---|
171 | if(not assigned(Cur)) then
|
---|
172 | AddChildObject(Owner);
|
---|
173 | end
|
---|
174 | else
|
---|
175 | begin
|
---|
176 | Cur := Tree.Items.GetFirstNode;
|
---|
177 | if(not assigned(Cur)) then
|
---|
178 | AddChildObject(nil);
|
---|
179 | end;
|
---|
180 | if(not Done) then
|
---|
181 | begin
|
---|
182 | repeat
|
---|
183 | if(Cur.Data = tmpl) then
|
---|
184 | Done := TRUE
|
---|
185 | else
|
---|
186 | begin
|
---|
187 | Next := Cur.GetNextSibling;
|
---|
188 | if(assigned(Next)) then
|
---|
189 | Cur := Next
|
---|
190 | else
|
---|
191 | AddChildObject(Owner);
|
---|
192 | end;
|
---|
193 | until Done;
|
---|
194 | end;
|
---|
195 | if(assigned(NewNode) and (InEditor or (not tmpl.HideItems)) and
|
---|
196 | ((tmpl.Children in [tcActive, tcBoth]) or
|
---|
197 | ((tmpl.Children <> tcNone) and AllowInactive))) then
|
---|
198 | begin
|
---|
199 | Tree.Items.AddChild(NewNode, EmptyNodeText);
|
---|
200 | inc(EmptyCount);
|
---|
201 | end;
|
---|
202 | end;
|
---|
203 | end;
|
---|
204 |
|
---|
205 | function TdmodShared.ExpandNode(Tree: TTreeView; Node: TTreeNode;
|
---|
206 | var EmptyCount: integer; AllowInactive: boolean = FALSE): boolean;
|
---|
207 |
|
---|
208 | var
|
---|
209 | TmpNode: TTreeNode;
|
---|
210 | tmpl: TTemplate;
|
---|
211 | i :integer;
|
---|
212 |
|
---|
213 | begin
|
---|
214 | TmpNode := Node.GetFirstChild;
|
---|
215 | Result := TRUE;
|
---|
216 | if((assigned(TmpNode)) and (TmpNode.Text = EmptyNodeText)) then
|
---|
217 | begin
|
---|
218 | TmpNode.Delete;
|
---|
219 | dec(EmptyCount);
|
---|
220 | tmpl := TTemplate(Node.Data);
|
---|
221 | ExpandTemplate(tmpl);
|
---|
222 | for i := 0 to tmpl.Items.Count-1 do
|
---|
223 | AddTemplateNode(Tree, EmptyCount, TTemplate(tmpl.Items[i]),
|
---|
224 | AllowInactive, Node);
|
---|
225 | if((tmpl.Children = tcNone) or ((not AllowInactive) and (tmpl.Children = tcInactive))) then
|
---|
226 | Result := FALSE;
|
---|
227 | end;
|
---|
228 | end;
|
---|
229 |
|
---|
230 | procedure TdmodShared.Resync(SyncNode: TTreeNode; AllowInactive: boolean;
|
---|
231 | var EmptyCount: integer);
|
---|
232 | var
|
---|
233 | FromGet: boolean;
|
---|
234 | IDCount, SyncLevel, i: integer;
|
---|
235 | SyncExpanded: boolean;
|
---|
236 | //SelNode,
|
---|
237 | Node: TTreeNode;
|
---|
238 | Template: TTemplate;
|
---|
239 | IDSort, CurExp: TStringList;
|
---|
240 | SelID, TopID: string;
|
---|
241 | DoSel, DoTop: boolean;
|
---|
242 | Tree: TTreeView;
|
---|
243 | First: boolean;
|
---|
244 | TagCount: longint;
|
---|
245 |
|
---|
246 | function InSyncNode(Node: TTreeNode): boolean;
|
---|
247 | var
|
---|
248 | TmpNode: TTreeNode;
|
---|
249 |
|
---|
250 | begin
|
---|
251 | Result := FALSE;
|
---|
252 | TmpNode := Node;
|
---|
253 | while((not Result) and assigned(TmpNode)) do
|
---|
254 | begin
|
---|
255 | if(TmpNode = SyncNode) then
|
---|
256 | Result := TRUE
|
---|
257 | else
|
---|
258 | TmpNode := TmpNode.Parent;
|
---|
259 | end;
|
---|
260 | end;
|
---|
261 |
|
---|
262 | function GetID(Node: TTreeNode): string;
|
---|
263 | var
|
---|
264 | tmpl: TTemplate;
|
---|
265 | IDX: string;
|
---|
266 |
|
---|
267 | begin
|
---|
268 | inc(IDCount);
|
---|
269 | Result := '';
|
---|
270 | if(assigned(Node) and assigned(Node.Data)) then
|
---|
271 | begin
|
---|
272 | tmpl := TTemplate(Node.Data);
|
---|
273 | if((tmpl.ID = '') or (tmpl.ID = '0')) then
|
---|
274 | begin
|
---|
275 | if(tmpl.LastTagIndex <> FTagIndex) then
|
---|
276 | begin
|
---|
277 | tmpl.LastTagIndex := FTagIndex;
|
---|
278 | inc(TagCount);
|
---|
279 | tmpl.tag := TagCount;
|
---|
280 | end;
|
---|
281 | IDX := '<'+IntToStr(tmpl.Tag)+'>';
|
---|
282 | end
|
---|
283 | else
|
---|
284 | IDX := tmpl.ID;
|
---|
285 | if(Node <> SyncNode) and (assigned(Node.Parent)) then
|
---|
286 | Result := U + GetID(Node.Parent);
|
---|
287 | Result := IDX + Result;
|
---|
288 | end;
|
---|
289 | dec(IDCount);
|
---|
290 | if((not FromGet) and (IDCount = 0) and (Result <> '')) then
|
---|
291 | Result := IntToStr(Node.AbsoluteIndex) + U + Result;
|
---|
292 | end;
|
---|
293 |
|
---|
294 | function GetNode(ID: string): TTreeNode;
|
---|
295 | var
|
---|
296 | idx, i :integer;
|
---|
297 | TrueID, TmpStr: string;
|
---|
298 | TmpNode: TTreeNode;
|
---|
299 |
|
---|
300 | begin
|
---|
301 | Result := nil;
|
---|
302 | if(ID <> '') then
|
---|
303 | begin
|
---|
304 | idx := StrToIntDef(Piece(ID,U,1),0);
|
---|
305 | i := pos(U,ID);
|
---|
306 | if(i > 0) then
|
---|
307 | begin
|
---|
308 | delete(ID,1,i);
|
---|
309 | FromGet := TRUE;
|
---|
310 | try
|
---|
311 | TmpNode := SyncNode.GetFirstChild;
|
---|
312 | while ((not assigned(Result)) and (assigned(TmpNode)) and
|
---|
313 | (TmpNode.Level > SyncLevel)) do
|
---|
314 | begin
|
---|
315 | if(GetID(TmpNode) = ID) then
|
---|
316 | Result := TmpNode
|
---|
317 | else
|
---|
318 | TmpNode := TmpNode.GetNext;
|
---|
319 | end;
|
---|
320 | if(not assigned(Result)) then
|
---|
321 | begin
|
---|
322 | TrueID := piece(ID,U,1);
|
---|
323 | TmpNode := SyncNode.GetFirstChild;
|
---|
324 | while ((not assigned(Result)) and (assigned(TmpNode)) and
|
---|
325 | (TmpNode.Level > SyncLevel)) do
|
---|
326 | begin
|
---|
327 | if(assigned(TmpNode.Data) and (TTemplate(TmpNode.Data).ID = TrueID)) then
|
---|
328 | begin
|
---|
329 | TmpStr := IntToStr(abs(idx-TmpNode.AbsoluteIndex));
|
---|
330 | TmpStr := copy('000000',1,7-length(TmpStr))+TmpStr;
|
---|
331 | IDSort.AddObject(TmpStr,TmpNode);
|
---|
332 | end;
|
---|
333 | TmpNode := TmpNode.GetNext;
|
---|
334 | end;
|
---|
335 | if(IDSort.Count > 0) then
|
---|
336 | begin
|
---|
337 | IDSort.Sort;
|
---|
338 | Result := TTreeNode(IDSort.Objects[0]);
|
---|
339 | IDSort.Clear;
|
---|
340 | end;
|
---|
341 | end;
|
---|
342 | finally
|
---|
343 | FromGet := FALSE;
|
---|
344 | end;
|
---|
345 | end;
|
---|
346 | end;
|
---|
347 | end;
|
---|
348 |
|
---|
349 | procedure BuildNodes(tmpl: TTemplate; Owner: TTreeNode);
|
---|
350 | var
|
---|
351 | i: integer;
|
---|
352 | TmpNode: TTreeNode;
|
---|
353 |
|
---|
354 | begin
|
---|
355 | if(tmpl.Active or AllowInactive) then
|
---|
356 | begin
|
---|
357 | if(First) then
|
---|
358 | begin
|
---|
359 | First := FALSE;
|
---|
360 | TmpNode := Owner;
|
---|
361 | end
|
---|
362 | else
|
---|
363 | begin
|
---|
364 | TmpNode := Tree.Items.AddChildObject(Owner, tmpl.PrintName, tmpl);
|
---|
365 | TORTreeNode(TmpNode).StringData := tmpl.ID + U + tmpl.PrintName;
|
---|
366 | TmpNode.Cut := not tmpl.Active;
|
---|
367 | tmpl.AddNode(TmpNode);
|
---|
368 | end;
|
---|
369 | if(tmpl.Expanded) then
|
---|
370 | begin
|
---|
371 | for i := 0 to tmpl.Items.Count-1 do
|
---|
372 | BuildNodes(TTemplate(tmpl.Items[i]), TmpNode);
|
---|
373 | end
|
---|
374 | else
|
---|
375 | if(InEditor or (not tmpl.HideItems)) and
|
---|
376 | ((tmpl.Children in [tcActive, tcBoth]) or
|
---|
377 | (AllowInactive and (tmpl.Children = tcInactive))) then
|
---|
378 | begin
|
---|
379 | Tree.Items.AddChild(TmpNode, EmptyNodeText);
|
---|
380 | inc(EmptyCount);
|
---|
381 | end;
|
---|
382 | end;
|
---|
383 | end;
|
---|
384 |
|
---|
385 | begin
|
---|
386 | if(assigned(SyncNode)) then
|
---|
387 | begin
|
---|
388 | TagCount := 0;
|
---|
389 | inc(FTagIndex);
|
---|
390 | Tree := TTreeView(SyncNode.TreeView);
|
---|
391 | Tree.Items.BeginUpdate;
|
---|
392 | try
|
---|
393 | SyncExpanded := SyncNode.Expanded;
|
---|
394 | Template := TTemplate(SyncNode.Data);
|
---|
395 | SyncLevel := SyncNode.Level;
|
---|
396 | FromGet := FALSE;
|
---|
397 | IDCount := 0;
|
---|
398 | IDSort := TStringList.Create;
|
---|
399 | try
|
---|
400 | {-- Get the Current State of the tree --}
|
---|
401 | CurExp := TStringList.Create;
|
---|
402 | try
|
---|
403 | Node := Tree.TopItem;
|
---|
404 | DoTop := InSyncNode(Node);
|
---|
405 | if(DoTop) then
|
---|
406 | TopID := GetID(Node);
|
---|
407 |
|
---|
408 | Node := Tree.Selected;
|
---|
409 | DoSel := InSyncNode(Node);
|
---|
410 | if(DoSel) then
|
---|
411 | SelID := GetID(Node);
|
---|
412 |
|
---|
413 | Node := SyncNode.GetFirstChild;
|
---|
414 | while ((assigned(Node)) and (Node.Level > SyncLevel)) do
|
---|
415 | begin
|
---|
416 | if(Node.Text = EmptyNodeText) then
|
---|
417 | dec(EmptyCount)
|
---|
418 | else
|
---|
419 | if(Node.Expanded) then
|
---|
420 | CurExp.Add(GetID(Node));
|
---|
421 | if(assigned(Node.Data)) then
|
---|
422 | TTemplate(Node.Data).RemoveNode(Node);
|
---|
423 | Node := Node.GetNext;
|
---|
424 | end;
|
---|
425 |
|
---|
426 | {-- Recursively Rebuild the Tree --}
|
---|
427 | SyncNode.DeleteChildren;
|
---|
428 | First := TRUE;
|
---|
429 | BuildNodes(Template, SyncNode);
|
---|
430 |
|
---|
431 | {-- Attempt to restore Tree to it's former State --}
|
---|
432 | SyncNode.Expanded := SyncExpanded;
|
---|
433 | for i := 0 to CurExp.Count-1 do
|
---|
434 | begin
|
---|
435 | Node := GetNode(CurExp[i]);
|
---|
436 | if(assigned(Node)) then
|
---|
437 | Node.Expand(FALSE);
|
---|
438 | end;
|
---|
439 |
|
---|
440 | if(DoTop) and (TopID <> '') then
|
---|
441 | begin
|
---|
442 | Node := GetNode(TopID);
|
---|
443 | if(assigned(Node)) then
|
---|
444 | Tree.TopItem := Node;
|
---|
445 | end;
|
---|
446 |
|
---|
447 | if(DoSel) and (SelID <> '') then
|
---|
448 | begin
|
---|
449 | Node := GetNode(SelID);
|
---|
450 | if(assigned(Node)) then
|
---|
451 | begin
|
---|
452 | Tree.Selected := Node;
|
---|
453 | Node.MakeVisible;
|
---|
454 | end;
|
---|
455 | end;
|
---|
456 |
|
---|
457 | finally
|
---|
458 | CurExp.Free;
|
---|
459 | end;
|
---|
460 |
|
---|
461 | finally
|
---|
462 | IDSort.Free;
|
---|
463 | end;
|
---|
464 |
|
---|
465 | finally
|
---|
466 | Tree.Items.EndUpdate;
|
---|
467 | end;
|
---|
468 | end;
|
---|
469 | end;
|
---|
470 |
|
---|
471 |
|
---|
472 | procedure TdmodShared.dmodSharedCreate(Sender: TObject);
|
---|
473 | begin
|
---|
474 | FDrawerTrees := TList.Create;
|
---|
475 | imgReminders.Overlay(6,0);
|
---|
476 | imgReminders.Overlay(7,1);
|
---|
477 | imgReminders2.Overlay(4,0);
|
---|
478 | end;
|
---|
479 |
|
---|
480 | procedure TdmodShared.dmodSharedDestroy(Sender: TObject);
|
---|
481 | begin
|
---|
482 | KillObj(@FDrawerTrees);
|
---|
483 | KillObj(@FTIUObjects);
|
---|
484 | end;
|
---|
485 |
|
---|
486 | procedure TdmodShared.AddDrawerTree(DrawerForm: TForm);
|
---|
487 | begin
|
---|
488 | if(assigned(FDrawerTrees)) and (FDrawerTrees.IndexOf(DrawerForm) < 0) then
|
---|
489 | FDrawerTrees.Add(DrawerForm);
|
---|
490 | Encounter.Notifier.NotifyWhenChanged(EncounterLocationChanged);
|
---|
491 | end;
|
---|
492 |
|
---|
493 | procedure TdmodShared.RemoveDrawerTree(DrawerForm: TForm);
|
---|
494 | var
|
---|
495 | idx: integer;
|
---|
496 |
|
---|
497 | begin
|
---|
498 | if(assigned(FDrawerTrees)) then
|
---|
499 | begin
|
---|
500 | idx := FDrawerTrees.IndexOf(DrawerForm);
|
---|
501 | if(idx >= 0) then
|
---|
502 | FDrawerTrees.Delete(idx);
|
---|
503 | end;
|
---|
504 | end;
|
---|
505 |
|
---|
506 | procedure TdmodShared.Reload;
|
---|
507 | var
|
---|
508 | i: integer;
|
---|
509 |
|
---|
510 | begin
|
---|
511 | if(assigned(FDrawerTrees)) then
|
---|
512 | begin
|
---|
513 | ReleaseTemplates;
|
---|
514 | for i := 0 to FDrawerTrees.Count-1 do
|
---|
515 | TfrmDrawers(FDrawerTrees[i]).ExternalReloadTemplates;
|
---|
516 | end;
|
---|
517 | end;
|
---|
518 |
|
---|
519 | procedure TdmodShared.LoadTIUObjects;
|
---|
520 | var
|
---|
521 | i: integer;
|
---|
522 |
|
---|
523 | begin
|
---|
524 | if(not assigned(FTIUObjects)) or (FRefreshObject = true) then
|
---|
525 | begin
|
---|
526 | if(not assigned(FTIUObjects)) then
|
---|
527 | FTIUObjects := TStringList.Create;
|
---|
528 | FTIUObjects.Clear;
|
---|
529 | GetObjectList;
|
---|
530 | for i := 0 to RPCBrokerV.Results.Count-1 do
|
---|
531 | FTIUObjects.Add(MixedCase(Piece(RPCBrokerV.Results[i],U,2))+U+RPCBrokerV.Results[i]);
|
---|
532 | FTIUObjects.Sort;
|
---|
533 | FRefreshObject := False;
|
---|
534 | end;
|
---|
535 | end;
|
---|
536 |
|
---|
537 | function TdmodShared.NeedsCollapsing(Tree: TTreeView): boolean;
|
---|
538 | var
|
---|
539 | Node: TTreeNode;
|
---|
540 |
|
---|
541 | begin
|
---|
542 | Result := FALSE;
|
---|
543 | if(assigned(Tree)) then
|
---|
544 | begin
|
---|
545 | Node := Tree.Items.GetFirstNode;
|
---|
546 | while((not Result) and assigned(Node)) do
|
---|
547 | begin
|
---|
548 | Result := Node.Expanded;
|
---|
549 | Node := Node.GetNextSibling;
|
---|
550 | end;
|
---|
551 | end;
|
---|
552 | end;
|
---|
553 |
|
---|
554 | function TdmodShared.BoilerplateOK(const Txt, CRDelim: string; ObjList: TStringList;
|
---|
555 | var Err: TStringList): boolean;
|
---|
556 | var
|
---|
557 | cnt, i, j, p: integer;
|
---|
558 | tmp,obj: string;
|
---|
559 | BadObj, ok: boolean;
|
---|
560 |
|
---|
561 | procedure AddErr(Amsg: string);
|
---|
562 | begin
|
---|
563 | if(not assigned(Err)) then
|
---|
564 | Err := TStringList.Create;
|
---|
565 | Err.Add(Amsg)
|
---|
566 | end;
|
---|
567 |
|
---|
568 | function ErrCount: integer;
|
---|
569 | begin
|
---|
570 | if(Assigned(Err)) then
|
---|
571 | Result := Err.Count
|
---|
572 | else
|
---|
573 | Result := 0;
|
---|
574 | end;
|
---|
575 |
|
---|
576 | begin
|
---|
577 | if(assigned(ObjList)) then
|
---|
578 | ObjList.Clear;
|
---|
579 | cnt := ErrCount;
|
---|
580 | tmp := Txt;
|
---|
581 | BadObj := FALSE;
|
---|
582 | repeat
|
---|
583 | i := pos('|',tmp);
|
---|
584 | if(i > 0) then
|
---|
585 | begin
|
---|
586 | delete(tmp,1,i);
|
---|
587 | j := pos('|',tmp);
|
---|
588 | if(j = 0) then
|
---|
589 | begin
|
---|
590 | AddErr('Unpaired "|" in Boilerplate');
|
---|
591 | continue;
|
---|
592 | end;
|
---|
593 | obj := copy(tmp,1,j-1);
|
---|
594 | delete(tmp,1,j);
|
---|
595 | if(obj = '') then
|
---|
596 | begin
|
---|
597 | AddErr('Brackets "||" are there, but there''s no name inside it.');
|
---|
598 | continue;
|
---|
599 | end;
|
---|
600 | j := pos(CRDelim, obj);
|
---|
601 | if(j > 0) then
|
---|
602 | begin
|
---|
603 | AddErr('Object "'+copy(obj,1,j-1)+'" split between lines');
|
---|
604 | continue;
|
---|
605 | end;
|
---|
606 | LoadTIUObjects;
|
---|
607 | ok := FALSE;
|
---|
608 | for j := 0 to FTIUObjects.Count-1 do
|
---|
609 | begin
|
---|
610 | for p := 3 to 5 do
|
---|
611 | begin
|
---|
612 | if(obj = piece(FTIUObjects[j],U,p)) then
|
---|
613 | begin
|
---|
614 | ok := TRUE;
|
---|
615 | if(assigned(ObjList)) and (ObjList.IndexOf(ObjMarker + obj) < 0) then
|
---|
616 | begin
|
---|
617 | ObjList.Add(ObjMarker + obj);
|
---|
618 | ObjList.Add('|' + obj + '|');
|
---|
619 | end;
|
---|
620 | break;
|
---|
621 | end;
|
---|
622 | end;
|
---|
623 | if(ok) then break;
|
---|
624 | end;
|
---|
625 | if(not ok) then
|
---|
626 | begin
|
---|
627 | AddErr('Object "'+obj+'" not found.');
|
---|
628 | BadObj := TRUE;
|
---|
629 | end;
|
---|
630 | end;
|
---|
631 | until(i=0);
|
---|
632 | Result := (cnt = ErrCount);
|
---|
633 | if(not Result) then
|
---|
634 | begin
|
---|
635 | Err.Insert(0,'Boilerplate Contains Errors:');
|
---|
636 | Err.Insert(1,'');
|
---|
637 | if(BadObj) then
|
---|
638 | begin
|
---|
639 | Err.Add('');
|
---|
640 | Err.Add('Use UPPERCASE and object''s exact NAME, PRINT NAME, or ABBREVIATION');
|
---|
641 | Err.Add('Any of these may have changed since an object was embedded.');
|
---|
642 | end;
|
---|
643 | end;
|
---|
644 | if(assigned(ObjList) and (ObjList.Count > 0)) then
|
---|
645 | ObjList.Add(ObjMarker);
|
---|
646 | end;
|
---|
647 |
|
---|
648 | function TdmodShared.TemplateOK(tmpl: TTemplate; Msg: string = ''): boolean;
|
---|
649 | var
|
---|
650 | Err: TStringList;
|
---|
651 | btns: TMsgDlgButtons;
|
---|
652 |
|
---|
653 | begin
|
---|
654 | Err := nil;
|
---|
655 | try
|
---|
656 | Result := BoilerplateOK(tmpl.FullBoilerplate, #13, nil, Err);
|
---|
657 | if(not Result) then
|
---|
658 | begin
|
---|
659 | if(Msg = 'OK') then
|
---|
660 | btns := [mbOK]
|
---|
661 | else
|
---|
662 | begin
|
---|
663 | btns := [mbAbort, mbIgnore];
|
---|
664 | Err.Add('');
|
---|
665 | if(Msg = '') then
|
---|
666 | Msg := 'template insertion';
|
---|
667 | Err.Add('Do you want to Abort '+Msg+', or Ignore the error and continue?');
|
---|
668 | end;
|
---|
669 | Result := (MessageDlg(Err.Text, mtError, btns, 0) = mrIgnore);
|
---|
670 | end;
|
---|
671 | finally
|
---|
672 | if(assigned(Err)) then
|
---|
673 | Err.Free;
|
---|
674 | end;
|
---|
675 | if Result then
|
---|
676 | Result := BoilerplateTemplateFieldsOK(tmpl.FullBoilerplate, Msg);
|
---|
677 | end;
|
---|
678 |
|
---|
679 | procedure TdmodShared.EncounterLocationChanged(Sender: TObject);
|
---|
680 | var
|
---|
681 | i: integer;
|
---|
682 |
|
---|
683 | begin
|
---|
684 | if(assigned(FDrawerTrees)) then
|
---|
685 | begin
|
---|
686 | for i:= 0 to FDrawerTrees.count-1 do
|
---|
687 | TfrmDrawers(FDrawerTrees[i]).UpdatePersonalTemplates;
|
---|
688 | end;
|
---|
689 | end;
|
---|
690 |
|
---|
691 | procedure TdmodShared.SelectNode(Tree: TORTreeView; GotoNodeID: string; var EmptyCount: integer);
|
---|
692 | var
|
---|
693 | i, j: integer;
|
---|
694 | IEN, PIEN: string;
|
---|
695 | Node: TORTreeNode;
|
---|
696 |
|
---|
697 | function FindNode(StartNode: TORTreeNode): TORTreeNode;
|
---|
698 | begin
|
---|
699 | Result := nil;
|
---|
700 | while assigned(StartNode) do
|
---|
701 | begin
|
---|
702 | if(Piece(StartNode.StringData, U ,1) = IEN) then
|
---|
703 | begin
|
---|
704 | Result := StartNode;
|
---|
705 | exit;
|
---|
706 | end;
|
---|
707 | StartNode := TORTreeNode(StartNode.GetNextSibling);
|
---|
708 | end;
|
---|
709 | end;
|
---|
710 |
|
---|
711 | begin
|
---|
712 | if(GotoNodeID <> '') then
|
---|
713 | begin
|
---|
714 | i := 1;
|
---|
715 | for j := 1 to length(GotoNodeID) do
|
---|
716 | if(GotoNodeID[j] = ';') then inc(i);
|
---|
717 | PIEN := '';
|
---|
718 | Node := TORTreeNode(Tree.Items.GetFirstNode);
|
---|
719 | repeat
|
---|
720 | IEN := piece(GotoNodeID, ';', i);
|
---|
721 | if(IEN <> '') then
|
---|
722 | begin
|
---|
723 | Node := FindNode(Node);
|
---|
724 | if(assigned(Node)) then
|
---|
725 | begin
|
---|
726 | if(PIEN <> '') then
|
---|
727 | PIEN := ';' + PIEN;
|
---|
728 | PIEN := IEN + PIEN;
|
---|
729 | if(PIEN = GotoNodeID) then
|
---|
730 | begin
|
---|
731 | Node.EnsureVisible;
|
---|
732 | Tree.Selected := Node;
|
---|
733 | IEN := '';
|
---|
734 | end
|
---|
735 | else
|
---|
736 | begin
|
---|
737 | dmodShared.ExpandNode(Tree, Node, EmptyCount);
|
---|
738 | Node := TORTreeNode(Node.GetFirstChild);
|
---|
739 | if(assigned(Node)) then
|
---|
740 | dec(i)
|
---|
741 | else
|
---|
742 | IEN := '';
|
---|
743 | end;
|
---|
744 | end
|
---|
745 | else
|
---|
746 | IEN := '';
|
---|
747 | end;
|
---|
748 | until (i < 1) or (IEN = '');
|
---|
749 | end;
|
---|
750 | end;
|
---|
751 |
|
---|
752 | function TdmodShared.InDialog(Node: TTreeNode): boolean;
|
---|
753 | begin
|
---|
754 | Result := FALSE;
|
---|
755 | while assigned(Node) and (not Result) do
|
---|
756 | begin
|
---|
757 | if TTemplate(Node.Data).IsDialog then
|
---|
758 | Result := TRUE
|
---|
759 | else
|
---|
760 | Node := Node.Parent;
|
---|
761 | end;
|
---|
762 | end;
|
---|
763 |
|
---|
764 | procedure TdmodShared.ExpandTree(Tree: TORTreeView; ExpandString: string;
|
---|
765 | var EmptyCount: integer; AllowInactive: boolean = FALSE);
|
---|
766 |
|
---|
767 | var
|
---|
768 | NStr: string;
|
---|
769 | i: integer;
|
---|
770 | Node: TTreeNode;
|
---|
771 |
|
---|
772 | begin
|
---|
773 | Tree.Items.BeginUpdate;
|
---|
774 | try
|
---|
775 | i := 1;
|
---|
776 | repeat
|
---|
777 | NStr := piece(ExpandString,U,i);
|
---|
778 | if(NStr <> '') then
|
---|
779 | begin
|
---|
780 | inc(i);
|
---|
781 | Node := Tree.FindPieceNode(NStr, 1, ';');
|
---|
782 | if assigned(Node) then
|
---|
783 | begin
|
---|
784 | ExpandNode(Tree, Node, EmptyCount, AllowInactive);
|
---|
785 | Node.Expand(False);
|
---|
786 | end;
|
---|
787 | end;
|
---|
788 | until(NStr = '');
|
---|
789 | finally
|
---|
790 | Tree.Items.EndUpdate;
|
---|
791 | end;
|
---|
792 | end;
|
---|
793 |
|
---|
794 | procedure TdmodShared.FindRichEditText(AFindDialog: TFindDialog; ARichEdit: TRichEdit);
|
---|
795 | const
|
---|
796 | TX_NOMATCH = 'The text was not found';
|
---|
797 | TC_NOMATCH = 'No more matches';
|
---|
798 | var
|
---|
799 | FoundAt, FoundLine, TopLine, BottomLine: LongInt;
|
---|
800 | StartPos, ToEnd, CharPos: Integer;
|
---|
801 | SearchOpts: TSearchTypes;
|
---|
802 | begin
|
---|
803 | SearchOpts := [];
|
---|
804 | with ARichEdit do
|
---|
805 | begin
|
---|
806 | { begin the search after the current selection if there is one }
|
---|
807 | { otherwise, begin at the start of the text }
|
---|
808 | if SelStart <> 0 then
|
---|
809 | StartPos := SelStart + SelLength
|
---|
810 | else
|
---|
811 | StartPos := 0;
|
---|
812 | { ToEnd is the length from StartPos to the end of the text in the rich edit control }
|
---|
813 | ToEnd := Length(Text) - StartPos;
|
---|
814 | if frMatchCase in AFindDialog.Options then Include(SearchOpts, stMatchCase);
|
---|
815 | if frWholeWord in AFindDialog.Options then Include(SearchOpts, stWholeWord);
|
---|
816 | FoundAt := FindText(AFindDialog.FindText, StartPos, ToEnd, SearchOpts);
|
---|
817 | if FoundAt <> -1 then
|
---|
818 | begin
|
---|
819 | SetFocus;
|
---|
820 | TopLine := SendMessage(Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
|
---|
821 | BottomLine := TopLine + (Height div FontHeightPixel(Font.Handle));
|
---|
822 | FoundLine := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, FoundAt);
|
---|
823 | if (FoundLine + 10) > BottomLine then
|
---|
824 | SendMessage(Handle, EM_LINESCROLL, 0, FoundLine - BottomLine + 10);
|
---|
825 | CharPos := Pos(AFindDialog.FindText, Lines[FoundLine]);
|
---|
826 | SendMessage(ARichEdit.Handle, EM_LINESCROLL, CharPos, 0);
|
---|
827 | SelStart := FoundAt;
|
---|
828 | SelLength := Length(AFindDialog.FindText);
|
---|
829 | end
|
---|
830 | else
|
---|
831 | begin
|
---|
832 | if not (frReplaceAll in AFindDialog.Options) then InfoBox(TX_NOMATCH, TC_NOMATCH, MB_OK);
|
---|
833 | SelStart := 0;
|
---|
834 | SelLength := 0;
|
---|
835 | //AFindDialog.CloseDialog;
|
---|
836 | end;
|
---|
837 | end;
|
---|
838 | end;
|
---|
839 |
|
---|
840 | procedure TdmodShared.ReplaceRichEditText(AReplaceDialog: TReplaceDialog; ARichEdit: TRichEdit);
|
---|
841 | const
|
---|
842 | TC_COMPLETE = 'Replacement Complete';
|
---|
843 | TX_COMPLETE1 = 'CPRS has finished searching the document. ' + CRLF;
|
---|
844 | TX_COMPLETE2 = ' replacements were made.';
|
---|
845 | var
|
---|
846 | Replacements: integer;
|
---|
847 | NewStart: integer;
|
---|
848 | begin
|
---|
849 | Replacements := 0;
|
---|
850 | if (frReplace in AReplaceDialog.Options) then
|
---|
851 | begin
|
---|
852 | if ARichEdit.SelLength > 0 then
|
---|
853 | begin
|
---|
854 | NewStart := ARichEdit.SelStart + Length(AReplaceDialog.ReplaceText);
|
---|
855 | ARichEdit.SelText := AReplaceDialog.ReplaceText;
|
---|
856 | ARichEdit.SelStart := NewStart;
|
---|
857 | //Replacements := Replacements + 1;
|
---|
858 | end;
|
---|
859 | FindRichEditText(AReplaceDialog, ARichEdit);
|
---|
860 | end
|
---|
861 | else if (frReplaceAll in AReplaceDialog.Options) then
|
---|
862 | begin
|
---|
863 | repeat
|
---|
864 | if ARichEdit.SelLength > 0 then
|
---|
865 | begin
|
---|
866 | NewStart := ARichEdit.SelStart + Length(AReplaceDialog.ReplaceText);
|
---|
867 | ARichEdit.SelText := AReplaceDialog.ReplaceText;
|
---|
868 | ARichEdit.SelStart := NewStart;
|
---|
869 | Replacements := Replacements + 1;
|
---|
870 | end;
|
---|
871 | FindRichEditText(AReplaceDialog, ARichEdit);
|
---|
872 | until ARichEdit.SelLength = 0;
|
---|
873 | InfoBox(TX_COMPLETE1 + IntToStr(Replacements) + TX_COMPLETE2, TC_COMPLETE, MB_OK);
|
---|
874 | end
|
---|
875 | else
|
---|
876 | FindRichEditText(AReplaceDialog, ARichEdit);
|
---|
877 | end;
|
---|
878 |
|
---|
879 | end.
|
---|
880 |
|
---|
881 |
|
---|
882 |
|
---|
883 |
|
---|
884 |
|
---|