source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fHFSearch.pas@ 1802

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.6 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 9/5/2007
2unit fHFSearch;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls, DKLang;
9
10type
11 TfrmHFSearch = class(TfrmAutoSz)
12 cbxSearch: TORComboBox;
13 tvSearch: TORTreeView;
14 pnlBottom: TPanel;
15 btnOK: TButton;
16 btnCancel: TButton;
17 splMain: TSplitter;
18 lblCat: TLabel;
19 DKLanguageController2: TDKLanguageController;
20 procedure FormCreate(Sender: TObject);
21 procedure btnOKClick(Sender: TObject);
22 procedure tvSearchDblClick(Sender: TObject);
23 procedure tvSearchGetImageIndex(Sender: TObject; Node: TTreeNode);
24 procedure tvSearchChange(Sender: TObject; Node: TTreeNode);
25 procedure cbxSearchChange(Sender: TObject);
26 private
27 FCode: string;
28 FChanging: boolean;
29 procedure UpdateCat;
30 public
31 end;
32
33procedure HFLookup(var Code: string);
34
35implementation
36
37uses rPCE, dShared, fEncounterFrame;
38
39{$R *.DFM}
40
41//const
42//CatTxt = 'Category: '; <-- original line. //kt 9/5/2007
43var
44 CatTxt : string; //kt
45
46procedure SetupVars;
47//kt Added entire function to replace constant declarations 9/5/2007
48begin
49 CatTxt := DKLangConstW('fHFSearch_Categoryx');
50end;
51
52procedure HFLookup(var Code: string);
53var
54 frmHFSearch: TfrmHFSearch;
55
56begin
57 frmHFSearch := TfrmHFSearch.Create(Application);
58 try
59 ResizeFormToFont(TForm(frmHFSearch));
60 frmHFSearch.ShowModal;
61 Code := frmHFSearch.FCode;
62 finally
63 frmHFSearch.Free;
64 end;
65end;
66
67procedure TfrmHFSearch.cbxSearchChange(Sender: TObject);
68var
69 Node: TORTreeNode;
70 CurCat, NodeCat: TTreeNode;
71 ID: string;
72
73begin
74 inherited;
75 if(not FChanging) then
76 begin
77 FChanging := TRUE;
78 try
79 btnOK.Enabled := (cbxSearch.ItemIndex >= 0);
80 if(cbxSearch.ItemIndex < 0) then
81 tvSearch.Selected := nil
82 else
83 begin
84 ID := cbxSearch.ItemID;
85 if(assigned(tvSearch.Selected)) then
86 begin
87 CurCat := tvSearch.Selected;
88 while (assigned(CurCat.Parent)) do
89 CurCat := CurCat.Parent;
90 end
91 else
92 CurCat := nil;
93 Node := TORTreeNode(tvSearch.Items.GetFirstNode);
94 while assigned(Node) do
95 begin
96 if(piece(Node.StringData,U,1)= ID) then
97 begin
98 NodeCat := Node;
99 while (assigned(NodeCat.Parent)) do
100 NodeCat := NodeCat.Parent;
101 RedrawSuspend(tvSearch.Handle);
102 try
103 if(CurCat <> NodeCat) then
104 tvSearch.FullCollapse;
105 tvSearch.Selected := Node;
106 Node.EnsureVisible;
107 finally
108 RedrawActivate(tvSearch.Handle);
109 end;
110 break;
111 end;
112 Node := TORTreeNode(Node.GetNext);
113 end;
114 end;
115 UpdateCat;
116 finally
117 FChanging := FALSE;
118 end;
119 end;
120end;
121
122
123procedure TfrmHFSearch.FormCreate(Sender: TObject);
124var
125 HFList: TStringList;
126 i: integer;
127 Node :TORTreeNode;
128 CAT: string;
129
130begin
131 inherited;
132 HFList := TStringList.Create;
133 try
134 LoadcboOther(HFList, uEncPCEData.Location, PCE_HF);
135 for i := 0 to HFList.Count-1 do
136 begin
137 if(Piece(HFList[i],U,3)='F') then
138 cbxSearch.Items.Add(pieces(HFList[i],U,1,2));
139 end;
140 for i := 0 to HFList.Count-1 do
141 begin
142 if(Piece(HFList[i],U,3)='C') then
143 begin
144 with TORTreeNode(tvSearch.Items.Add(nil, '')) do
145 begin
146 StringData := HFList[i];
147 StateIndex := 2;
148 end;
149 end;
150 end;
151 for i := 0 to HFList.Count-1 do
152 begin
153 if(Piece(HFList[i],U,3)='F') then
154 begin
155 CAT := piece(HFList[i],U,4);
156 Node := TORTreeNode(tvSearch.Items.GetFirstNode);
157 while(assigned(Node)) do
158 begin
159 if(Piece(Node.StringData, U, 1) = CAT) then
160 break;
161 Node := TORTreeNode(Node.GetNextSibling);
162 end;
163 TORTreeNode(tvSearch.Items.AddChild(Node, '')).StringData := Pieces(HFList[i],U,1,2);
164 end;
165 end;
166// tvSearch.Invalidate;
167 finally
168 HFList.Free;
169 end;
170end;
171
172procedure TfrmHFSearch.btnOKClick(Sender: TObject);
173begin
174 inherited;
175 if cbxSearch.ItemIndex = -1 then Exit;
176 FCode := cbxSearch.Items[cbxSearch.ItemIndex];
177 ModalResult := mrOK;
178end;
179
180procedure TfrmHFSearch.tvSearchDblClick(Sender: TObject);
181begin
182 inherited;
183 btnOKClick(Sender);
184end;
185
186procedure TfrmHFSearch.tvSearchGetImageIndex(Sender: TObject;
187 Node: TTreeNode);
188begin
189 inherited;
190 if(piece(TORTreeNode(Node).StringData,U,3)= 'C') then
191 begin
192 if(Node.Expanded) then
193 Node.StateIndex := 3
194 else
195 Node.StateIndex := 2;
196 end;
197// tvSearch.Invalidate;
198end;
199
200procedure TfrmHFSearch.tvSearchChange(Sender: TObject; Node: TTreeNode);
201begin
202 inherited;
203 if(not FChanging) then
204 begin
205 FChanging := TRUE;
206 try
207 if(assigned(Node)) then
208 cbxSearch.SelectByID(Piece(TORTreeNode(Node).StringData,U,1))
209 else
210 cbxSearch.ItemIndex := -1;
211 btnOK.Enabled := (cbxSearch.ItemIndex >= 0);
212 UpdateCat;
213 finally
214 FChanging := FALSE;
215 end;
216 end;
217end;
218
219procedure TfrmHFSearch.UpdateCat;
220var
221 NodeCat: TTreeNode;
222
223begin
224 NodeCat := tvSearch.Selected;
225 if(assigned(NodeCat)) then
226 begin
227 while (assigned(NodeCat.Parent)) do
228 NodeCat := NodeCat.Parent;
229 lblCat.Caption := CatTxt + NodeCat.Text;
230 end
231 else
232 lblCat.Caption := CatTxt;
233 cbxSearch.Caption := lblCat.Caption;
234end;
235
236end.
Note: See TracBrowser for help on using the repository browser.