source: cprs/branches/GUI-config/EditTextU.pas@ 1381

Last change on this file since 1381 was 542, checked in by Kevin Toppenberg, 15 years ago

v1.1 Fixes Access/Verify code issues

File size: 5.8 KB
Line 
1unit EditTextU;
2 (*
3 WorldVistA Configuration Utility
4 (c) 8/2008 Kevin Toppenberg
5 Programmed by Kevin Toppenberg, Eddie Hagood
6
7 Family Physicians of Greeneville, PC
8 1410 Tusculum Blvd, Suite 2600
9 Greeneville, TN 37745
10 kdtop@yahoo.com
11
12 This library is free software; you can redistribute it and/or
13 modify it under the terms of the GNU Lesser General Public
14 License as published by the Free Software Foundation; either
15 version 2.1 of the License, or (at your option) any later version.
16
17 This library is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 Lesser General Public License for more details.
21
22 You should have received a copy of the GNU Lesser General Public
23 License along with this library; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25 *)
26
27interface
28
29uses
30 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
31 Dialogs, StdCtrls, Buttons, ExtCtrls;
32
33type
34 TEditTextForm = class(TForm)
35 Panel1: TPanel;
36 Memo: TMemo;
37 RevertBtn: TBitBtn;
38 ApplyBtn: TBitBtn;
39 DoneBtn: TBitBtn;
40 procedure FormCreate(Sender: TObject);
41 procedure FormDestroy(Sender: TObject);
42 procedure RevertBtnClick(Sender: TObject);
43 procedure ApplyBtnClick(Sender: TObject);
44 procedure DoneBtnClick(Sender: TObject);
45 procedure MemoChange(Sender: TObject);
46 procedure FormHide(Sender: TObject);
47 procedure FormClose(Sender: TObject; var Action: TCloseAction);
48 private
49 { Private declarations }
50 FCachedText : TStringList;
51 FFileNum,FFieldNum,FIENS : String;
52 function GetWPField(FileNum,FieldNum,IENS : string) : TStringList;
53 procedure PostWPField(Lines: TStrings; FileNum,FieldNum,IENS : string);
54 public
55 { Public declarations }
56 procedure PrepForm(FileNum,FieldNum,IENS : string);
57 end;
58
59var
60 EditTextForm: TEditTextForm;
61
62implementation
63
64uses FMErrorU, ORNet, ORFn,
65 Trpcb ; //needed for .ptype types
66
67{$R *.dfm}
68
69 procedure TEditTextForm.PrepForm(FileNum,FieldNum,IENS : string);
70 begin
71 FFileNum := FileNum;
72 FFieldNum := FieldNum;
73 FIENS := IENS;
74 Memo.Lines.Clear;
75 Memo.Lines.Assign(GetWPField(FileNum,FieldNum,IENS));
76 ApplyBtn.Enabled := false;
77 RevertBtn.Enabled := false;
78 end;
79
80 procedure TEditTextForm.FormCreate(Sender: TObject);
81 begin
82 FCachedText := TStringList.Create;
83
84 end;
85
86 procedure TEditTextForm.FormDestroy(Sender: TObject);
87 begin
88 FCachedText.Free;
89 end;
90
91
92 function TEditTextForm.GetWPField(FileNum,FieldNum,IENS : string) : TStringList;
93 var RPCResult: string;
94 cmd : string;
95 lastLine : string;
96 begin
97 FCachedText.clear;
98 RPCBrokerV.Results.Clear;
99 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
100 RPCBrokerV.param[0].ptype := list;
101 cmd := 'GET ONE WP FIELD^' + FileNum + '^' + FieldNum + '^' + IENS;
102 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
103 RPCBrokerV.Call;
104 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
105 if piece(RPCResult,'^',1)='-1' then begin
106 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
107 FMErrorForm.PrepMessage;
108 FMErrorForm.ShowModal;
109 end else begin
110 FCachedText.Assign(RPCBrokerV.Results);
111 FCachedText.Delete(0);
112 lastLine := FCachedText.Strings[FCachedText.Count-1];
113 //I can't figure out where these are coming from...
114 if (lastLine='WORD-PROCESSING') or (lastLine = 'POINTER')
115 or (lastLine='FREE TEXT') then begin
116 FCachedText.Delete(FCachedText.Count-1);
117 end;
118 end;
119 result := FCachedText;
120 end;
121
122
123 procedure TEditTextForm.PostWPField(Lines: TStrings; FileNum,FieldNum,IENS : string);
124 var RPCResult: string;
125 cmd : string;
126 lastLine : string;
127 i : integer;
128 begin
129 RPCBrokerV.Results.Clear;
130 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
131 RPCBrokerV.param[0].ptype := list;
132 cmd := 'POST WP FIELD^' + FileNum + '^' + FieldNum + '^' + IENS;
133 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
134 for i := 0 to Lines.Count-1 do begin
135 RPCBrokerV.Param[0].Mult['"' + IntToStr(i+1) + '"'] := Lines.Strings[i];
136 end;
137 RPCBrokerV.Call;
138 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
139 if piece(RPCResult,'^',1)='-1' then begin
140 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
141 FMErrorForm.PrepMessage;
142 FMErrorForm.ShowModal;
143 end else begin
144 FCachedText.Assign(Lines);
145 end;
146 end;
147
148
149 procedure TEditTextForm.RevertBtnClick(Sender: TObject);
150 begin
151 if MessageDlg('Abort editing changes and revert to original?',mtWarning,mbOKCancel,0) = mrOK then begin
152 Memo.Lines.Assign(FCachedText);
153 end;
154 end;
155
156 procedure TEditTextForm.ApplyBtnClick(Sender: TObject);
157 begin
158 if FCachedText.Text <> Memo.Lines.Text then begin
159 //MessageDlg('Here I will post changes',mtInformation,[mbOK],0);
160 PostWPField(Memo.Lines,FFileNum,FFieldNum,FIENS);
161 end;
162 ApplyBtn.Enabled := false;
163 RevertBtn.Enabled := false;
164 end;
165
166 procedure TEditTextForm.DoneBtnClick(Sender: TObject);
167 begin
168 ApplyBtnClick(self);
169 ModalResult := mrOK;
170 end;
171
172 procedure TEditTextForm.MemoChange(Sender: TObject);
173 begin
174 ApplyBtn.Enabled := true;
175 RevertBtn.Enabled := true;
176 end;
177
178 procedure TEditTextForm.FormHide(Sender: TObject);
179 begin
180 ApplyBtnClick(self);
181 end;
182
183 procedure TEditTextForm.FormClose(Sender: TObject; var Action: TCloseAction);
184 begin
185 ApplyBtnClick(self);
186 end;
187
188end.
189
Note: See TracBrowser for help on using the repository browser.