1 | unit fConsultBS;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | ExtCtrls, ORCtrls, StdCtrls, ORFn, ComCtrls, uConsults;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TfrmConsultsByService = class(TForm)
|
---|
11 | pnlBase: TORAutoPanel;
|
---|
12 | lblService: TLabel;
|
---|
13 | radSort: TRadioGroup;
|
---|
14 | cmdOK: TButton;
|
---|
15 | cmdCancel: TButton;
|
---|
16 | treService: TORTreeView;
|
---|
17 | cboService: TORComboBox;
|
---|
18 | procedure cmdCancelClick(Sender: TObject);
|
---|
19 | procedure cmdOKClick(Sender: TObject);
|
---|
20 | procedure treServiceChange(Sender: TObject; Node: TTreeNode);
|
---|
21 | procedure cboServiceSelect(Sender: TObject);
|
---|
22 | private
|
---|
23 | FChanged: Boolean;
|
---|
24 | FService: string;
|
---|
25 | FServiceName: string;
|
---|
26 | FAscending: Boolean;
|
---|
27 | fConsultUser: boolean ;
|
---|
28 | end;
|
---|
29 |
|
---|
30 | TServiceContext = record
|
---|
31 | Changed: Boolean;
|
---|
32 | Service: string;
|
---|
33 | ServiceName: string;
|
---|
34 | Ascending: Boolean;
|
---|
35 | ConsultUser: Boolean ;
|
---|
36 | end;
|
---|
37 |
|
---|
38 | function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
|
---|
39 |
|
---|
40 | implementation
|
---|
41 |
|
---|
42 | {$R *.DFM}
|
---|
43 |
|
---|
44 | uses rConsults, rCore, uCore;
|
---|
45 |
|
---|
46 | var
|
---|
47 | SvcList: TStrings ;
|
---|
48 | SvcInfo: string ;
|
---|
49 | uChanging: Boolean;
|
---|
50 |
|
---|
51 | const
|
---|
52 | TX_SVC_TEXT = 'Select a consult service or press Cancel.';
|
---|
53 | TX_SVC_CAP = 'Missing Service';
|
---|
54 |
|
---|
55 | function SelectService(FontSize: Integer; CurrentContext: TSelectContext; var ServiceContext: TServiceContext): boolean;
|
---|
56 | { displays service select form for consults and returns a record of the selection }
|
---|
57 | var
|
---|
58 | frmConsultsByService: TfrmConsultsByService;
|
---|
59 | W, H, i: Integer;
|
---|
60 | CurrentService: string;
|
---|
61 | begin
|
---|
62 | frmConsultsByService := TfrmConsultsByService.Create(Application);
|
---|
63 | try
|
---|
64 | with frmConsultsByService do
|
---|
65 | begin
|
---|
66 | Font.Size := FontSize;
|
---|
67 | W := ClientWidth;
|
---|
68 | H := ClientHeight;
|
---|
69 | ResizeToFont(FontSize, W, H);
|
---|
70 | ClientWidth := W; pnlBase.Width := W;
|
---|
71 | ClientHeight := H; pnlBase.Height := H;
|
---|
72 | FChanged := False;
|
---|
73 | //SvcList.Assign(LoadServiceList(CN_SVC_LIST_DISP)); {RV}
|
---|
74 | SvcList.Assign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP)); {RV}
|
---|
75 | SortByPiece(TStringList(SvcList), U, 2); {RV}
|
---|
76 | for i := 0 to SvcList.Count - 1 do
|
---|
77 | if cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1 then {RV}
|
---|
78 | //if cboService.SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
|
---|
79 | cboService.Items.Add(SvcList.Strings[i]);
|
---|
80 | BuildServiceTree(treService, SvcList, '0', nil) ;
|
---|
81 | with treService do
|
---|
82 | for i := 0 to Items.Count-1 do
|
---|
83 | begin
|
---|
84 | if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
|
---|
85 | TopItem := Items[0] ;
|
---|
86 | Selected := Items[0] ;
|
---|
87 | end ;
|
---|
88 | FAscending := CurrentContext.Ascending;
|
---|
89 | radSort.ItemIndex := Ord(not FAscending);
|
---|
90 | CurrentService := CurrentContext.Service;
|
---|
91 | if StrToIntDef(CurrentService, 0) > 0 then
|
---|
92 | begin
|
---|
93 | cboservice.SelectByID(CurrentService);
|
---|
94 | cboServiceSelect(frmConsultsByService);
|
---|
95 | end;
|
---|
96 | ShowModal;
|
---|
97 | with ServiceContext do
|
---|
98 | begin
|
---|
99 | Changed := FChanged;
|
---|
100 | Service := FService;
|
---|
101 | ServiceName := FServiceName;
|
---|
102 | Ascending := FAscending;
|
---|
103 | ConsultUser := FConsultUser ;
|
---|
104 | Result := Changed ;
|
---|
105 | end; {with ServiceContext}
|
---|
106 | end; {with frmConsultsByService}
|
---|
107 | finally
|
---|
108 | frmConsultsByService.Release;
|
---|
109 | end;
|
---|
110 | end;
|
---|
111 |
|
---|
112 | procedure TfrmConsultsByService.cmdCancelClick(Sender: TObject);
|
---|
113 | begin
|
---|
114 | Close;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | procedure TfrmConsultsByService.cmdOKClick(Sender: TObject);
|
---|
118 | begin
|
---|
119 | if (treService.Selected = nil) and (StrToIntDef(FService, 0) = 0 ) then
|
---|
120 | begin
|
---|
121 | InfoBox(TX_SVC_TEXT, TX_SVC_CAP, MB_OK or MB_ICONWARNING);
|
---|
122 | Exit;
|
---|
123 | end;
|
---|
124 | FChanged := True;
|
---|
125 | FService := Piece(SvcInfo,u,1);
|
---|
126 | FServiceName := Piece(SvcInfo,u,2) ;
|
---|
127 | FAscending := (radSort.ItemIndex = 0);
|
---|
128 | FConsultUser := ConsultServiceUser(StrToIntDef(FService, 0), User.DUZ) ;
|
---|
129 | Close;
|
---|
130 | end;
|
---|
131 |
|
---|
132 | procedure TfrmConsultsByService.treServiceChange(Sender: TObject;
|
---|
133 | Node: TTreeNode);
|
---|
134 | begin
|
---|
135 | if uChanging then Exit;
|
---|
136 | SvcInfo := TORTreeNode(treService.Selected).StringData ;
|
---|
137 | cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text)); {RV}
|
---|
138 | //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
|
---|
139 | end;
|
---|
140 |
|
---|
141 | procedure TfrmConsultsByService.cboServiceSelect(Sender: TObject);
|
---|
142 | var
|
---|
143 | i: integer;
|
---|
144 | begin
|
---|
145 | uChanging := True;
|
---|
146 | with treService do for i := 0 to Items.Count-1 do
|
---|
147 | begin
|
---|
148 | if Piece(TORTreeNode(Items[i]).StringData, U, 1) = cboService.ItemID then
|
---|
149 | begin
|
---|
150 | Selected := Items[i];
|
---|
151 | //treServiceChange(Self, Items[i]);
|
---|
152 | break;
|
---|
153 | end;
|
---|
154 | end;
|
---|
155 | uChanging := False;
|
---|
156 | SvcInfo := TORTreeNode(treService.Selected).StringData ;
|
---|
157 | end;
|
---|
158 |
|
---|
159 | initialization
|
---|
160 | SvcList := TStringList.Create ;
|
---|
161 |
|
---|
162 | finalization
|
---|
163 | SvcList.Free ;
|
---|
164 |
|
---|
165 | end.
|
---|