source: cprs/branches/tmg-cprs/CPRS-Chart/dShared.pas@ 1680

Last change on this file since 1680 was 738, checked in by Kevin Toppenberg, 15 years ago

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