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