source: cprs/trunk/CPRS-Chart/Encounter/fHFSearch.pas@ 1800

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

Upgrade to version 27

File size: 5.6 KB
Line 
1unit fHFSearch;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, ORFn, StdCtrls, ComCtrls, ORCtrls, ExtCtrls,
8 VA508AccessibilityManager, VA508ImageListLabeler;
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 imgListHFtvSearch: TVA508ImageListLabeler;
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
41const
42 CatTxt = 'Category: ';
43
44procedure HFLookup(var Code: string);
45var
46 frmHFSearch: TfrmHFSearch;
47
48begin
49 frmHFSearch := TfrmHFSearch.Create(Application);
50 try
51 ResizeFormToFont(TForm(frmHFSearch));
52 frmHFSearch.ShowModal;
53 Code := frmHFSearch.FCode;
54 finally
55 frmHFSearch.Free;
56 end;
57end;
58
59procedure TfrmHFSearch.cbxSearchChange(Sender: TObject);
60var
61 Node: TORTreeNode;
62 CurCat, NodeCat: TTreeNode;
63 ID: string;
64
65begin
66 inherited;
67 if(not FChanging) then
68 begin
69 FChanging := TRUE;
70 try
71 btnOK.Enabled := (cbxSearch.ItemIndex >= 0);
72 if(cbxSearch.ItemIndex < 0) then
73 tvSearch.Selected := nil
74 else
75 begin
76 ID := cbxSearch.ItemID;
77 if(assigned(tvSearch.Selected)) then
78 begin
79 CurCat := tvSearch.Selected;
80 while (assigned(CurCat.Parent)) do
81 CurCat := CurCat.Parent;
82 end
83 else
84 CurCat := nil;
85 Node := TORTreeNode(tvSearch.Items.GetFirstNode);
86 while assigned(Node) do
87 begin
88 if(piece(Node.StringData,U,1)= ID) then
89 begin
90 NodeCat := Node;
91 while (assigned(NodeCat.Parent)) do
92 NodeCat := NodeCat.Parent;
93 RedrawSuspend(tvSearch.Handle);
94 try
95 if(CurCat <> NodeCat) then
96 tvSearch.FullCollapse;
97 tvSearch.Selected := Node;
98 Node.EnsureVisible;
99 finally
100 RedrawActivate(tvSearch.Handle);
101 end;
102 break;
103 end;
104 Node := TORTreeNode(Node.GetNext);
105 end;
106 end;
107 UpdateCat;
108 finally
109 FChanging := FALSE;
110 end;
111 end;
112end;
113
114
115procedure TfrmHFSearch.FormCreate(Sender: TObject);
116var
117 HFList: TStringList;
118 i: integer;
119 Node, Child :TORTreeNode;
120 CAT: string;
121
122begin
123 inherited;
124 HFList := TStringList.Create;
125 try
126 LoadcboOther(HFList, uEncPCEData.Location, PCE_HF);
127 for i := 0 to HFList.Count-1 do
128 begin
129 if(Piece(HFList[i],U,3)='F') then
130 cbxSearch.Items.Add(pieces(HFList[i],U,1,2));
131 end;
132 for i := 0 to HFList.Count-1 do
133 begin
134 if(Piece(HFList[i],U,3)='C') then
135 begin
136 with TORTreeNode(tvSearch.Items.Add(nil, '')) do
137 begin
138 StringData := HFList[i];
139 ImageIndex := 2;
140 SelectedIndex := 2;
141 end;
142 end;
143 end;
144 for i := 0 to HFList.Count-1 do
145 begin
146 if(Piece(HFList[i],U,3)='F') then
147 begin
148 CAT := piece(HFList[i],U,4);
149 Node := TORTreeNode(tvSearch.Items.GetFirstNode);
150 while(assigned(Node)) do
151 begin
152 if(Piece(Node.StringData, U, 1) = CAT) then
153 break;
154 Node := TORTreeNode(Node.GetNextSibling);
155 end;
156 Child := TORTreeNode(tvSearch.Items.AddChild(Node, ''));
157 Child.StringData := Pieces(HFList[i],U,1,2);
158 Child.ImageIndex := -1;
159 Child.StateIndex := -1;
160 end;
161 end;
162// tvSearch.Invalidate;
163 finally
164 HFList.Free;
165 end;
166end;
167
168procedure TfrmHFSearch.btnOKClick(Sender: TObject);
169begin
170 inherited;
171 if cbxSearch.ItemIndex = -1 then Exit;
172 FCode := cbxSearch.Items[cbxSearch.ItemIndex];
173 ModalResult := mrOK;
174end;
175
176procedure TfrmHFSearch.tvSearchDblClick(Sender: TObject);
177begin
178 inherited;
179 btnOKClick(Sender);
180end;
181
182procedure TfrmHFSearch.tvSearchGetImageIndex(Sender: TObject;
183 Node: TTreeNode);
184begin
185 inherited;
186 if(piece(TORTreeNode(Node).StringData,U,3)= 'C') then
187 begin
188 if(Node.Expanded) then
189 Node.ImageIndex := 3
190 else
191 Node.ImageIndex := 2;
192 end
193 else
194 Node.ImageIndex := -1;
195 Node.SelectedIndex := Node.ImageIndex;
196// tvSearch.Invalidate;
197end;
198
199procedure TfrmHFSearch.tvSearchChange(Sender: TObject; Node: TTreeNode);
200begin
201 inherited;
202 if(not FChanging) then
203 begin
204 FChanging := TRUE;
205 try
206 if(assigned(Node)) then
207 cbxSearch.SelectByID(Piece(TORTreeNode(Node).StringData,U,1))
208 else
209 cbxSearch.ItemIndex := -1;
210 btnOK.Enabled := (cbxSearch.ItemIndex >= 0);
211 UpdateCat;
212 finally
213 FChanging := FALSE;
214 end;
215 end;
216end;
217
218procedure TfrmHFSearch.UpdateCat;
219var
220 NodeCat: TTreeNode;
221
222begin
223 NodeCat := tvSearch.Selected;
224 if(assigned(NodeCat)) then
225 begin
226 while (assigned(NodeCat.Parent)) do
227 NodeCat := NodeCat.Parent;
228 lblCat.Caption := CatTxt + NodeCat.Text;
229 end
230 else
231 lblCat.Caption := CatTxt;
232 cbxSearch.Caption := lblCat.Caption;
233end;
234
235end.
Note: See TracBrowser for help on using the repository browser.