source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Templates/uTemplateFields.pas@ 1727

Last change on this file since 1727 was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch
File size: 74.8 KB
Line 
1unit uTemplateFields;
2
3interface
4
5uses
6 Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
7 Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils;
8
9type
10 TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
11 dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText,
12// keep dftScreenReader as last entry - users can not create this type of field
13 dftScreenReader);
14
15 TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
16 dtCombo, dtYear, dtYearMonth);
17
18const
19 FldItemTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons, dftWP, dftText];
20 SepLinesTypes = [dftCheckBoxes, dftRadioButtons];
21 EditLenTypes = [dftEditBox, dftComboBox, dftWP];
22 EditDfltTypes = [dftEditBox, dftHyperlink];
23 EditDfltType2 = [dftEditBox, dftHyperlink, dftDate];
24 ItemDfltTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons];
25 NoRequired = [dftHyperlink, dftText];
26 ExcludeText = [dftHyperlink, dftText];
27 DateComboTypes = [dtCombo, dtYear, dtYearMonth];
28
29type
30 TTemplateDialogEntry = class(TObject)
31 private
32 FID: string;
33 FFont: TFont;
34 FPanel: TDlgFieldPanel;
35 FControls: TStringList;
36 FIndents: TStringList;
37 FFirstBuild: boolean;
38 FOnChange: TNotifyEvent;
39 FText: string;
40 FInternalID: string;
41 FObj: TObject;
42 FFieldValues: string;
43 FUpdating: boolean;
44 FAutoDestroyOnPanelFree: boolean;
45 FPanelDying: boolean;
46 FOnDestroy: TNotifyEvent;
47 procedure KillLabels;
48 function GetFieldValues: string;
49 procedure SetFieldValues(const Value: string);
50 procedure SetAutoDestroyOnPanelFree(const Value: boolean);
51 function StripCode(var txt: string; code: char): boolean;
52 protected
53 procedure UpDownChange(Sender: TObject);
54 procedure DoChange(Sender: TObject);
55 function GetControlText(CtrlID: integer; NoCommas: boolean;
56 var FoundEntry: boolean; AutoWrap: boolean;
57 emField: string = ''): string;
58 procedure SetControlText(CtrlID: integer; AText: string);
59 public
60 constructor Create(AParent: TWinControl; AID, Text: string);
61 destructor Destroy; override;
62 function GetPanel(MaxLen: integer; AParent: TWinControl;
63 OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
64 function GetText: string;
65 property Text: string read FText write FText;
66 property InternalID: string read FInternalID write FInternalID;
67 property ID: string read FID;
68 property Obj: TObject read FObj write FObj;
69 property OnChange: TNotifyEvent read FOnChange write FOnChange;
70 property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
71 property FieldValues: string read GetFieldValues write SetFieldValues;
72 property AutoDestroyOnPanelFree: boolean read FAutoDestroyOnPanelFree
73 write SetAutoDestroyOnPanelFree;
74 end;
75
76 TTemplateField = class(TObject)
77 private
78 FMaxLen: integer;
79 FFldName: string;
80 FNameChanged: boolean;
81 FLMText: string;
82 FEditDefault: string;
83 FNotes: string;
84 FItems: string;
85 FInactive: boolean;
86 FItemDefault: string;
87 FFldType: TTemplateFieldType;
88 FRequired: boolean;
89 FSepLines: boolean;
90 FTextLen: integer;
91 FIndent: integer;
92 FPad: integer;
93 FMinVal: integer;
94 FMaxVal: integer;
95 FIncrement: integer;
96 FURL: string;
97 FDateType: TTmplFldDateType;
98 FModified: boolean;
99 FID: string;
100 FLocked: boolean;
101 procedure SetEditDefault(const Value: string);
102 procedure SetFldName(const Value: string);
103 procedure SetFldType(const Value: TTemplateFieldType);
104 procedure SetInactive(const Value: boolean);
105 procedure SetRequired(const Value: boolean);
106 procedure SetSepLines(const Value: boolean);
107 procedure SetItemDefault(const Value: string);
108 procedure SetItems(const Value: string);
109 procedure SetLMText(const Value: string);
110 procedure SetMaxLen(const Value: integer);
111 procedure SetNotes(const Value: string);
112 procedure SetID(const Value: string);
113 procedure SetIncrement(const Value: integer);
114 procedure SetIndent(const Value: integer);
115 procedure SetMaxVal(const Value: integer);
116 procedure SetMinVal(const Value: integer);
117 procedure SetPad(const Value: integer);
118 procedure SetTextLen(const Value: integer);
119 procedure SetURL(const Value: string);
120 function GetTemplateFieldDefault: string;
121 procedure CreateDialogControls(Entry: TTemplateDialogEntry;
122 var Index: Integer; CtrlID: integer);
123 function SaveError: string;
124 function Width: integer;
125 function GetRequired: boolean;
126 procedure SetDateType(const Value: TTmplFldDateType);
127 public
128 constructor Create(AData: TStrings);
129 destructor Destroy; override;
130 procedure Assign(AFld: TTemplateField);
131 function NewField: boolean;
132 function CanModify: boolean;
133 property ID: string read FID write SetID;
134 property FldName: string read FFldName write SetFldName;
135 property NameChanged: boolean read FNameChanged;
136 property FldType: TTemplateFieldType read FFldType write SetFldType;
137 property MaxLen: integer read FMaxLen write SetMaxLen;
138 property EditDefault: string read FEditDefault write SetEditDefault;
139 property Items: string read FItems write SetItems;
140 property ItemDefault: string read FItemDefault write SetItemDefault;
141 property LMText: string read FLMText write SetLMText;
142 property Inactive: boolean read FInactive write SetInactive;
143 property Required: boolean read GetRequired write SetRequired;
144 property SepLines: boolean read FSepLines write SetSepLines;
145 property TextLen: integer read FTextLen write SetTextLen;
146 property Indent: integer read FIndent write SetIndent;
147 property Pad: integer read FPad write SetPad;
148 property MinVal: integer read FMinVal write SetMinVal;
149 property MaxVal: integer read FMaxVal write SetMaxVal;
150 property Increment: integer read FIncrement write SetIncrement;
151 property URL: string read FURL write SetURL;
152 property DateType: TTmplFldDateType read FDateType write SetDateType;
153 property Notes: string read FNotes write SetNotes;
154 property TemplateFieldDefault: string read GetTemplateFieldDefault;
155 end;
156
157 TIntStruc = class(TObject)
158 public
159 x: integer;
160 end;
161
162function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
163procedure FreeEntries(SL: TStrings);
164procedure AssignFieldIDs(var Txt: string); overload;
165procedure AssignFieldIDs(SL: TStrings); overload;
166function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
167function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
168function HasTemplateField(txt: string): boolean;
169
170function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
171function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
172function SaveTemplateFieldErrors: string;
173procedure ClearModifiedTemplateFields;
174function AnyTemplateFieldsModified: boolean;
175procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
176function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
177procedure EnsureText(edt: TEdit; ud: TUpDown);
178procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
179function StripEmbedded(iItems: string): string;
180procedure StripScreenReaderCodes(var Text: string); overload;
181procedure StripScreenReaderCodes(SL: TStrings); overload;
182function HasScreenReaderBreakCodes(SL: TStrings): boolean;
183
184const
185 TemplateFieldSignature = '{FLD';
186 TemplateFieldBeginSignature = TemplateFieldSignature + ':';
187 TemplateFieldEndSignature = '}';
188 ScreenReaderCodeSignature = '{SR-';
189 ScreenReaderCodeType = ' Screen Reader Code';
190 ScreenReaderCodeCount = 2;
191 ScreenReaderShownCount = 1;
192 ScreenReaderStopCode = ScreenReaderCodeSignature + 'STOP' + TemplateFieldEndSignature;
193 ScreenReaderStopCodeLen = Length(ScreenReaderStopCode);
194 ScreenReaderStopCodeID = '-43';
195 ScreenReaderStopName = 'SCREEN READER STOP CODE **';
196 ScreenReaderStopCodeLine = ScreenReaderStopCodeID + U + ScreenReaderStopName + U + ScreenReaderCodeType;
197 ScreenReaderContinueCode = ScreenReaderCodeSignature + 'CONT' + TemplateFieldEndSignature;
198 ScreenReaderContinueCodeLen = Length(ScreenReaderContinueCode);
199 ScreenReaderContinueCodeOld = ScreenReaderCodeSignature + 'CONTINUE' + TemplateFieldEndSignature;
200 ScreenReaderContinueCodeOldLen = Length(ScreenReaderContinueCodeOld);
201 ScreenReaderContinueCodeID = '-44';
202 ScreenReaderContinueCodeName = 'SCREEN READER CONTINUE CODE ***';
203 ScreenReaderContinueCodeLine = ScreenReaderContinueCodeID + U + ScreenReaderContinueCodeName + U + ScreenReaderCodeType;
204 MissingFieldsTxt = 'One or more required fields must still be entered.';
205
206 ScreenReaderCodes: array[0..ScreenReaderCodeCount] of string =
207 (ScreenReaderStopCode, ScreenReaderContinueCode, ScreenReaderContinueCodeOld);
208 ScreenReaderCodeLens: array[0..ScreenReaderCodeCount] of integer =
209 (ScreenReaderStopCodeLen, ScreenReaderContinueCodeLen, ScreenReaderContinueCodeOldLen);
210 ScreenReaderCodeIDs: array[0..ScreenReaderShownCount] of string =
211 (ScreenReaderStopCodeID, ScreenReaderContinueCodeID);
212 ScreenReaderCodeLines: array[0..ScreenReaderShownCount] of string =
213 (ScreenReaderStopCodeLine, ScreenReaderContinueCodeLine);
214
215 TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
216 { dftUnknown } ('',
217 { dftEditBox } 'E',
218 { dftComboBox } 'C',
219 { dftButton } 'B',
220 { dftCheckBoxes } 'X',
221 { dftRadioButtons } 'R',
222 { dftDate } 'D',
223 { dftNumber } 'N',
224 { dftHyperlink } 'H',
225 { dftWP } 'W',
226 { dftText } 'T',
227 { dftScreenReader } 'S');
228
229 TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
230 { dftUnknown } (('',''),
231 { dftEditBox } ('Edit Box', 'Edit'),
232 { dftComboBox } ('Combo Box', 'Combo'),
233 { dftButton } ('Button', 'Button'),
234 { dftCheckBoxes } ('Check Boxes', 'Check'),
235 { dftRadioButtons } ('Radio Buttons', 'Radio'),
236 { dftDate } ('Date', 'Date'),
237 { dftNumber } ('Number', 'Num'),
238 { dftHyperlink } ('Hyperlink', 'Link'),
239 { dftWP } ('Word Processing', 'WP'),
240 { dftText } ('Display Text', 'Text'),
241 { dftScreenReader } ('Screen Reader Stop', 'SRStop'));
242
243 TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
244 { dtUnknown } (('',''),
245 { dtDate } ('Date', 'Date'),
246 { dtDateTime } ('Date & Time', 'Time'),
247 { dtDateReqTime } ('Date & Req Time','R.Time'),
248 { dtCombo } ('Date Combo', 'C.Date'),
249 { dtYear } ('Year', 'Year'),
250 { dtYearMonth } ('Year & Month', 'Month'));
251
252 FldNames: array[TTemplateFieldType] of string =
253 { dftUnknown } ('',
254 { dftEditBox } 'EDIT',
255 { dftComboBox } 'LIST',
256 { dftButton } 'BTTN',
257 { dftCheckBoxes } 'CBOX',
258 { dftRadioButtons } 'RBTN',
259 { dftDate } 'DATE',
260 { dftNumber } 'NUMB',
261 { dftHyperlink } 'LINK',
262 { dftWP } 'WRDP',
263 { dftTExt } 'TEXT',
264 { dftScreenReader } 'SRST');
265
266 TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
267 { dtUnknown } ('',
268 { dtDate } 'D',
269 { dtDateTime } 'T',
270 { dtDateReqTime } 'R',
271 { dtCombo } 'C',
272 { dtYear } 'Y',
273 { dtYearMonth } 'M');
274
275 MaxTFWPLines = 20;
276 MaxTFEdtLen = 70;
277
278implementation
279
280uses
281 rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
282 VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter;
283
284const
285 NewTemplateField = 'NEW TEMPLATE FIELD';
286 TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
287 TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
288
289var
290 uTmplFlds: TList = nil;
291 uEntries: TStringList = nil;
292
293 uNewTemplateFieldIDCnt: longint = 0;
294 uRadioGroupIndex: integer = 0;
295
296 uInternalFieldIDCount: integer = 0;
297
298const
299 FieldIDDelim = '`';
300 FieldIDLen = 6;
301 NewLine = 'NL';
302
303function GetNewFieldID: string;
304begin
305 inc(uInternalFieldIDCount);
306 Result := IntToStr(uInternalFieldIDCount);
307 Result := FieldIDDelim +
308 copy(StringOfChar('0', FieldIDLen-2) + Result, length(Result), FieldIDLen-1);
309end;
310
311function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
312var
313 idx: integer;
314
315begin
316 Result := nil;
317 if AID = '' then exit;
318 if(not assigned(uEntries)) then
319 uEntries := TStringList.Create;
320 idx := uEntries.IndexOf(AID);
321 if(idx < 0) then
322 begin
323 Result := TTemplateDialogEntry.Create(AParent, AID, AText);
324 uEntries.AddObject(AID, Result);
325 end
326 else
327 Result := TTemplateDialogEntry(uEntries.Objects[idx]);
328end;
329
330procedure FreeEntries(SL: TStrings);
331var
332 i, idx, cnt: integer;
333
334begin
335 if(assigned(uEntries)) then
336 begin
337 for i := SL.Count-1 downto 0 do
338 begin
339 idx := uEntries.IndexOf(SL[i]);
340 if(idx >= 0) then
341 begin
342 cnt := uEntries.Count;
343 if(assigned(uEntries.Objects[idx])) then
344 begin
345 TTemplateDialogEntry(uEntries.Objects[idx]).AutoDestroyOnPanelFree := FALSE;
346 uEntries.Objects[idx].Free;
347 end;
348 if cnt = uEntries.Count then
349 uEntries.Delete(idx);
350 end;
351 end;
352 if(uEntries.Count = 0) then
353 uInternalFieldIDCount := 0;
354 end;
355end;
356
357procedure AssignFieldIDs(var Txt: string);
358var
359 i: integer;
360
361begin
362 i := 0;
363 while (i < length(Txt)) do
364 begin
365 inc(i);
366 if(copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature) then
367 begin
368 inc(i,TemplateFieldSignatureLen);
369 if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then
370 begin
371 insert(GetNewFieldID, Txt, i);
372 inc(i, FieldIDLen);
373 end;
374 end;
375 end;
376end;
377
378procedure AssignFieldIDs(SL: TStrings);
379var
380 i: integer;
381 txt: string;
382
383begin
384 for i := 0 to SL.Count-1 do
385 begin
386 txt := SL[i];
387 AssignFieldIDs(txt);
388 SL[i] := txt;
389 end;
390end;
391
392procedure WordWrapText(var Txt: string);
393var
394 TmpSL: TStringList;
395 i: integer;
396
397 function WrappedText(const Str: string): string;
398 var
399 i, i2, j, k: integer;
400 Temp: string;
401
402 begin
403 Temp := Str;
404 Result := '';
405 i2 := 0;
406
407 repeat
408 i := pos(TemplateFieldBeginSignature, Temp);
409
410 if i>0 then
411 j := pos(TemplateFieldEndSignature, copy(Temp, i, MaxInt))
412 else
413 j := 0;
414
415 if (j > 0) then
416 begin
417 i2 := pos(TemplateFieldBeginSignature, copy(Temp, i+TemplateFieldSignatureLen, MaxInt));
418 if (i2 = 0) then
419 i2 := MaxInt
420 else
421 i2 := i + TemplateFieldSignatureLen + i2 - 1;
422 end;
423
424 if (i>0) and (j=0) then
425 i := 0;
426
427 if (i>0) and (j>0) then
428 if (j > i2) then
429 begin
430 Result := Result + copy(Temp, 1, i2-1);
431 delete(Temp, 1, i2-1);
432 end
433 else
434 begin
435 for k := (i+TemplateFieldSignatureLen) to (i+j-2) do
436 if Temp[k]=' ' then
437 Temp[k]:= #1;
438 i := i + j - 1;
439 Result := Result + copy(Temp,1,i);
440 delete(Temp,1,i);
441 end;
442
443 until (i = 0);
444
445 Result := Result + Temp;
446 Result := WrapText(Result, #13#10, [' '], MAX_ENTRY_WIDTH);
447 repeat
448 i := pos(#1, Result);
449 if i > 0 then
450 Result[i] := ' ';
451 until i = 0;
452 end;
453
454begin
455 if length(Txt) > MAX_ENTRY_WIDTH then
456 begin
457 TmpSL := TStringList.Create;
458 try
459 TmpSL.Text := Txt;
460 Txt := '';
461 for i := 0 to TmpSL.Count-1 do
462 begin
463 if Txt <> '' then
464 Txt := Txt + CRLF;
465 Txt := Txt + WrappedText(TmpSL[i]);
466 end;
467 finally
468 TmpSL.Free;
469 end;
470 end;
471end;
472
473function ResolveTemplateFields(Text: string;
474 AutoWrap: boolean;
475 Hidden: boolean = FALSE;
476 IncludeEmbedded: boolean = FALSE): string;
477var
478 flen, CtrlID, i, j: integer;
479 Entry: TTemplateDialogEntry;
480 iField, Temp, NewTxt, Fld: string;
481 FoundEntry: boolean;
482 TmplFld: TTemplateField;
483
484 procedure AddNewTxt;
485 begin
486 if(NewTxt <> '') then
487 begin
488 insert(StringOfChar('x',length(NewTxt)), Temp, i);
489 insert(NewTxt, Result, i);
490 inc(i, length(NewTxt));
491 end;
492 end;
493
494begin
495 if(not assigned(uEntries)) then
496 uEntries := TStringList.Create;
497 Result := Text;
498 Temp := Text; // Use Temp to allow template fields to contain other template field references
499 repeat
500 i := pos(TemplateFieldBeginSignature, Temp);
501 if(i > 0) then
502 begin
503 CtrlID := 0;
504 if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
505 begin
506 CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
507 delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
508 delete(Result,i + TemplateFieldSignatureLen, FieldIDLen);
509 end;
510 j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
511 Fld := '';
512 if(j > 0) then
513 begin
514 inc(j, i + TemplateFieldSignatureLen - 1);
515 flen := j - i - TemplateFieldSignatureLen;
516 Fld := copy(Temp,i + TemplateFieldSignatureLen, flen);
517 delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
518 delete(Result,i,flen + TemplateFieldSignatureLen + 1);
519 end
520 else
521 begin
522 delete(Temp,i,TemplateFieldSignatureLen);
523 delete(Result,i,TemplateFieldSignatureLen);
524 end;
525 if(CtrlID > 0) then
526 begin
527 FoundEntry := FALSE;
528 for j := 0 to uEntries.Count-1 do
529 begin
530 Entry := TTemplateDialogEntry(uEntries.Objects[j]);
531 if(assigned(Entry)) then
532 begin
533 if IncludeEmbedded then
534 iField := Fld
535 else
536 iField := '';
537 NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
538 TmplFld := GetTemplateField(Fld, FALSE);
539 if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
540 NewTxt := Piece(NewTxt,':',1); {we only want the first piece of NewTxt}
541 AddNewTxt;
542 end;
543 if FoundEntry then break;
544 end;
545 if Hidden and (not FoundEntry) and (Fld <> '') then
546 begin
547 NewTxt := TemplateFieldBeginSignature + Fld + TemplateFieldEndSignature;
548 AddNewTxt;
549 end;
550 end;
551 end;
552 until(i = 0);
553 if not AutoWrap then
554 WordWrapText(Result);
555end;
556
557function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
558var
559 flen, CtrlID, i, j: integer;
560 Entry: TTemplateDialogEntry;
561 Fld: TTemplateField;
562 Temp, NewTxt, FldName: string;
563 FoundEntry: boolean;
564
565begin
566 if(not assigned(uEntries)) then
567 uEntries := TStringList.Create;
568 Temp := Text;
569 Result := FALSE;
570 repeat
571 i := pos(TemplateFieldBeginSignature, Temp);
572 if(i > 0) then
573 begin
574 CtrlID := 0;
575 if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
576 begin
577 CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
578 delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
579 end;
580 j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
581 if(j > 0) then
582 begin
583 inc(j, i + TemplateFieldSignatureLen - 1);
584 flen := j - i - TemplateFieldSignatureLen;
585 FldName := copy(Temp, i + TemplateFieldSignatureLen, flen);
586 Fld := GetTemplateField(FldName, FALSE);
587 delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
588 end
589 else
590 begin
591 delete(Temp,i,TemplateFieldSignatureLen);
592 Fld := nil;
593 end;
594 if(CtrlID > 0) and (assigned(Fld)) and (Fld.Required) then
595 begin
596 FoundEntry := FALSE;
597 for j := 0 to uEntries.Count-1 do
598 begin
599 Entry := TTemplateDialogEntry(uEntries.Objects[j]);
600 if(assigned(Entry)) then
601 begin
602 NewTxt := Entry.GetControlText(CtrlID, TRUE, FoundEntry, FALSE);
603 if FoundEntry and (NewTxt = '') then{(Trim(NewTxt) = '') then //CODE ADDED BACK IN - VHAISPBELLC}
604 Result := TRUE;
605 end;
606 if FoundEntry then break;
607 end;
608 if (not FoundEntry) and assigned(FldValues) then
609 begin
610 j := FldValues.IndexOfPiece(IntToStr(CtrlID));
611 if(j < 0) or (Piece(FldValues[j],U,2) = '') then
612 Result := TRUE;
613 end;
614 end;
615 end;
616 until((i = 0) or Result);
617end;
618
619function HasTemplateField(txt: string): boolean;
620begin
621 Result := (pos(TemplateFieldBeginSignature, txt) > 0);
622end;
623
624function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
625var
626 i, idx: integer;
627 AData: TStrings;
628
629begin
630 Result := nil;
631 if(not assigned(uTmplFlds)) then
632 uTmplFlds := TList.Create;
633 idx := -1;
634 for i := 0 to uTmplFlds.Count-1 do
635 begin
636 if(ByIEN) then
637 begin
638 if(TTemplateField(uTmplFlds[i]).FID = ATemplateField) then
639 begin
640 idx := i;
641 break;
642 end;
643 end
644 else
645 begin
646 if(TTemplateField(uTmplFlds[i]).FFldName = ATemplateField) then
647 begin
648 idx := i;
649 break;
650 end;
651 end;
652 end;
653 if(idx < 0) then
654 begin
655 if(ByIEN) then
656 AData := LoadTemplateFieldByIEN(ATemplateField)
657 else
658 AData := LoadTemplateField(ATemplateField);
659 if(AData.Count > 1) then
660 Result := TTemplateField.Create(AData);
661 end
662 else
663 Result := TTemplateField(uTmplFlds[idx]);
664end;
665
666function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
667const
668 DUPFLD = 'Field Name is not unique';
669
670var
671 i: integer;
672 msg: string;
673
674begin
675 msg := '';
676 if(Fld.FldName = NewTemplateField) then
677 msg := 'Field Name can not be ' + NewTemplateField
678 else
679 if(length(Fld.FldName) < 3) then
680 msg := 'Field Name must be at least three characters in length'
681 else
682 if(not (Fld.FldName[1] in ['A'..'Z','0'..'9'])) then
683 msg := 'First Field Name character must be "A" - "Z", or "0" - "9"'
684 else
685 if(assigned(uTmplFlds)) then
686 begin
687 for i := 0 to uTmplFlds.Count-1 do
688 begin
689 if(Fld <> uTmplFlds[i]) and
690 (CompareText(TTemplateField(uTmplFlds[i]).FFldName, Fld.FFldName) = 0) then
691 begin
692 msg := DUPFLD;
693 break;
694 end;
695 end;
696 end;
697 if(msg = '') and (not IsTemplateFieldNameUnique(Fld.FFldName, Fld.ID)) then
698 msg := DUPFLD;
699 Result := (msg <> '');
700 if(Result) then
701 ShowMsg(msg);
702end;
703
704function SaveTemplateFieldErrors: string;
705var
706 i: integer;
707 Errors: TStringList;
708 Fld: TTemplateField;
709 msg: string;
710
711begin
712 Result := '';
713 if(assigned(uTmplFlds)) then
714 begin
715 Errors := nil;
716 try
717 for i := 0 to uTmplFlds.Count-1 do
718 begin
719 Fld := TTemplateField(uTmplFlds[i]);
720 if(Fld.FModified) then
721 begin
722 msg := Fld.SaveError;
723 if(msg <> '') then
724 begin
725 if(not assigned(Errors)) then
726 begin
727 Errors := TStringList.Create;
728 Errors.Add('The following template field save errors have occurred:');
729 Errors.Add('');
730 end;
731 Errors.Add(' ' + Fld.FldName + ': ' + msg);
732 end;
733 end;
734 end;
735 finally
736 if(assigned(Errors)) then
737 begin
738 Result := Errors.Text;
739 Errors.Free;
740 end;
741 end;
742 end;
743end;
744
745procedure ClearModifiedTemplateFields;
746var
747 i: integer;
748 Fld: TTemplateField;
749
750begin
751 if(assigned(uTmplFlds)) then
752 begin
753 for i := uTmplFlds.Count-1 downto 0 do
754 begin
755 Fld := TTemplateField(uTmplFlds[i]);
756 if(assigned(Fld)) and (Fld.FModified) then
757 begin
758 if Fld.FLocked then
759 UnlockTemplateField(Fld.FID);
760 Fld.Free;
761 end;
762 end;
763 end;
764end;
765
766function AnyTemplateFieldsModified: boolean;
767var
768 i: integer;
769
770begin
771 Result := FALSE;
772 if(assigned(uTmplFlds)) then
773 begin
774 for i := 0 to uTmplFlds.Count-1 do
775 begin
776 if(TTemplateField(uTmplFlds[i]).FModified) then
777 begin
778 Result := TRUE;
779 break;
780 end;
781 end;
782 end;
783end;
784
785procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
786var
787 i, j, k, flen, BadCount: integer;
788 flddesc, tmp, fld: string;
789 TmpList: TStringList;
790 InactiveList: TStringList;
791 FldObj: TTemplateField;
792
793begin
794 if(AText = '') then exit;
795 BadCount := 0;
796 InactiveList := TStringList.Create;
797 try
798 TmpList := TStringList.Create;
799 try
800 TmpList.Text := AText;
801 for k := 0 to TmpList.Count-1 do
802 begin
803 tmp := TmpList[k];
804 repeat
805 i := pos(TemplateFieldBeginSignature, tmp);
806 if(i > 0) then
807 begin
808 fld := '';
809 j := pos(TemplateFieldEndSignature, copy(tmp, i + TemplateFieldSignatureLen, MaxInt));
810 if(j > 0) then
811 begin
812 inc(j, i + TemplateFieldSignatureLen - 1);
813 flen := j - i - TemplateFieldSignatureLen;
814 fld := copy(tmp,i + TemplateFieldSignatureLen, flen);
815 delete(tmp, i, flen + TemplateFieldSignatureLen + 1);
816 end
817 else
818 begin
819 delete(tmp,i,TemplateFieldSignatureLen);
820 inc(BadCount);
821 end;
822 if(fld <> '') then
823 begin
824 if ListErrors then
825 begin
826 FldObj := GetTemplateField(fld, FALSE);
827 if assigned(FldObj) then
828 begin
829 if FldObj.Inactive then
830 InactiveList.Add(' "' + fld + '"');
831 flddesc := '';
832 end
833 else
834 flddesc := ' "' + fld + '"';
835 end
836 else
837 flddesc := fld;
838 if(flddesc <> '') and (AList.IndexOf(flddesc) < 0) then
839 AList.Add(flddesc)
840 end;
841 end;
842 until (i = 0);
843 end;
844 finally
845 TmpList.Free;
846 end;
847 if ListErrors then
848 begin
849 if(AList.Count > 0) then
850 AList.Insert(0, 'The following template fields were not found:');
851 if (BadCount > 0) then
852 begin
853 if(BadCount = 1) then
854 tmp := 'A template field marker "' + TemplateFieldBeginSignature +
855 '" was found without a'
856 else
857 tmp := IntToStr(BadCount) + ' template field markers "' + TemplateFieldBeginSignature +
858 '" were found without';
859 if(AList.Count > 0) then
860 AList.Add('');
861 AList.Add(tmp + ' matching "' + TemplateFieldEndSignature + '"');
862 end;
863 if(InactiveList.Count > 0) then
864 begin
865 if(AList.Count > 0) then
866 AList.Add('');
867 AList.Add('The following inactive template fields were found:');
868 FastAddStrings(InactiveList, AList);
869 end;
870 if(AList.Count > 0) then
871 begin
872 AList.Insert(0, 'Text contains template field errors:');
873 AList.Insert(1, '');
874 end;
875 end;
876 finally
877 InactiveList.Free;
878 end;
879end;
880
881function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
882var
883 Errors: TStringList;
884 btns: TMsgDlgButtons;
885
886begin
887 Result := TRUE;
888 Errors := TStringList.Create;
889 try
890 ListTemplateFields(AText, Errors, TRUE);
891 if(Errors.Count > 0) then
892 begin
893 if(Msg = 'OK') then
894 btns := [mbOK]
895 else
896 begin
897 btns := [mbAbort, mbIgnore];
898 Errors.Add('');
899 if(Msg = '') then
900 Msg := 'text insertion';
901 Errors.Add('Do you want to Abort ' + Msg + ', or Ignore the error and continue?');
902 end;
903 Result := (MessageDlg(Errors.Text, mtError, btns, 0) = mrIgnore);
904 end;
905 finally
906 Errors.Free;
907 end;
908end;
909
910procedure EnsureText(edt: TEdit; ud: TUpDown);
911var
912 v: integer;
913 s: string;
914
915begin
916 if assigned(ud.Associate) then
917 begin
918 v := StrToIntDef(edt.Text, ud.Position);
919 if (v < ud.Min) or (v > ud.Max) then
920 v := ud.Position;
921 s := IntToStr(v);
922 if edt.Text <> s then
923 edt.Text := s;
924 end;
925 edt.SelStart := edt.GetTextLen;
926end;
927
928function TemplateFieldCode2Field(const Code: string): TTemplateFieldType;
929var
930 typ: TTemplateFieldType;
931
932begin
933 Result := dftUnknown;
934 for typ := low(TTemplateFieldType) to high(TTemplateFieldType) do
935 if Code = TemplateFieldTypeCodes[typ] then
936 begin
937 Result := typ;
938 break;
939 end;
940end;
941
942function TemplateDateCode2DateType(const Code: string): TTmplFldDateType;
943var
944 typ: TTmplFldDateType;
945
946begin
947 Result := dtUnknown;
948 for typ := low(TTmplFldDateType) to high(TTmplFldDateType) do
949 if Code = TemplateFieldDateCodes[typ] then
950 begin
951 Result := typ;
952 break;
953 end;
954end;
955
956procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
957var
958 i: integer;
959 tmp, output: string;
960 ftype: TTemplateFieldType;
961 dtype: TTmplFldDateType;
962
963begin
964 for i := 0 to sl.Count-1 do
965 begin
966 tmp := sl[i];
967 if piece(tmp,U,4) = BOOLCHAR[TRUE] then
968 output := '* '
969 else
970 output := ' ';
971 ftype := TemplateFieldCode2Field(Piece(tmp, U, 3));
972 if ftype = dftDate then
973 begin
974 dtype := TemplateDateCode2DateType(Piece(tmp, U, 5));
975 output := output + TemplateDateTypeDesc[dtype, short];
976 end
977 else
978 output := output + TemplateFieldTypeDesc[ftype, short];
979 SetPiece(tmp, U, 3, output);
980 sl[i] := tmp;
981 end;
982end;
983
984{ TTemplateField }
985
986constructor TTemplateField.Create(AData: TStrings);
987var
988 tmp, p1: string;
989 AFID, i,idx,cnt: integer;
990
991begin
992 AFID := 0;
993 if(assigned(AData)) then
994 begin
995 if AData.Count > 0 then
996 AFID := StrToIntDef(AData[0],0);
997 if(AFID > 0) and (AData.Count > 1) then
998 begin
999 FID := IntToStr(AFID);
1000 FFldName := Piece(AData[1],U,1);
1001 FFldType := TemplateFieldCode2Field(Piece(AData[1],U,2));
1002 FInactive := (Piece(AData[1],U,3) = '1');
1003 FMaxLen := StrToIntDef(Piece(AData[1],U,4),0);
1004 FEditDefault := Piece(AData[1],U,5);
1005 FLMText := Piece(AData[1],U,6);
1006 idx := StrToIntDef(Piece(AData[1],U,7),0);
1007 cnt := 0;
1008 for i := 2 to AData.Count-1 do
1009 begin
1010 tmp := AData[i];
1011 p1 := Piece(tmp,U,1);
1012 tmp := Piece(tmp,U,2);
1013 if(p1 = 'D') then
1014 FNotes := FNotes + tmp + CRLF
1015 else
1016 if(p1 = 'U') then
1017 FURL := tmp
1018 else
1019 if(p1 = 'I') then
1020 begin
1021 inc(cnt);
1022 FItems := FItems + tmp + CRLF;
1023 if(cnt=idx) then
1024 FItemDefault := tmp;
1025 end;
1026 end;
1027 FRequired := (Piece(AData[1],U,8) = '1');
1028 FSepLines := (Piece(AData[1],U,9) = '1');
1029 FTextLen := StrToIntDef(Piece(AData[1],U,10),0);
1030 FIndent := StrToIntDef(Piece(AData[1],U,11),0);
1031 FPad := StrToIntDef(Piece(AData[1],U,12),0);
1032 FMinVal := StrToIntDef(Piece(AData[1],U,13),0);
1033 FMaxVal := StrToIntDef(Piece(AData[1],U,14),0);
1034 FIncrement := StrToIntDef(Piece(AData[1],U,15),0);
1035 FDateType := TemplateDateCode2DateType(Piece(AData[1],U,16));
1036 FModified := FALSE;
1037 FNameChanged := FALSE;
1038 end;
1039 end;
1040 if(AFID = 0) then
1041 begin
1042 inc(uNewTemplateFieldIDCnt);
1043 FID := IntToStr(-uNewTemplateFieldIDCnt);
1044 FFldName := NewTemplateField;
1045 FModified := TRUE;
1046 end;
1047 if(not assigned(uTmplFlds)) then
1048 uTmplFlds := TList.Create;
1049 uTmplFlds.Add(Self);
1050end;
1051
1052function TTemplateField.GetTemplateFieldDefault: string;
1053begin
1054 case FFldType of
1055 dftEditBox, dftNumber: Result := FEditDefault;
1056
1057 dftComboBox,
1058 dftButton,
1059 dftCheckBoxes, {Clear out embedded fields}
1060 dftRadioButtons: Result := StripEmbedded(FItemDefault);
1061
1062 dftDate: if FEditDefault <> '' then Result := FEditDefault;
1063
1064 dftHyperlink, dftText: if FEditDefault <> '' then
1065 Result := StripEmbedded(FEditDefault)
1066 else
1067 Result := URL;
1068
1069 dftWP: Result := Items;
1070 end;
1071end;
1072
1073procedure TTemplateField.CreateDialogControls(Entry: TTemplateDialogEntry;
1074 var Index: Integer; CtrlID: integer);
1075
1076var
1077 i, Aht, w, tmp, AWdth: integer;
1078 STmp: string;
1079 TmpSL: TStringList;
1080 edt: TEdit;
1081 cbo: TORComboBox;
1082 cb: TORCheckBox;
1083 btn: TfraTemplateFieldButton;
1084 dbox: TORDateBox;
1085 dcbo: TORDateCombo;
1086 lbl: TCPRSTemplateFieldLabel;
1087 re: TRichEdit;
1088 pnl: TCPRSDialogNumber;
1089 DefDate: TFMDateTime;
1090 ctrl: TControl;
1091
1092 function wdth: integer;
1093 begin
1094 if(Awdth < 0) then
1095 Awdth := FontWidthPixel(Entry.FFont.Handle);
1096 Result := Awdth;
1097 end;
1098
1099 function ht: integer;
1100 begin
1101 if(Aht < 0) then
1102 Aht := FontHeightPixel(Entry.FFont.Handle);
1103 Result := Aht;
1104 end;
1105
1106 procedure UpdateIndents(AControl: TControl);
1107 var
1108 idx: integer;
1109
1110 begin
1111 if (FIndent > 0) or (FPad > 0) then
1112 begin
1113 idx := Entry.FIndents.IndexOfObject(AControl);
1114 if idx < 0 then
1115 Entry.FIndents.AddObject(IntToStr(FIndent * wdth) + U + IntToStr(FPad), AControl);
1116 end;
1117 end;
1118
1119begin
1120 if(not FInactive) and (FFldType <> dftUnknown) then
1121 begin
1122 AWdth := -1;
1123 Aht := -1;
1124 ctrl := nil;
1125
1126 case FFldType of
1127 dftEditBox:
1128 begin
1129 edt := TCPRSDialogFieldEdit.Create(nil);
1130 (edt as ICPRSDialogComponent).RequiredField := Required;
1131 edt.Parent := Entry.FPanel;
1132 edt.BorderStyle := bsNone;
1133 edt.Height := ht;
1134 edt.Width := (wdth * Width + 4);
1135 if FTextLen > 0 then
1136 edt.MaxLength := FTextLen
1137 else
1138 edt.MaxLength := FMaxLen;
1139 edt.Text := FEditDefault;
1140 edt.Tag := CtrlID;
1141 edt.OnChange := Entry.DoChange;
1142 UpdateColorsFor508Compliance(edt, TRUE);
1143 ctrl := edt;
1144 end;
1145
1146 dftComboBox:
1147 begin
1148 cbo := TCPRSDialogComboBox.Create(nil);
1149 (cbo as ICPRSDialogComponent).RequiredField := Required;
1150 cbo.Parent := Entry.FPanel;
1151 cbo.TemplateField := TRUE;
1152 w := Width;
1153 cbo.MaxLength := w;
1154 if FTextLen > 0 then
1155 cbo.MaxLength := FTextLen
1156 else
1157 cbo.ListItemsOnly := TRUE;
1158 {Clear out embedded fields}
1159 cbo.Items.Text := StripEmbedded(Items);
1160 cbo.SelectByID(StripEmbedded(FItemDefault));
1161 cbo.Tag := CtrlID;
1162 cbo.OnChange := Entry.DoChange;
1163
1164 if cbo.Items.Count > 12 then
1165 begin
1166 cbo.Width := (wdth * w) + ScrollBarWidth + 8;
1167 cbo.DropDownCount := 12;
1168 end
1169 else
1170 begin
1171 cbo.Width := (wdth * w) + 18;
1172 cbo.DropDownCount := cbo.Items.Count;
1173 end;
1174 UpdateColorsFor508Compliance(cbo, TRUE);
1175 ctrl := cbo;
1176 end;
1177
1178 dftButton:
1179 begin
1180 btn := TfraTemplateFieldButton.Create(nil);
1181 (btn as ICPRSDialogComponent).RequiredField := Required;
1182 btn.Parent := Entry.FPanel;
1183 {Clear out embedded fields}
1184 btn.Items.Text := StripEmbedded(Items);
1185 btn.ButtonText := StripEmbedded(FItemDefault);
1186 btn.Height := ht;
1187 btn.Width := (wdth * Width) + 6;
1188 btn.Tag := CtrlID;
1189 btn.OnChange := Entry.DoChange;
1190 UpdateColorsFor508Compliance(btn);
1191 ctrl := btn;
1192 end;
1193
1194 dftCheckBoxes, dftRadioButtons:
1195 begin
1196 if FFldType = dftRadioButtons then
1197 inc(uRadioGroupIndex);
1198 TmpSL := TStringList.Create;
1199 try
1200 {Clear out embedded fields}
1201 TmpSL.Text := StripEmbedded(Items);
1202 for i := 0 to TmpSL.Count-1 do
1203 begin
1204 cb := TCPRSDialogCheckBox.Create(nil);
1205 if i = 0 then
1206 (cb as ICPRSDialogComponent).RequiredField := Required;
1207 cb.Parent := Entry.FPanel;
1208 cb.Caption := TmpSL[i];
1209 cb.AutoSize := TRUE;
1210 cb.AutoAdjustSize;
1211 // cb.AutoSize := FALSE;
1212 // cb.Height := ht;
1213 if FFldType = dftRadioButtons then
1214 begin
1215 cb.GroupIndex := uRadioGroupIndex;
1216 cb.RadioStyle := TRUE;
1217 end;
1218 if(TmpSL[i] = StripEmbedded(FItemDefault)) then
1219 cb.Checked := TRUE;
1220 cb.Tag := CtrlID;
1221 if FSepLines and (FFldType in SepLinesTypes) then
1222 cb.StringData := NewLine;
1223 cb.OnClick := Entry.DoChange;
1224 UpdateColorsFor508Compliance(cb);
1225 inc(Index);
1226 Entry.FControls.InsertObject(Index, '', cb);
1227 if (i=0) or FSepLines then
1228 UpdateIndents(cb);
1229 end;
1230 finally
1231 TmpSL.Free;
1232 end;
1233 end;
1234
1235 dftDate:
1236 begin
1237 if FEditDefault <> '' then
1238 DefDate := StrToFMDateTime(FEditDefault)
1239 else
1240 DefDate := 0;
1241 if FDateType in DateComboTypes then
1242 begin
1243 dcbo := TCPRSDialogDateCombo.Create(nil);
1244 (dcbo as ICPRSDialogComponent).RequiredField := Required;
1245 dcbo.Parent := Entry.FPanel;
1246 dcbo.Tag := CtrlID;
1247 dcbo.IncludeBtn := (FDateType = dtCombo);
1248 dcbo.IncludeDay := (FDateType = dtCombo);
1249 dcbo.IncludeMonth := (FDateType <> dtYear);
1250 dcbo.FMDate := DefDate;
1251 dcbo.TemplateField := TRUE;
1252 dcbo.OnChange := Entry.DoChange;
1253 UpdateColorsFor508Compliance(dcbo, TRUE);
1254 ctrl := dcbo;
1255 end
1256 else
1257 begin
1258 dbox := TCPRSDialogDateBox.Create(nil);
1259 (dbox as ICPRSDialogComponent).RequiredField := Required;
1260 dbox.Parent := Entry.FPanel;
1261 dbox.Tag := CtrlID;
1262 dbox.DateOnly := (FDateType = dtDate);
1263 dbox.RequireTime := (FDateType = dtDateReqTime);
1264 dbox.TemplateField := TRUE;
1265 dbox.FMDateTime := DefDate;
1266 if (FDateType = dtDate) then
1267 tmp := 11
1268 else
1269 tmp := 17;
1270 dbox.Width := (wdth * tmp) + 18;
1271 dbox.OnChange := Entry.DoChange;
1272 UpdateColorsFor508Compliance(dbox, TRUE);
1273 ctrl := dbox;
1274 end;
1275 end;
1276
1277 dftNumber:
1278 begin
1279 pnl := TCPRSDialogNumber.CreatePanel(nil);
1280 (pnl as ICPRSDialogComponent).RequiredField := Required;
1281 pnl.Parent := Entry.FPanel;
1282 pnl.BevelOuter := bvNone;
1283 pnl.Tag := CtrlID;
1284 pnl.Edit.Height := ht;
1285 pnl.Edit.Width := (wdth * 5 + 4);
1286 pnl.UpDown.Min := MinVal;
1287 pnl.UpDown.Max := MaxVal;
1288 pnl.UpDown.Min := MinVal; // Both ud.Min settings are needeed!
1289 i := Increment;
1290 if i < 1 then i := 1;
1291 pnl.UpDown.Increment := i;
1292 pnl.UpDown.Position := StrToIntDef(EditDefault, 0);
1293 pnl.Edit.OnChange := Entry.UpDownChange;
1294 pnl.Height := pnl.Edit.Height;
1295 pnl.Width := pnl.Edit.Width + pnl.UpDown.Width;
1296 UpdateColorsFor508Compliance(pnl, TRUE);
1297 //CQ 17597 wat
1298 pnl.Edit.Align := alLeft;
1299 pnl.UpDown.Align := alLeft;
1300 //end 17597
1301 ctrl := pnl;
1302 end;
1303
1304 dftHyperlink, dftText:
1305 begin
1306 if (FFldType = dftHyperlink) and User.WebAccess then
1307 lbl := TCPRSDialogHyperlinkLabel.Create(nil)
1308 else
1309 lbl := TCPRSTemplateFieldLabel.Create(nil);
1310 lbl.Parent := Entry.FPanel;
1311 lbl.ShowAccelChar := FALSE;
1312 lbl.Exclude := FSepLines;
1313 if (FFldType = dftHyperlink) then
1314 begin
1315 if FEditDefault <> '' then
1316 lbl.Caption := StripEmbedded(FEditDefault)
1317 else
1318 lbl.Caption := URL;
1319 end
1320 else
1321 begin
1322 STmp := StripEmbedded(Items);
1323 if copy(STmp,length(STmp)-1,2) = CRLF then
1324 delete(STmp,length(STmp)-1,2);
1325 lbl.Caption := STmp;
1326 end;
1327 if lbl is TCPRSDialogHyperlinkLabel then
1328 TCPRSDialogHyperlinkLabel(lbl).Init(FURL);
1329 lbl.Tag := CtrlID;
1330 UpdateColorsFor508Compliance(lbl);
1331 ctrl := lbl;
1332 end;
1333
1334 dftWP:
1335 begin
1336 re := TCPRSDialogRichEdit.Create(nil);
1337 (re as ICPRSDialogComponent).RequiredField := Required;
1338 re.Parent := Entry.FPanel;
1339 re.Tag := CtrlID;
1340 tmp := FMaxLen;
1341 if tmp < 5 then
1342 tmp := 5;
1343 re.Width := wdth * tmp;
1344 tmp := FTextLen;
1345 if tmp < 2 then
1346 tmp := 2
1347 else
1348 if tmp > MaxTFWPLines then
1349 tmp := MaxTFWPLines;
1350 re.Height := ht * tmp;
1351 re.BorderStyle := bsNone;
1352 re.ScrollBars := ssVertical;
1353 re.Lines.Text := Items;
1354 re.OnChange := Entry.DoChange;
1355 UpdateColorsFor508Compliance(re, TRUE);
1356 ctrl := re;
1357 end;
1358 end;
1359 if assigned(ctrl) then
1360 begin
1361 inc(Index);
1362 Entry.FControls.InsertObject(Index, '', ctrl);
1363 UpdateIndents(ctrl);
1364 end;
1365 end;
1366end;
1367
1368function TTemplateField.CanModify: boolean;
1369begin
1370 if((not FModified) and (not FLocked) and (StrToIntDef(FID,0) > 0)) then
1371 begin
1372 FLocked := LockTemplateField(FID);
1373 Result := FLocked;
1374 if(not FLocked) then
1375 ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.');
1376 end
1377 else
1378 Result := TRUE;
1379 if(Result) then FModified := TRUE;
1380end;
1381
1382procedure TTemplateField.SetEditDefault(const Value: string);
1383begin
1384 if(FEditDefault <> Value) and CanModify then
1385 FEditDefault := Value;
1386end;
1387
1388procedure TTemplateField.SetFldName(const Value: string);
1389begin
1390 if(FFldName <> Value) and CanModify then
1391 begin
1392 FFldName := Value;
1393 FNameChanged := TRUE;
1394 end;
1395end;
1396
1397procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
1398begin
1399 if(FFldType <> Value) and CanModify then
1400 begin
1401 FFldType := Value;
1402 if(Value = dftEditBox) then
1403 begin
1404 if (FMaxLen < 1) then
1405 FMaxLen := 1;
1406 if FTextLen < FMaxLen then
1407 FTextLen := FMaxLen;
1408 end
1409 else
1410 if(Value = dftHyperlink) and (FURL = '') then
1411 FURL := 'http://'
1412 else
1413 if(Value = dftComboBox) and (FMaxLen < 1) then
1414 begin
1415 FMaxLen := Width;
1416 if FMaxLen < 1 then
1417 FMaxLen := 1;
1418 end
1419 else
1420 if(Value = dftWP) then
1421 begin
1422 if (FMaxLen = 0) then
1423 FMaxLen := MAX_ENTRY_WIDTH
1424 else
1425 if (FMaxLen < 5) then
1426 FMaxLen := 5;
1427 if FTextLen < 2 then
1428 FTextLen := 2;
1429 end
1430 else
1431 if(Value = dftDate) and (FDateType = dtUnknown) then
1432 FDateType := dtDate;
1433 end;
1434end;
1435
1436procedure TTemplateField.SetID(const Value: string);
1437begin
1438// if(FID <> Value) and CanModify then
1439 FID := Value;
1440end;
1441
1442procedure TTemplateField.SetInactive(const Value: boolean);
1443begin
1444 if(FInactive <> Value) and CanModify then
1445 FInactive := Value;
1446end;
1447
1448procedure TTemplateField.SetItemDefault(const Value: string);
1449begin
1450 if(FItemDefault <> Value) and CanModify then
1451 FItemDefault := Value;
1452end;
1453
1454procedure TTemplateField.SetItems(const Value: string);
1455begin
1456 if(FItems <> Value) and CanModify then
1457 FItems := Value;
1458end;
1459
1460procedure TTemplateField.SetLMText(const Value: string);
1461begin
1462 if(FLMText <> Value) and CanModify then
1463 FLMText := Value;
1464end;
1465
1466procedure TTemplateField.SetMaxLen(const Value: integer);
1467begin
1468 if(FMaxLen <> Value) and CanModify then
1469 FMaxLen := Value;
1470end;
1471
1472procedure TTemplateField.SetNotes(const Value: string);
1473begin
1474 if(FNotes <> Value) and CanModify then
1475 FNotes := Value;
1476end;
1477
1478function TTemplateField.SaveError: string;
1479var
1480 TmpSL, FldSL: TStringList;
1481 AID,Res: string;
1482 idx, i: integer;
1483 IEN64: Int64;
1484 NewRec: boolean;
1485
1486begin
1487 if(FFldName = NewTemplateField) then
1488 begin
1489 Result := 'Template Field can not be named "' + NewTemplateField + '"';
1490 exit;
1491 end;
1492 Result := '';
1493 NewRec := (StrToIntDef(FID,0) < 0);
1494 if(FModified or NewRec) then
1495 begin
1496 TmpSL := TStringList.Create;
1497 try
1498 FldSL := TStringList.Create;
1499 try
1500 if(StrToIntDef(FID,0) > 0) then
1501 AID := FID
1502 else
1503 AID := '0';
1504 FldSL.Add('.01='+FFldName);
1505 FldSL.Add('.02='+TemplateFieldTypeCodes[FFldType]);
1506 FldSL.Add('.03='+BOOLCHAR[FInactive]);
1507 FldSL.Add('.04='+IntToStr(FMaxLen));
1508 FldSL.Add('.05='+FEditDefault);
1509 FldSL.Add('.06='+FLMText);
1510 idx := -1;
1511 if(FItems <> '') and (FItemDefault <> '') then
1512 begin
1513 TmpSL.Text := FItems;
1514 for i := 0 to TmpSL.Count-1 do
1515 if(FItemDefault = TmpSL[i]) then
1516 begin
1517 idx := i;
1518 break;
1519 end;
1520 end;
1521 FldSL.Add('.07='+IntToStr(Idx+1));
1522 FldSL.Add('.08='+BOOLCHAR[fRequired]);
1523 FldSL.Add('.09='+BOOLCHAR[fSepLines]);
1524 FldSL.Add('.1=' +IntToStr(FTextLen));
1525 FldSL.Add('.11='+IntToStr(FIndent));
1526 FldSL.Add('.12='+IntToStr(FPad));
1527 FldSL.Add('.13='+IntToStr(FMinVal));
1528 FldSL.Add('.14='+IntToStr(FMaxVal));
1529 FldSL.Add('.15='+IntToStr(FIncrement));
1530 if FDateType = dtUnknown then
1531 FldSL.Add('.16=@')
1532 else
1533 FldSL.Add('.16='+TemplateFieldDateCodes[FDateType]);
1534
1535 if FURL='' then
1536 FldSL.Add('3=@')
1537 else
1538 FldSL.Add('3='+FURL);
1539
1540 if(FNotes <> '') or (not NewRec) then
1541 begin
1542 if(FNotes = '') then
1543 FldSL.Add('2,1=@')
1544 else
1545 begin
1546 TmpSL.Text := FNotes;
1547 for i := 0 to TmpSL.Count-1 do
1548 FldSL.Add('2,'+IntToStr(i+1)+',0='+TmpSL[i]);
1549 end;
1550 end;
1551 if((FItems <> '') or (not NewRec)) then
1552 begin
1553 if(FItems = '') then
1554 FldSL.Add('10,1=@')
1555 else
1556 begin
1557 TmpSL.Text := FItems;
1558 for i := 0 to TmpSL.Count-1 do
1559 FldSL.Add('10,'+IntToStr(i+1)+',0='+TmpSL[i]);
1560 end;
1561 end;
1562
1563 Res := UpdateTemplateField(AID, FldSL);
1564 IEN64 := StrToInt64Def(Piece(Res,U,1),0);
1565 if(IEN64 > 0) then
1566 begin
1567 if(NewRec) then
1568 FID := IntToStr(IEN64)
1569 else
1570 UnlockTemplateField(FID);
1571 FModified := FALSE;
1572 FNameChanged := FALSE;
1573 FLocked := FALSE;
1574 end
1575 else
1576 Result := Piece(Res, U, 2);
1577 finally
1578 FldSL.Free;
1579 end;
1580 finally
1581 TmpSL.Free;
1582 end;
1583 end;
1584end;
1585
1586procedure TTemplateField.Assign(AFld: TTemplateField);
1587begin
1588 FMaxLen := AFld.FMaxLen;
1589 FFldName := AFld.FFldName;
1590 FLMText := AFld.FLMText;
1591 FEditDefault := AFld.FEditDefault;
1592 FNotes := AFld.FNotes;
1593 FItems := AFld.FItems;
1594 FInactive := AFld.FInactive;
1595 FItemDefault := AFld.FItemDefault;
1596 FFldType := AFld.FFldType;
1597 FRequired := AFld.FRequired;
1598 FSepLines := AFld.FSepLines;
1599 FTextLen := AFld.FTextLen;
1600 FIndent := AFld.FIndent;
1601 FPad := AFld.FPad;
1602 FMinVal := AFld.FMinVal;
1603 FMaxVal := AFld.FMaxVal;
1604 FIncrement := AFld.FIncrement;
1605 FDateType := AFld.FDateType;
1606 FURL := AFld.FURL;
1607end;
1608
1609function TTemplateField.Width: integer;
1610var
1611 i, ilen: integer;
1612 TmpSL: TStringList;
1613
1614begin
1615 if(FFldType = dftEditBox) then
1616 Result := FMaxLen
1617 else
1618 begin
1619 if FMaxLen > 0 then
1620 Result := FMaxLen
1621 else
1622 begin
1623 Result := -1;
1624 TmpSL := TStringList.Create;
1625 try
1626 TmpSL.Text := StripEmbedded(FItems);
1627 for i := 0 to TmpSL.Count-1 do
1628 begin
1629 ilen := length(TmpSL[i]);
1630 if(Result < ilen) then
1631 Result := ilen;
1632 end;
1633 finally
1634 TmpSL.Free;
1635 end;
1636 end;
1637 end;
1638 if Result > MaxTFEdtLen then
1639 Result := MaxTFEdtLen;
1640end;
1641
1642destructor TTemplateField.Destroy;
1643begin
1644 uTmplFlds.Remove(Self);
1645 inherited;
1646end;
1647
1648procedure TTemplateField.SetRequired(const Value: boolean);
1649begin
1650 if(FRequired <> Value) and CanModify then
1651 FRequired := Value;
1652end;
1653
1654function TTemplateField.NewField: boolean;
1655begin
1656 Result := (StrToIntDef(FID,0) <= 0);
1657end;
1658
1659procedure TTemplateField.SetSepLines(const Value: boolean);
1660begin
1661 if(FSepLines <> Value) and CanModify then
1662 FSepLines := Value
1663end;
1664
1665procedure TTemplateField.SetIncrement(const Value: integer);
1666begin
1667 if(FIncrement <> Value) and CanModify then
1668 FIncrement := Value;
1669end;
1670
1671procedure TTemplateField.SetIndent(const Value: integer);
1672begin
1673 if(FIndent <> Value) and CanModify then
1674 FIndent := Value;
1675end;
1676
1677procedure TTemplateField.SetMaxVal(const Value: integer);
1678begin
1679 if(FMaxVal <> Value) and CanModify then
1680 FMaxVal := Value;
1681end;
1682
1683procedure TTemplateField.SetMinVal(const Value: integer);
1684begin
1685 if(FMinVal <> Value) and CanModify then
1686 FMinVal := Value;
1687end;
1688
1689procedure TTemplateField.SetPad(const Value: integer);
1690begin
1691 if(FPad <> Value) and CanModify then
1692 FPad := Value;
1693end;
1694
1695procedure TTemplateField.SetTextLen(const Value: integer);
1696begin
1697 if(FTextLen <> Value) and CanModify then
1698 FTextLen := Value;
1699end;
1700
1701procedure TTemplateField.SetURL(const Value: string);
1702begin
1703 if(FURL <> Value) and CanModify then
1704 FURL := Value;
1705end;
1706
1707function TTemplateField.GetRequired: boolean;
1708begin
1709 if FFldType in NoRequired then
1710 Result := FALSE
1711 else
1712 Result := FRequired;
1713end;
1714
1715procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
1716begin
1717 if(FDateType <> Value) and CanModify then
1718 FDateType := Value;
1719end;
1720
1721{ TTemplateDialogEntry }
1722const
1723 EOL_MARKER = #182;
1724 SR_BREAK = #186;
1725
1726procedure PanelDestroy(AData: Pointer; Sender: TObject);
1727var
1728 idx: integer;
1729 dlg: TTemplateDialogEntry;
1730
1731begin
1732 dlg := TTemplateDialogEntry(AData);
1733 idx := uEntries.IndexOf(dlg.FID);
1734 if(idx >= 0) then
1735 uEntries.Delete(idx);
1736 dlg.FPanelDying := TRUE;
1737 dlg.Free;
1738end;
1739
1740constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
1741var
1742 CtrlID, idx, i, j, flen: integer;
1743 txt, FldName: string;
1744 Fld: TTemplateField;
1745
1746begin
1747 FID := AID;
1748 FText := Text;
1749 FControls := TStringList.Create;
1750 FIndents := TStringList.Create;
1751 FFont := TFont.Create;
1752 FFont.Assign(TORExposedControl(AParent).Font);
1753 FControls.Text := Text;
1754 if(FControls.Count > 1) then
1755 begin
1756 for i := 1 to FControls.Count-1 do
1757 FControls[i] := EOL_MARKER + FControls[i];
1758 if not ScreenReaderSystemActive then
1759 StripScreenReaderCodes(FControls);
1760 end;
1761 FFirstBuild := TRUE;
1762 FPanel := TDlgFieldPanel.Create(AParent.Owner);
1763 FPanel.Parent := AParent;
1764 FPanel.BevelOuter := bvNone;
1765 FPanel.Caption := '';
1766 FPanel.Font.Assign(FFont);
1767 UpdateColorsFor508Compliance(FPanel, TRUE);
1768 idx := 0;
1769 while (idx < FControls.Count) do
1770 begin
1771 txt := FControls[idx];
1772 i := pos(TemplateFieldBeginSignature, txt);
1773 if(i > 0) then
1774 begin
1775 if(copy(txt, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
1776 begin
1777 CtrlID := StrToIntDef(copy(txt, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
1778 delete(txt,i + TemplateFieldSignatureLen, FieldIDLen);
1779 end
1780 else
1781 CtrlID := 0;
1782 j := pos(TemplateFieldEndSignature, copy(txt, i + TemplateFieldSignatureLen, MaxInt));
1783 if(j > 0) then
1784 begin
1785 inc(j, i + TemplateFieldSignatureLen - 1);
1786 flen := j - i - TemplateFieldSignatureLen;
1787 FldName := copy(txt, i + TemplateFieldSignatureLen, flen);
1788 Fld := GetTemplateField(FldName, FALSE);
1789 delete(txt,i,flen + TemplateFieldSignatureLen + 1);
1790 if(assigned(Fld)) then
1791 begin
1792 FControls[idx] := copy(txt,1,i-1);
1793 if(Fld.Required) then
1794 begin
1795 if ScreenReaderSystemActive then
1796 begin
1797 if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then
1798 FControls[idx] := FControls[idx] + ScreenReaderStopCode;
1799 end;
1800 FControls[idx] := FControls[idx] + '*';
1801 end;
1802 Fld.CreateDialogControls(Self, idx, CtrlID);
1803 FControls.Insert(idx+1,copy(txt,i,MaxInt));
1804 end
1805 else
1806 begin
1807 FControls[idx] := txt;
1808 dec(idx);
1809 end;
1810 end
1811 else
1812 begin
1813 delete(txt,i,TemplateFieldSignatureLen);
1814 FControls[idx] := txt;
1815 dec(idx);
1816 end;
1817 end;
1818 inc(idx);
1819 end;
1820 if ScreenReaderSystemActive then
1821 begin
1822 idx := 0;
1823 while (idx < FControls.Count) do
1824 begin
1825 txt := FControls[idx];
1826 i := pos(ScreenReaderStopCode, txt);
1827 if i > 0 then
1828 begin
1829 FControls[idx] := copy(txt, 1, i-1);
1830 txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt);
1831 FControls.Insert(idx+1, SR_BREAK + txt);
1832 end;
1833 inc(idx);
1834 end;
1835 end;
1836end;
1837
1838destructor TTemplateDialogEntry.Destroy;
1839begin
1840 if assigned(FOnDestroy) then
1841 FOnDestroy(Self);
1842 KillLabels;
1843 KillObj(@FControls, TRUE);
1844 if FPanelDying then
1845 FPanel := nil
1846 else
1847 FreeAndNil(FPanel);
1848 FreeAndNil(FFont);
1849 FreeAndNil(FIndents);
1850 inherited;
1851end;
1852
1853procedure TTemplateDialogEntry.DoChange(Sender: TObject);
1854begin
1855 if (not FUpdating) and assigned(FOnChange) then
1856 FOnChange(Self);
1857end;
1858
1859function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
1860 var FoundEntry: boolean; AutoWrap: boolean;
1861 emField: string = ''): string;
1862var
1863 x, i, j, ind, idx: integer;
1864 Ctrl: TControl;
1865 Done: boolean;
1866 iString: string;
1867 iField: TTemplateField;
1868 iTemp: TStringList;
1869
1870 function GetOriginalItem(istr: string): string;
1871 begin
1872 Result := '';
1873 if emField <> '' then
1874 begin
1875 iField := GetTemplateField(emField,FALSE);
1876 iTemp := nil;
1877 if ifield <> nil then
1878 try
1879 iTemp := TStringList.Create;
1880 iTemp.Text := StripEmbedded(iField.Items);
1881 x := iTemp.IndexOf(istr);
1882 if x >= 0 then
1883 begin
1884 iTemp.Text := iField.Items;
1885 Result := iTemp.Strings[x];
1886 end;
1887 finally
1888 iTemp.Free;
1889 end;
1890 end;
1891 end;
1892
1893
1894begin
1895 Result := '';
1896 Done := FALSE;
1897 ind := -1;
1898 for i := 0 to FControls.Count-1 do
1899 begin
1900 Ctrl := TControl(FControls.Objects[i]);
1901 if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
1902 begin
1903 FoundEntry := TRUE;
1904 Done := TRUE;
1905 if ind < 0 then
1906 begin
1907 idx := FIndents.IndexOfObject(Ctrl);
1908 if idx >= 0 then
1909 ind := StrToIntDef(Piece(FIndents[idx], U, 2), 0)
1910 else
1911 ind := 0;
1912 end;
1913 if(Ctrl is TCPRSTemplateFieldLabel) then
1914 begin
1915 if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin
1916 if emField <> '' then begin
1917 iField := GetTemplateField(emField,FALSE);
1918 case iField.FldType of
1919 dftHyperlink: if iField.EditDefault <> '' then
1920 Result := iField.EditDefault
1921 else
1922 Result := iField.URL;
1923 dftText: begin
1924 iString := iField.Items;
1925 if copy(iString,length(iString)-1,2) = CRLF then
1926 delete(iString,length(iString)-1,2);
1927 Result := iString;
1928 end;
1929 else {case}
1930 Result := TCPRSTemplateFieldLabel(Ctrl).Caption
1931 end; {case iField.FldType}
1932 end {if emField}
1933 else
1934 Result := TCPRSTemplateFieldLabel(Ctrl).Caption;
1935 end;
1936 end
1937 else
1938 //!!!!!! CODE ADDED BACK IN - VHAISPBELLC !!!!!!
1939 if(Ctrl is TEdit) then
1940 Result := TEdit(Ctrl).Text
1941 else
1942 if(Ctrl is TORComboBox) then begin
1943 Result := TORComboBox(Ctrl).Text;
1944 iString := GetOriginalItem(Result);
1945 if iString <> '' then
1946 Result := iString;
1947 end
1948 else
1949 if(Ctrl is TORDateCombo) then
1950 Result := TORDateCombo(Ctrl).Text + ':' + FloatToStr(TORDateCombo(Ctrl).FMDate)
1951 else
1952 {!!!!!! THIS HAS BEEN REMOVED AS IT CAUSED PROBLEMS WITH REMINDER DIALOGS - VHAISPBELLC !!!!!!
1953 if(Ctrl is TORDateBox) then begin
1954 if TORDateBox(Ctrl).IsValid then
1955 Result := TORDateBox(Ctrl).Text
1956 else
1957 Result := '';
1958 end else
1959 }
1960 //!!!!!! CODE ADDED BACK IN - VHAISPBELLC !!!!!!
1961 if(Ctrl is TORDateBox) then
1962 Result := TORDateBox(Ctrl).Text
1963 else
1964 if(Ctrl is TRichEdit) then
1965 begin
1966 if((ind = 0) and (not AutoWrap)) then
1967 Result := TRichEdit(Ctrl).Lines.Text
1968 else
1969 begin
1970 for j := 0 to TRichEdit(Ctrl).Lines.Count-1 do
1971 begin
1972 if AutoWrap then
1973 begin
1974 if(Result <> '') then
1975 Result := Result + ' ';
1976 Result := Result + TRichEdit(Ctrl).Lines[j];
1977 end
1978 else
1979 begin
1980 if(Result <> '') then
1981 Result := Result + CRLF;
1982 Result := Result + StringOfChar(' ', ind) + TRichEdit(Ctrl).Lines[j];
1983 end;
1984 end;
1985 ind := 0;
1986 end;
1987 end
1988 else
1989 {!!!!!! THIS HAS BEEN REMOVED AS IT CAUSED PROBLEMS WITH REMINDER DIALOGS - VHAISPBELLC !!!!!!
1990 if(Ctrl is TEdit) then
1991 Result := TEdit(Ctrl).Text
1992 else }
1993 if(Ctrl is TORCheckBox) then
1994 begin
1995 Done := FALSE;
1996 if(TORCheckBox(Ctrl).Checked) then
1997 begin
1998 if(Result <> '') then
1999 begin
2000 if NoCommas then
2001 Result := Result + '|'
2002 else
2003 Result := Result + ', ';
2004 end;
2005 iString := GetOriginalItem(TORCheckBox(Ctrl).Caption);
2006 if iString <> '' then
2007 Result := Result + iString
2008 else
2009 Result := Result + TORCheckBox(Ctrl).Caption;
2010 end;
2011 end
2012 else
2013 if(Ctrl is TfraTemplateFieldButton) then
2014 begin
2015 Result := TfraTemplateFieldButton(Ctrl).ButtonText;
2016 iString := GetOriginalItem(Result);
2017 if iString <> '' then
2018 Result := iString;
2019 end
2020 else
2021 if(Ctrl is TPanel) then
2022 begin
2023 for j := 0 to Ctrl.ComponentCount-1 do
2024 if Ctrl.Components[j] is TUpDown then
2025 begin
2026 Result := IntToStr(TUpDown(Ctrl.Components[j]).Position);
2027 break;
2028 end;
2029 end;
2030 end;
2031 if Done then break;
2032 end;
2033 if (ind > 0) and (not NoCommas) then
2034 Result := StringOfChar(' ', ind) + Result;
2035end;
2036
2037function TTemplateDialogEntry.GetFieldValues: string;
2038var
2039 i: integer;
2040 Ctrl: TControl;
2041 CtrlID: integer;
2042 TmpIDs: TList;
2043 TmpSL: TStringList;
2044 Dummy: boolean;
2045
2046begin
2047 Result := '';
2048 TmpIDs := TList.Create;
2049 try
2050 TmpSL := TStringList.Create;
2051 try
2052 for i := 0 to FControls.Count-1 do
2053 begin
2054 Ctrl := TControl(FControls.Objects[i]);
2055 if(assigned(Ctrl)) then
2056 begin
2057 CtrlID := Ctrl.Tag;
2058 if(TmpIDs.IndexOf(Pointer(CtrlID)) < 0) then
2059 begin
2060 TmpSL.Add(IntToStr(CtrlID) + U + GetControlText(CtrlID, TRUE, Dummy, FALSE));
2061 TmpIDs.Add(Pointer(CtrlID));
2062 end;
2063 end;
2064 end;
2065 Result := TmpSL.CommaText;
2066 finally
2067 TmpSL.Free;
2068 end;
2069 finally
2070 TmpIDs.Free;
2071 end;
2072end;
2073
2074function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl;
2075 OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
2076var
2077 i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
2078 MaxTextLen: integer; {Max num of chars per line in pixels}
2079 MaxChars: integer; {Max num of chars per line}
2080 txt: string;
2081 ctrl: TControl;
2082 LastLineBlank: boolean;
2083 sLbl: TCPRSDialogStaticLabel;
2084 nLbl: TVA508ChainedLabel;
2085 sLblHeight: integer;
2086 TabOrdr: integer;
2087
2088const
2089 FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
2090 overlay the focus rect on its parent panel.}
2091
2092 procedure Add2TabOrder(ctrl: TWinControl);
2093 begin
2094 ctrl.TabOrder := TabOrdr;
2095 inc(TabOrdr);
2096 end;
2097
2098 function StripSRCode(var txt: string; code: string; len: integer): integer;
2099 begin
2100 Result := pos(code, txt);
2101 if Result > 0 then
2102 begin
2103 delete(txt,Result,len);
2104 dec(Result);
2105 end
2106 else
2107 Result := -1;
2108 end;
2109
2110 procedure DoLabel(Atxt: string);
2111 var
2112 ctrl: TControl;
2113 tempLbl: TVA508ChainedLabel;
2114
2115 begin
2116 if ScreenReaderSystemActive then
2117 begin
2118 if assigned(sLbl) then
2119 begin
2120 tempLbl := TVA508ChainedLabel.Create(nil);
2121 if assigned(nLbl) then
2122 nLbl.NextLabel := tempLbl
2123 else
2124 sLbl.NextLabel := tempLbl;
2125 nLbl := tempLbl;
2126 ctrl := nLbl;
2127 end
2128 else
2129 begin
2130 sLbl := TCPRSDialogStaticLabel.Create(nil);
2131 ctrl := sLbl;
2132 end;
2133 end
2134 else
2135 ctrl := TLabel.Create(nil);
2136 SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE));
2137 SetStrProp(ctrl, CaptionProperty, Atxt);
2138 ctrl.Parent := FPanel;
2139 ctrl.Left := x;
2140 ctrl.Top := y;
2141 if ctrl = sLbl then
2142 begin
2143 Add2TabOrder(sLbl);
2144 sLbl.Height := sLblHeight;
2145 ScreenReaderSystem_CurrentLabel(sLbl);
2146 end;
2147 if ScreenReaderSystemActive then
2148 ScreenReaderSystem_AddText(Atxt);
2149 UpdateColorsFor508Compliance(ctrl);
2150 inc(x, ctrl.Width);
2151 end;
2152
2153 procedure Init;
2154 var
2155 lbl : TLabel;
2156 begin
2157 if(FFirstBuild) then
2158 FFirstBuild := FALSE
2159 else
2160 KillLabels;
2161 y := FOCUS_RECT_MARGIN; {placement of labels on panel so they don't cover the}
2162 x := FOCUS_RECT_MARGIN; {focus rectangle}
2163 MaxX := 0;
2164 //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2); AGP commentout line for
2165 //reminder spacing
2166 ybase := FontHeightPixel(FFont.Handle) + 2;
2167 yinc := ybase;
2168 LastLineBlank := FALSE;
2169 sLbl := nil;
2170 nLbl := nil;
2171 TabOrdr := 0;
2172 if ScreenReaderSystemActive then
2173 begin
2174 ScreenReaderSystem_CurrentCheckBox(OwningCheckBox);
2175 lbl := TLabel.Create(nil);
2176 try
2177 lbl.Parent := FPanel;
2178 sLblHeight := lbl.Height + 2;
2179 finally
2180 lbl.Free;
2181 end;
2182
2183 end;
2184 end;
2185
2186 procedure Text508Work;
2187 var
2188 ContinueCode: boolean;
2189 begin
2190 if StripCode(txt, SR_BREAK) then
2191 begin
2192 ScreenReaderSystem_Stop;
2193 nLbl := nil;
2194 sLbl := nil;
2195 end;
2196
2197 ContinueCode := FALSE;
2198 while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do
2199 ContinueCode := TRUE;
2200 while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do
2201 ContinueCode := TRUE;
2202 if ContinueCode then
2203 ScreenReaderSystem_Continue;
2204 end;
2205
2206 procedure Ctrl508Work(ctrl: TControl);
2207 var
2208 lbl: TCPRSTemplateFieldLabel;
2209 begin
2210 if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then
2211 begin
2212 lbl := Ctrl as TCPRSTemplateFieldLabel;
2213 if trim(lbl.Caption) <> '' then
2214 begin
2215 ScreenReaderSystem_CurrentLabel(lbl);
2216 ScreenReaderSystem_AddText(lbl.Caption);
2217 end
2218 else
2219 begin
2220 lbl.TabStop := FALSE;
2221 ScreenReaderSystem_Stop;
2222 end;
2223 end
2224 else
2225 begin
2226 if ctrl is TWinControl then
2227 Add2TabOrder(TWinControl(ctrl));
2228 if Supports(ctrl, ICPRSDialogComponent) then
2229 ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent);
2230 end;
2231 sLbl := nil;
2232 nLbl := nil;
2233 end;
2234
2235 procedure NextLine;
2236 begin
2237 if(MaxX < x) then
2238 MaxX := x;
2239 x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect}
2240 inc(y, yinc);
2241 yinc := ybase;
2242 end;
2243
2244begin
2245 MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
2246 if(FFirstBuild or (FPanel.Width <> MaxLen)) then
2247 begin
2248 Init;
2249 for i := 0 to FControls.Count-1 do
2250 begin
2251 txt := FControls[i];
2252 if ScreenReaderSystemActive then
2253 Text508Work;
2254 if StripCode(txt,EOL_MARKER) then
2255 begin
2256 if((x <> 0) or LastLineBlank) then
2257 NextLine;
2258 LastLineBlank := (txt = '');
2259 end;
2260 if(txt <> '') then
2261 begin
2262 while(txt <> '') do
2263 begin
2264 cnt := NumCharsFitInWidth(FFont.Handle, txt, MaxTextLen-x);
2265 MaxChars := cnt;
2266 if(cnt >= length(txt)) then
2267 begin
2268 DoLabel(txt);
2269 txt := '';
2270 end
2271 else
2272 if(cnt < 1) then
2273 NextLine
2274 else
2275 begin
2276 repeat
2277 if(txt[cnt+1] = ' ') then
2278 begin
2279 DoLabel(copy(txt,1,cnt));
2280 NextLine;
2281 txt := copy(txt, cnt + 1, MaxInt);
2282 break;
2283 end
2284 else
2285 dec(cnt);
2286 until(cnt = 0);
2287 if(cnt = 0) then
2288 begin
2289 if(x = FOCUS_RECT_MARGIN) then {If x is at the far left margin...}
2290 begin
2291 DoLabel(Copy(txt,1,MaxChars));
2292 NextLine;
2293 txt := copy(txt, MaxChars + 1, MaxInt);
2294 end
2295 else
2296 NextLine;
2297 end;
2298 end;
2299 end;
2300 end
2301 else
2302 begin
2303 ctrl := TControl(FControls.Objects[i]);
2304 if(assigned(ctrl)) then
2305 begin
2306 if ScreenReaderSystemActive then
2307 Ctrl508Work(ctrl);
2308 idx := FIndents.IndexOfObject(Ctrl);
2309 if idx >= 0 then
2310 ind := StrToIntDef(Piece(FIndents[idx], U, 1), 0)
2311 else
2312 ind := 0;
2313 if(x > 0) then
2314 begin
2315 if (x < MaxLen) and (Ctrl is TORCheckBox) and (TORCheckBox(Ctrl).StringData = NewLine) then
2316 x := MaxLen;
2317 if((ctrl.Width + x + ind) > MaxLen) then
2318 NextLine;
2319 end;
2320 inc(x,ind);
2321 Ctrl.Left := x;
2322 Ctrl.Top := y;
2323 inc(x, Ctrl.Width + 4);
2324 if yinc <= Ctrl.Height then
2325 yinc := Ctrl.Height + 2;
2326 if (x < MaxLen) and ((Ctrl is TRichEdit) or
2327 ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
2328 x := MaxLen;
2329 end;
2330 end;
2331 end;
2332 NextLine;
2333 FPanel.Height := (y-1) + (FOCUS_RECT_MARGIN * 2); //AGP added Focus_rect_margin for Reminder spacing
2334 FPanel.Width := MaxX + FOCUS_RECT_MARGIN;
2335 end;
2336 if(FFieldValues <> '') then
2337 SetFieldValues(FFieldValues);
2338 if ScreenReaderSystemActive then
2339 ScreenReaderSystem_Stop;
2340 Result := FPanel;
2341end;
2342
2343function TTemplateDialogEntry.GetText: string;
2344begin
2345 Result := ResolveTemplateFields(FText, FALSE);
2346end;
2347
2348procedure TTemplateDialogEntry.KillLabels;
2349var
2350 i, idx: integer;
2351 obj: TObject;
2352 max: integer;
2353
2354begin
2355 if(assigned(FPanel)) then
2356 begin
2357 max := FPanel.ControlCount-1;
2358 for i := max downto 0 do
2359 begin
2360// deleting TVA508StaticText can delete several TVA508ChainedLabel components
2361 if i < FPanel.ControlCount then
2362 begin
2363 obj := FPanel.Controls[i];
2364 if (not (obj is TVA508ChainedLabel)) and
2365 ((obj is TLabel) or (obj is TVA508StaticText)) then
2366 begin
2367 idx := FControls.IndexOfObject(obj);
2368 if idx < 0 then
2369 obj.Free;
2370 end;
2371 end;
2372 end;
2373 end;
2374end;
2375
2376procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
2377 const Value: boolean);
2378var
2379 M: TMethod;
2380
2381begin
2382 FAutoDestroyOnPanelFree := Value;
2383 if(Value) then
2384 begin
2385 M.Data := Self;
2386 M.Code := @PanelDestroy;
2387 FPanel.OnDestroy := TNotifyEvent(M);
2388 end
2389 else
2390 FPanel.OnDestroy := nil;
2391end;
2392
2393procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
2394var
2395 cnt, i, j: integer;
2396 Ctrl: TControl;
2397 Done: boolean;
2398
2399begin
2400 FUpdating := TRUE;
2401 try
2402 Done := FALSE;
2403 cnt := 0;
2404 for i := 0 to FControls.Count-1 do
2405 begin
2406 Ctrl := TControl(FControls.Objects[i]);
2407 if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
2408 begin
2409 Done := TRUE;
2410 if(Ctrl is TLabel) then
2411 TLabel(Ctrl).Caption := AText
2412 else
2413 if(Ctrl is TEdit) then
2414 TEdit(Ctrl).Text := AText
2415 else
2416 if(Ctrl is TORComboBox) then
2417 TORComboBox(Ctrl).SelectByID(AText)
2418 else
2419 if(Ctrl is TRichEdit) then
2420 TRichEdit(Ctrl).Lines.Text := AText
2421 else
2422 if(Ctrl is TORDateCombo) then
2423 TORDateCombo(Ctrl).FMDate := MakeFMDateTime(piece(AText,':',2))
2424 else
2425 if(Ctrl is TORDateBox) then
2426 TORDateBox(Ctrl).Text := AText
2427 else
2428 if(Ctrl is TORCheckBox) then
2429 begin
2430 Done := FALSE;
2431 TORCheckBox(Ctrl).Checked := FALSE; //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV
2432 if(cnt = 0) then
2433 cnt := DelimCount(AText, '|') + 1;
2434 for j := 1 to cnt do
2435 begin
2436 if(TORCheckBox(Ctrl).Caption = piece(AText,'|',j)) then
2437 TORCheckBox(Ctrl).Checked := TRUE;
2438 end;
2439 end
2440 else
2441 if(Ctrl is TfraTemplateFieldButton) then
2442 TfraTemplateFieldButton(Ctrl).ButtonText := AText
2443 else
2444 if(Ctrl is TPanel) then
2445 begin
2446 for j := 0 to Ctrl.ComponentCount-1 do
2447 if Ctrl.Components[j] is TUpDown then
2448 begin
2449 TUpDown(Ctrl.Components[j]).Position := StrToIntDef(AText,0);
2450 break;
2451 end;
2452 end;
2453 end;
2454 if Done then break;
2455 end;
2456 finally
2457 FUpdating := FALSE;
2458 end;
2459end;
2460
2461procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
2462var
2463 i: integer;
2464 TmpSL: TStringList;
2465
2466begin
2467 FFieldValues := Value;
2468 TmpSL := TStringList.Create;
2469 try
2470 TmpSL.CommaText := Value;
2471 for i := 0 to TmpSL.Count-1 do
2472 SetControlText(StrToIntDef(Piece(TmpSL[i], U, 1), 0), Piece(TmpSL[i], U, 2));
2473 finally
2474 TmpSL.Free;
2475 end;
2476end;
2477
2478function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean;
2479var
2480 p: integer;
2481begin
2482 p := pos(code, txt);
2483 Result := (p > 0);
2484 if Result then
2485 begin
2486 while p > 0 do
2487 begin
2488 delete(txt, p, 1);
2489 p := pos(code, txt);
2490 end;
2491 end;
2492end;
2493
2494procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
2495begin
2496 EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
2497 DoChange(Sender);
2498end;
2499
2500function StripEmbedded(iItems: string): string;
2501{7/26/01 S Monson
2502 Returns the field will all embedded fields removed}
2503var
2504 p1, p2, icur: integer;
2505Begin
2506 p1 := pos(TemplateFieldBeginSignature,iItems);
2507 icur := 0;
2508 while p1 > 0 do
2509 begin
2510 p2 := pos(TemplateFieldEndSignature,copy(iItems,icur+p1+TemplateFieldSignatureLen,maxint));
2511 if p2 > 0 then
2512 begin
2513 delete(iItems,p1+icur,TemplateFieldSignatureLen+p2+TemplateFieldSignatureEndLen-1);
2514 icur := icur + p1 - 1;
2515 p1 := pos(TemplateFieldBeginSignature,copy(iItems,icur+1,maxint));
2516 end
2517 else
2518 p1 := 0;
2519 end;
2520 Result := iItems;
2521end;
2522
2523procedure StripScreenReaderCodes(var Text: string);
2524var
2525 p, j: integer;
2526begin
2527 for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do
2528 begin
2529 p := 1;
2530 while (p > 0) do
2531 begin
2532 p := posex(ScreenReaderCodes[j], Text, p);
2533 if p > 0 then
2534 delete(Text, p, ScreenReaderCodeLens[j]);
2535 end;
2536 end;
2537end;
2538
2539procedure StripScreenReaderCodes(SL: TStrings);
2540var
2541 temp: string;
2542 i: integer;
2543
2544begin
2545 for i := 0 to SL.Count - 1 do
2546 begin
2547 temp := SL[i];
2548 StripScreenReaderCodes(temp);
2549 SL[i] := temp;
2550 end;
2551end;
2552
2553function HasScreenReaderBreakCodes(SL: TStrings): boolean;
2554var
2555 i: integer;
2556
2557begin
2558 Result := TRUE;
2559 for i := 0 to SL.Count - 1 do
2560 begin
2561 if pos(ScreenReaderCodeSignature, SL[i]) > 0 then
2562 exit;
2563 end;
2564 Result := FALSE;
2565end;
2566
2567initialization
2568
2569finalization
2570 KillObj(@uTmplFlds, TRUE);
2571 KillObj(@uEntries, TRUE);
2572
2573end.
Note: See TracBrowser for help on using the repository browser.