source: cprs/trunk/CPRS-Chart/dShared.pas@ 796

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 25.0 KB
Line 
1unit dShared;
2interface
3
4uses
5 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
6 ComCtrls, ImgList, uTemplates, ORFn, ORNet, ExtCtrls, ORCtrls, Richedit;
7
8type
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
57var
58 dmodShared: TdmodShared;
59
60const
61 ObjMarker = '^@@^';
62 ObjMarkerLen = length(ObjMarker);
63 DlgPropMarker = '^@=';
64 DlgPropMarkerLen = length(DlgPropMarker);
65 NoTextMarker = '<@>';
66
67implementation
68
69uses fDrawers, rTemplates, uCore, uTemplateFields, uEventHooks;
70
71{$R *.DFM}
72
73const
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
99function TdmodShared.ImgIdx(Node: TTreeNode): integer;
100var
101 Typ: TTemplateType;
102 i: integer;
103
104begin
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;
144end;
145
146procedure TdmodShared.AddTemplateNode(Tree: TTreeView; var EmptyCount: integer;
147 const tmpl: TTemplate; AllowInactive: boolean = FALSE;
148 const Owner: TTreeNode = nil);
149var
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
163begin
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;
203end;
204
205function TdmodShared.ExpandNode(Tree: TTreeView; Node: TTreeNode;
206 var EmptyCount: integer; AllowInactive: boolean = FALSE): boolean;
207
208var
209 TmpNode: TTreeNode;
210 tmpl: TTemplate;
211 i :integer;
212
213begin
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;
228end;
229
230procedure TdmodShared.Resync(SyncNode: TTreeNode; AllowInactive: boolean;
231 var EmptyCount: integer);
232var
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
385begin
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;
469end;
470
471
472procedure TdmodShared.dmodSharedCreate(Sender: TObject);
473begin
474 FDrawerTrees := TList.Create;
475 imgReminders.Overlay(6,0);
476 imgReminders.Overlay(7,1);
477 imgReminders2.Overlay(4,0);
478end;
479
480procedure TdmodShared.dmodSharedDestroy(Sender: TObject);
481begin
482 KillObj(@FDrawerTrees);
483 KillObj(@FTIUObjects);
484end;
485
486procedure TdmodShared.AddDrawerTree(DrawerForm: TForm);
487begin
488 if(assigned(FDrawerTrees)) and (FDrawerTrees.IndexOf(DrawerForm) < 0) then
489 FDrawerTrees.Add(DrawerForm);
490 Encounter.Notifier.NotifyWhenChanged(EncounterLocationChanged);
491end;
492
493procedure TdmodShared.RemoveDrawerTree(DrawerForm: TForm);
494var
495 idx: integer;
496
497begin
498 if(assigned(FDrawerTrees)) then
499 begin
500 idx := FDrawerTrees.IndexOf(DrawerForm);
501 if(idx >= 0) then
502 FDrawerTrees.Delete(idx);
503 end;
504end;
505
506procedure TdmodShared.Reload;
507var
508 i: integer;
509
510begin
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;
517end;
518
519procedure TdmodShared.LoadTIUObjects;
520var
521 i: integer;
522
523begin
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;
535end;
536
537function TdmodShared.NeedsCollapsing(Tree: TTreeView): boolean;
538var
539 Node: TTreeNode;
540
541begin
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;
552end;
553
554function TdmodShared.BoilerplateOK(const Txt, CRDelim: string; ObjList: TStringList;
555 var Err: TStringList): boolean;
556var
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
576begin
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);
646end;
647
648function TdmodShared.TemplateOK(tmpl: TTemplate; Msg: string = ''): boolean;
649var
650 Err: TStringList;
651 btns: TMsgDlgButtons;
652
653begin
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);
677end;
678
679procedure TdmodShared.EncounterLocationChanged(Sender: TObject);
680var
681 i: integer;
682
683begin
684 if(assigned(FDrawerTrees)) then
685 begin
686 for i:= 0 to FDrawerTrees.count-1 do
687 TfrmDrawers(FDrawerTrees[i]).UpdatePersonalTemplates;
688 end;
689end;
690
691procedure TdmodShared.SelectNode(Tree: TORTreeView; GotoNodeID: string; var EmptyCount: integer);
692var
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
711begin
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;
750end;
751
752function TdmodShared.InDialog(Node: TTreeNode): boolean;
753begin
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;
762end;
763
764procedure TdmodShared.ExpandTree(Tree: TORTreeView; ExpandString: string;
765 var EmptyCount: integer; AllowInactive: boolean = FALSE);
766
767var
768 NStr: string;
769 i: integer;
770 Node: TTreeNode;
771
772begin
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;
792end;
793
794procedure TdmodShared.FindRichEditText(AFindDialog: TFindDialog; ARichEdit: TRichEdit);
795const
796 TX_NOMATCH = 'The text was not found';
797 TC_NOMATCH = 'No more matches';
798var
799 FoundAt, FoundLine, TopLine, BottomLine: LongInt;
800 StartPos, ToEnd, CharPos: Integer;
801 SearchOpts: TSearchTypes;
802begin
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;
838end;
839
840procedure TdmodShared.ReplaceRichEditText(AReplaceDialog: TReplaceDialog; ARichEdit: TRichEdit);
841const
842 TC_COMPLETE = 'Replacement Complete';
843 TX_COMPLETE1 = 'CPRS has finished searching the document. ' + CRLF;
844 TX_COMPLETE2 = ' replacements were made.';
845var
846 Replacements: integer;
847 NewStart: integer;
848begin
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);
877end;
878
879end.
880
881
882
883
884
Note: See TracBrowser for help on using the repository browser.