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

Last change on this file since 732 was 453, checked in by Kevin Toppenberg, 16 years ago

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