source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Templates/fFindingTemplates.pas@ 1702

Last change on this file since 1702 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 4.1 KB
Line 
1unit fFindingTemplates;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, ComCtrls, DateUtils;
8
9type
10 TfrmFindingTemplates = class(TForm)
11 animSearch: TAnimate;
12 lblFind: TLabel;
13 Label2: TLabel;
14 btnCancel: TButton;
15 procedure FormShow(Sender: TObject);
16 procedure btnCancelClick(Sender: TObject);
17 private
18 FCanceled: boolean;
19 FSearchString: string;
20 FStarted: boolean;
21 FTree: TTreeView;
22 FStartNode: TTreeNode;
23 FCurrentNode :TTreeNode;
24 FIgnoreCase: boolean;
25 FWholeWords: boolean;
26 FFoundNode: TTreeNode;
27 FIsNext: boolean;
28 { Private declarations }
29 procedure Find;
30 public
31 end;
32
33function FindTemplate(SearchString: string; Tree: TTreeView; OwningForm: TForm;
34 StartNode: TTreeNode; IsNext, IgnoreCase, WholeWords: boolean): TTreeNode;
35
36implementation
37
38uses uTemplates, VAUtils, ORNet;
39
40{$R *.dfm}
41
42const
43 // search for 1 second before showing dialog - note some loading may have already
44 // taken place before this call.
45 DELAY_TIME = 1000;
46 MESSAGE_TIME = 0;
47
48function FindTemplate(SearchString: string; Tree: TTreeView; OwningForm: TForm;
49 StartNode: TTreeNode; IsNext, IgnoreCase, WholeWords: boolean): TTreeNode;
50var
51 frmFindingTemplates: TfrmFindingTemplates;
52 msg: string;
53begin
54 Result := nil;
55 if (SearchString = '') or (not assigned(Tree)) then exit;
56 frmFindingTemplates := TfrmFindingTemplates.Create(OwningForm);
57 try
58 with frmFindingTemplates do
59 begin
60 FSearchString := SearchString;
61 FTree := Tree;
62 FStartNode := StartNode;
63 FIgnoreCase := IgnoreCase;
64 FWholeWords := WholeWords;
65 FIsNext := IsNext;
66 if IsNext then
67 lblFind.Caption := 'Finding Next Template';
68 Find;
69 if assigned(FFoundNode) then
70 begin
71 Result := FFoundNode;
72 end
73 else
74 begin
75 if FCanceled then
76 msg := 'Find Canceled.'
77 else
78 msg := 'Text not Found.';
79 ShowMsg('Search Completed. ' + msg,'Find Template Failed', smiError);
80 end;
81 end;
82 finally
83 frmFindingTemplates.Free;
84 end;
85end;
86
87procedure TfrmFindingTemplates.btnCancelClick(Sender: TObject);
88begin
89 FCanceled := True;
90 btnCancel.Enabled := False;
91end;
92
93procedure TfrmFindingTemplates.Find;
94var
95 Found : boolean;
96 Text: String;
97 WindowList: Pointer;
98 NeedToShow: boolean;
99 StartTime: TDateTime;
100begin
101 WindowList := nil;
102 NeedToShow := True;
103 StartTime := Now;
104 try
105 if(FIgnoreCase) then
106 FSearchString := UpperCase(FSearchString);
107 FCurrentNode := FStartNode;
108 Found := False;
109 if FIsNext and assigned(FCurrentNode) then
110 begin
111 FCurrentNode.Expand(False);
112 FCurrentNode := FCurrentNode.GetNext;
113 end;
114 while (not FCanceled) and (assigned(FCurrentNode) and (not Found)) do
115 begin
116 Application.ProcessMessages;
117 if not FCanceled then
118 begin
119 Text := FCurrentNode.Text;
120 if(FIgnoreCase) then
121 Text := UpperCase(Text);
122 Found := SearchMatch(FSearchString, Text, FWholeWords);
123 if(not Found) then
124 begin
125 FCurrentNode.Expand(False);
126 FCurrentNode := FCurrentNode.GetNext;
127 end;
128 if (not Found) and assigned(FCurrentNode) and NeedToShow then
129 begin
130 if MilliSecondsBetween(Now, StartTime) > DELAY_TIME then
131 begin
132 WindowList := DisableTaskWindows(0);
133 AppStartedCursorForm := Self;
134 Show;
135 NeedToShow := False;
136 end;
137 end;
138 end;
139 end;
140 if Found then
141 FFoundNode := FCurrentNode;
142 finally
143 if not NeedToShow then
144 begin
145 AppStartedCursorForm := nil;
146 EnableTaskWindows(WindowList);
147 Hide;
148 end;
149 end;
150end;
151
152procedure TfrmFindingTemplates.FormShow(Sender: TObject);
153begin
154 if not FStarted then
155 begin
156 FStarted := True;
157 animSearch.Active := True;
158 end;
159end;
160
161end.
Note: See TracBrowser for help on using the repository browser.