source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/uODBase.pas@ 1742

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.5 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit uODBase;
3
4interface
5
6uses
7 Classes, ORFn, uConst;
8
9{ Order Checking }
10function AddFillerAppID(const AnID: string): Boolean;
11procedure ClearFillerAppList;
12
13{ Ordering Environment }
14procedure SetOrderFormIDOnCreate(AFormID: Integer);
15function OrderFormIDOnCreate: Integer;
16procedure SetOrderEventTypeOnCreate(AType: Char);
17function OrderEventTypeOnCreate: Char;
18procedure SetOrderEventIDOnCreate(AnEvtID: integer);
19function OrderEventIDOnCreate: integer;
20procedure SetOrderEventNameOnCreate(AnEvtNm: string);
21function OrderEventNameOnCreate: string;
22function GetKeyVars: string;
23procedure PopKeyVars(NumLevels: Integer = 1);
24procedure PushKeyVars(const NewVals: string);
25procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
26
27implementation
28
29uses
30 dShared, Windows, rTemplates,
31 DKLang //kt
32 ;
33
34var
35 uOrderEventType: Char;
36 uOrderEventID: Integer;
37 uOrderEventName: string;
38 uOrderFormID: Integer;
39 uFillerAppID: TStringList;
40 uKeyVarList: TStringList;
41
42{ Order Checking }
43
44function AddFillerAppID(const AnID: string): Boolean;
45begin
46 Result := False;
47 if uFillerAppID.IndexOf(AnID) < 0 then
48 begin
49 Result := True;
50 uFillerAppID.Add(AnID);
51 end;
52end;
53
54procedure ClearFillerAppList;
55begin
56 uFillerAppID.Clear;
57end;
58
59{ Ordering Environment }
60
61procedure SetOrderFormIDOnCreate(AFormID: Integer);
62begin
63 uOrderFormID := AFormID;
64end;
65
66function OrderFormIDOnCreate: Integer;
67begin
68 Result := uOrderFormID;
69end;
70
71procedure SetOrderEventTypeOnCreate(AType: Char);
72begin
73 uOrderEventType := AType;
74end;
75
76function OrderEventTypeOnCreate: Char;
77begin
78 Result := uOrderEventType;
79end;
80
81procedure SetOrderEventIDOnCreate(AnEvtID: Integer);
82begin
83 uOrderEventID := AnEvtID;
84end;
85
86procedure SetOrderEventNameOnCreate(AnEvtNm: string);
87begin
88 uOrderEventName := AnEvtNm;
89end;
90
91function OrderEventNameOnCreate: string;
92begin
93 Result := uOrderEventName;
94end;
95
96function OrderEventIDOnCreate: integer;
97begin
98 Result := uOrderEventID;
99end;
100
101function GetKeyVars: string;
102begin
103 Result := '';
104 with uKeyVarList do if Count > 0 then Result := Strings[Count - 1];
105end;
106
107procedure PopKeyVars(NumLevels: Integer = 1);
108begin
109 with uKeyVarList do while (NumLevels > 0) and (Count > 0) do
110 begin
111 Delete(Count - 1);
112 Dec(NumLevels);
113 end;
114end;
115
116procedure PushKeyVars(const NewVals: string);
117var
118 i: Integer;
119 x: string;
120begin
121 if uKeyVarList.Count > 0 then x := uKeyVarList[uKeyVarList.Count - 1] else x := '';
122 for i := 1 to MAX_KEYVARS do
123 if Piece(NewVals, U, i) <> '' then SetPiece(x, U, i, Piece(NewVals, U, i));
124 uKeyVarList.Add(x);
125end;
126
127procedure ExpandOrderObjects(var Txt: string; var ContainsObjects: boolean; msg: string = '');
128var
129 ObjList: TStringList;
130 Err: TStringList;
131 i, j, k, oLen: integer;
132 obj, ObjTxt: string;
133
134const
135 CRDelim = #13;
136//TC_BOILER_ERR = 'Order Boilerplate Object Error'; <-- original line. //kt 8/8/2007
137//TX_BOILER_ERR = 'Contact IRM and inform them about this error.' + CRLF + <-- original line. //kt 8/8/2007
138// 'Make sure you give them the name of the quick' + CRLF + <-- original line. //kt 8/8/2007
139// 'order that you are processing.' ; <-- original line. //kt 8/8/2007
140
141var //kt added
142 TC_BOILER_ERR : string; //kt added
143 TX_BOILER_ERR : string; //kt added
144
145begin
146 TC_BOILER_ERR := DKLangConstW('uODBase_Order_Boilerplate_Object_Error'); //kt added 8/8/2007
147 TX_BOILER_ERR := DKLangConstW('uODBase_Contact_IRM_and_inform_them_about_this_errorx') + CRLF + //kt added 8/8/2007
148 DKLangConstW('uODBase_Make_sure_you_give_them_the_name_of_the_quick') + CRLF + //kt added 8/8/2007
149 DKLangConstW('uODBase_order_that_you_are_processingx') ; //kt added 8/8/2007
150 ObjList := TStringList.Create;
151 try
152 Err := nil;
153 if(not dmodShared.BoilerplateOK(Txt, CRDelim, ObjList, Err)) and (assigned(Err)) then
154 begin
155 try
156 Err.Add(CRLF + TX_BOILER_ERR);
157 InfoBox(Err.Text, TC_BOILER_ERR, MB_OK + MB_ICONERROR);
158 finally
159 Err.Free;
160 end;
161 end;
162 if(ObjList.Count > 0) then
163 begin
164 ContainsObjects := True;
165 GetTemplateText(ObjList);
166 i := 0;
167 while (i < ObjList.Count) do
168 begin
169 if(pos(ObjMarker, ObjList[i]) = 1) then
170 begin
171 obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
172 if(obj = '') then break;
173 j := i + 1;
174 while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
175 inc(j);
176 if((j - i) > 2) then
177 begin
178 ObjTxt := '';
179 for k := i+1 to j-1 do
180 ObjTxt := ObjTxt + #13 + ObjList[k];
181 end
182 else
183 ObjTxt := ObjList[i+1];
184 i := j;
185 obj := '|' + obj + '|';
186 oLen := length(obj);
187 repeat
188 j := pos(obj, Txt);
189 if(j > 0) then
190 begin
191 delete(Txt, j, OLen);
192 insert(ObjTxt, Txt, j);
193 end;
194 until(j = 0);
195 end
196 else
197 inc(i);
198 end
199 end;
200 finally
201 ObjList.Free;
202 end;
203end;
204
205initialization
206 uOrderEventType := #0;
207 uOrderFormID := 0;
208 uOrderEventName := '';
209 uFillerAppID := TStringList.Create;
210 uKeyVarList := TStringList.Create;
211
212finalization
213 uFillerAppID.Free;
214 uKeyVarList.Free;
215
216end.
Note: See TracBrowser for help on using the repository browser.