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

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

Upgrade to version 27
File size: 74.0 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
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.OnClick := 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 ctrl := pnl;
1298 end;
1299
1300 dftHyperlink, dftText:
1301 begin
1302 if (FFldType = dftHyperlink) and User.WebAccess then
1303 lbl := TCPRSDialogHyperlinkLabel.Create(nil)
1304 else
1305 lbl := TCPRSTemplateFieldLabel.Create(nil);
1306 lbl.Parent := Entry.FPanel;
1307 lbl.ShowAccelChar := FALSE;
1308 lbl.Exclude := FSepLines;
1309 if (FFldType = dftHyperlink) then
1310 begin
1311 if FEditDefault <> '' then
1312 lbl.Caption := StripEmbedded(FEditDefault)
1313 else
1314 lbl.Caption := URL;
1315 end
1316 else
1317 begin
1318 STmp := StripEmbedded(Items);
1319 if copy(STmp,length(STmp)-1,2) = CRLF then
1320 delete(STmp,length(STmp)-1,2);
1321 lbl.Caption := STmp;
1322 end;
1323 if lbl is TCPRSDialogHyperlinkLabel then
1324 TCPRSDialogHyperlinkLabel(lbl).Init(FURL);
1325 lbl.Tag := CtrlID;
1326 UpdateColorsFor508Compliance(lbl);
1327 ctrl := lbl;
1328 end;
1329
1330 dftWP:
1331 begin
1332 re := TCPRSDialogRichEdit.Create(nil);
1333 (re as ICPRSDialogComponent).RequiredField := Required;
1334 re.Parent := Entry.FPanel;
1335 re.Tag := CtrlID;
1336 tmp := FMaxLen;
1337 if tmp < 5 then
1338 tmp := 5;
1339 re.Width := wdth * tmp;
1340 tmp := FTextLen;
1341 if tmp < 2 then
1342 tmp := 2
1343 else
1344 if tmp > MaxTFWPLines then
1345 tmp := MaxTFWPLines;
1346 re.Height := ht * tmp;
1347 re.BorderStyle := bsNone;
1348 re.ScrollBars := ssVertical;
1349 re.Lines.Text := Items;
1350 re.OnChange := Entry.DoChange;
1351 UpdateColorsFor508Compliance(re, TRUE);
1352 ctrl := re;
1353 end;
1354 end;
1355 if assigned(ctrl) then
1356 begin
1357 inc(Index);
1358 Entry.FControls.InsertObject(Index, '', ctrl);
1359 UpdateIndents(ctrl);
1360 end;
1361 end;
1362end;
1363
1364function TTemplateField.CanModify: boolean;
1365begin
1366 if((not FModified) and (not FLocked) and (StrToIntDef(FID,0) > 0)) then
1367 begin
1368 FLocked := LockTemplateField(FID);
1369 Result := FLocked;
1370 if(not FLocked) then
1371 ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.');
1372 end
1373 else
1374 Result := TRUE;
1375 if(Result) then FModified := TRUE;
1376end;
1377
1378procedure TTemplateField.SetEditDefault(const Value: string);
1379begin
1380 if(FEditDefault <> Value) and CanModify then
1381 FEditDefault := Value;
1382end;
1383
1384procedure TTemplateField.SetFldName(const Value: string);
1385begin
1386 if(FFldName <> Value) and CanModify then
1387 begin
1388 FFldName := Value;
1389 FNameChanged := TRUE;
1390 end;
1391end;
1392
1393procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
1394begin
1395 if(FFldType <> Value) and CanModify then
1396 begin
1397 FFldType := Value;
1398 if(Value = dftEditBox) then
1399 begin
1400 if (FMaxLen < 1) then
1401 FMaxLen := 1;
1402 if FTextLen < FMaxLen then
1403 FTextLen := FMaxLen;
1404 end
1405 else
1406 if(Value = dftHyperlink) and (FURL = '') then
1407 FURL := 'http://'
1408 else
1409 if(Value = dftComboBox) and (FMaxLen < 1) then
1410 begin
1411 FMaxLen := Width;
1412 if FMaxLen < 1 then
1413 FMaxLen := 1;
1414 end
1415 else
1416 if(Value = dftWP) then
1417 begin
1418 if (FMaxLen = 0) then
1419 FMaxLen := MAX_ENTRY_WIDTH
1420 else
1421 if (FMaxLen < 5) then
1422 FMaxLen := 5;
1423 if FTextLen < 2 then
1424 FTextLen := 2;
1425 end
1426 else
1427 if(Value = dftDate) and (FDateType = dtUnknown) then
1428 FDateType := dtDate;
1429 end;
1430end;
1431
1432procedure TTemplateField.SetID(const Value: string);
1433begin
1434// if(FID <> Value) and CanModify then
1435 FID := Value;
1436end;
1437
1438procedure TTemplateField.SetInactive(const Value: boolean);
1439begin
1440 if(FInactive <> Value) and CanModify then
1441 FInactive := Value;
1442end;
1443
1444procedure TTemplateField.SetItemDefault(const Value: string);
1445begin
1446 if(FItemDefault <> Value) and CanModify then
1447 FItemDefault := Value;
1448end;
1449
1450procedure TTemplateField.SetItems(const Value: string);
1451begin
1452 if(FItems <> Value) and CanModify then
1453 FItems := Value;
1454end;
1455
1456procedure TTemplateField.SetLMText(const Value: string);
1457begin
1458 if(FLMText <> Value) and CanModify then
1459 FLMText := Value;
1460end;
1461
1462procedure TTemplateField.SetMaxLen(const Value: integer);
1463begin
1464 if(FMaxLen <> Value) and CanModify then
1465 FMaxLen := Value;
1466end;
1467
1468procedure TTemplateField.SetNotes(const Value: string);
1469begin
1470 if(FNotes <> Value) and CanModify then
1471 FNotes := Value;
1472end;
1473
1474function TTemplateField.SaveError: string;
1475var
1476 TmpSL, FldSL: TStringList;
1477 AID,Res: string;
1478 idx, i: integer;
1479 IEN64: Int64;
1480 NewRec: boolean;
1481
1482begin
1483 if(FFldName = NewTemplateField) then
1484 begin
1485 Result := 'Template Field can not be named "' + NewTemplateField + '"';
1486 exit;
1487 end;
1488 Result := '';
1489 NewRec := (StrToIntDef(FID,0) < 0);
1490 if(FModified or NewRec) then
1491 begin
1492 TmpSL := TStringList.Create;
1493 try
1494 FldSL := TStringList.Create;
1495 try
1496 if(StrToIntDef(FID,0) > 0) then
1497 AID := FID
1498 else
1499 AID := '0';
1500 FldSL.Add('.01='+FFldName);
1501 FldSL.Add('.02='+TemplateFieldTypeCodes[FFldType]);
1502 FldSL.Add('.03='+BOOLCHAR[FInactive]);
1503 FldSL.Add('.04='+IntToStr(FMaxLen));
1504 FldSL.Add('.05='+FEditDefault);
1505 FldSL.Add('.06='+FLMText);
1506 idx := -1;
1507 if(FItems <> '') and (FItemDefault <> '') then
1508 begin
1509 TmpSL.Text := FItems;
1510 for i := 0 to TmpSL.Count-1 do
1511 if(FItemDefault = TmpSL[i]) then
1512 begin
1513 idx := i;
1514 break;
1515 end;
1516 end;
1517 FldSL.Add('.07='+IntToStr(Idx+1));
1518 FldSL.Add('.08='+BOOLCHAR[fRequired]);
1519 FldSL.Add('.09='+BOOLCHAR[fSepLines]);
1520 FldSL.Add('.1=' +IntToStr(FTextLen));
1521 FldSL.Add('.11='+IntToStr(FIndent));
1522 FldSL.Add('.12='+IntToStr(FPad));
1523 FldSL.Add('.13='+IntToStr(FMinVal));
1524 FldSL.Add('.14='+IntToStr(FMaxVal));
1525 FldSL.Add('.15='+IntToStr(FIncrement));
1526 if FDateType = dtUnknown then
1527 FldSL.Add('.16=@')
1528 else
1529 FldSL.Add('.16='+TemplateFieldDateCodes[FDateType]);
1530
1531 if FURL='' then
1532 FldSL.Add('3=@')
1533 else
1534 FldSL.Add('3='+FURL);
1535
1536 if(FNotes <> '') or (not NewRec) then
1537 begin
1538 if(FNotes = '') then
1539 FldSL.Add('2,1=@')
1540 else
1541 begin
1542 TmpSL.Text := FNotes;
1543 for i := 0 to TmpSL.Count-1 do
1544 FldSL.Add('2,'+IntToStr(i+1)+',0='+TmpSL[i]);
1545 end;
1546 end;
1547 if((FItems <> '') or (not NewRec)) then
1548 begin
1549 if(FItems = '') then
1550 FldSL.Add('10,1=@')
1551 else
1552 begin
1553 TmpSL.Text := FItems;
1554 for i := 0 to TmpSL.Count-1 do
1555 FldSL.Add('10,'+IntToStr(i+1)+',0='+TmpSL[i]);
1556 end;
1557 end;
1558
1559 Res := UpdateTemplateField(AID, FldSL);
1560 IEN64 := StrToInt64Def(Piece(Res,U,1),0);
1561 if(IEN64 > 0) then
1562 begin
1563 if(NewRec) then
1564 FID := IntToStr(IEN64)
1565 else
1566 UnlockTemplateField(FID);
1567 FModified := FALSE;
1568 FNameChanged := FALSE;
1569 FLocked := FALSE;
1570 end
1571 else
1572 Result := Piece(Res, U, 2);
1573 finally
1574 FldSL.Free;
1575 end;
1576 finally
1577 TmpSL.Free;
1578 end;
1579 end;
1580end;
1581
1582procedure TTemplateField.Assign(AFld: TTemplateField);
1583begin
1584 FMaxLen := AFld.FMaxLen;
1585 FFldName := AFld.FFldName;
1586 FLMText := AFld.FLMText;
1587 FEditDefault := AFld.FEditDefault;
1588 FNotes := AFld.FNotes;
1589 FItems := AFld.FItems;
1590 FInactive := AFld.FInactive;
1591 FItemDefault := AFld.FItemDefault;
1592 FFldType := AFld.FFldType;
1593 FRequired := AFld.FRequired;
1594 FSepLines := AFld.FSepLines;
1595 FTextLen := AFld.FTextLen;
1596 FIndent := AFld.FIndent;
1597 FPad := AFld.FPad;
1598 FMinVal := AFld.FMinVal;
1599 FMaxVal := AFld.FMaxVal;
1600 FIncrement := AFld.FIncrement;
1601 FDateType := AFld.FDateType;
1602 FURL := AFld.FURL;
1603end;
1604
1605function TTemplateField.Width: integer;
1606var
1607 i, ilen: integer;
1608 TmpSL: TStringList;
1609
1610begin
1611 if(FFldType = dftEditBox) then
1612 Result := FMaxLen
1613 else
1614 begin
1615 if FMaxLen > 0 then
1616 Result := FMaxLen
1617 else
1618 begin
1619 Result := -1;
1620 TmpSL := TStringList.Create;
1621 try
1622 TmpSL.Text := StripEmbedded(FItems);
1623 for i := 0 to TmpSL.Count-1 do
1624 begin
1625 ilen := length(TmpSL[i]);
1626 if(Result < ilen) then
1627 Result := ilen;
1628 end;
1629 finally
1630 TmpSL.Free;
1631 end;
1632 end;
1633 end;
1634 if Result > MaxTFEdtLen then
1635 Result := MaxTFEdtLen;
1636end;
1637
1638destructor TTemplateField.Destroy;
1639begin
1640 uTmplFlds.Remove(Self);
1641 inherited;
1642end;
1643
1644procedure TTemplateField.SetRequired(const Value: boolean);
1645begin
1646 if(FRequired <> Value) and CanModify then
1647 FRequired := Value;
1648end;
1649
1650function TTemplateField.NewField: boolean;
1651begin
1652 Result := (StrToIntDef(FID,0) <= 0);
1653end;
1654
1655procedure TTemplateField.SetSepLines(const Value: boolean);
1656begin
1657 if(FSepLines <> Value) and CanModify then
1658 FSepLines := Value
1659end;
1660
1661procedure TTemplateField.SetIncrement(const Value: integer);
1662begin
1663 if(FIncrement <> Value) and CanModify then
1664 FIncrement := Value;
1665end;
1666
1667procedure TTemplateField.SetIndent(const Value: integer);
1668begin
1669 if(FIndent <> Value) and CanModify then
1670 FIndent := Value;
1671end;
1672
1673procedure TTemplateField.SetMaxVal(const Value: integer);
1674begin
1675 if(FMaxVal <> Value) and CanModify then
1676 FMaxVal := Value;
1677end;
1678
1679procedure TTemplateField.SetMinVal(const Value: integer);
1680begin
1681 if(FMinVal <> Value) and CanModify then
1682 FMinVal := Value;
1683end;
1684
1685procedure TTemplateField.SetPad(const Value: integer);
1686begin
1687 if(FPad <> Value) and CanModify then
1688 FPad := Value;
1689end;
1690
1691procedure TTemplateField.SetTextLen(const Value: integer);
1692begin
1693 if(FTextLen <> Value) and CanModify then
1694 FTextLen := Value;
1695end;
1696
1697procedure TTemplateField.SetURL(const Value: string);
1698begin
1699 if(FURL <> Value) and CanModify then
1700 FURL := Value;
1701end;
1702
1703function TTemplateField.GetRequired: boolean;
1704begin
1705 if FFldType in NoRequired then
1706 Result := FALSE
1707 else
1708 Result := FRequired;
1709end;
1710
1711procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
1712begin
1713 if(FDateType <> Value) and CanModify then
1714 FDateType := Value;
1715end;
1716
1717{ TTemplateDialogEntry }
1718const
1719 EOL_MARKER = #182;
1720 SR_BREAK = #186;
1721
1722procedure PanelDestroy(AData: Pointer; Sender: TObject);
1723var
1724 idx: integer;
1725 dlg: TTemplateDialogEntry;
1726
1727begin
1728 dlg := TTemplateDialogEntry(AData);
1729 idx := uEntries.IndexOf(dlg.FID);
1730 if(idx >= 0) then
1731 uEntries.Delete(idx);
1732 dlg.FPanelDying := TRUE;
1733 dlg.Free;
1734end;
1735
1736constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
1737var
1738 CtrlID, idx, i, j, flen: integer;
1739 txt, FldName: string;
1740 Fld: TTemplateField;
1741
1742begin
1743 FID := AID;
1744 FText := Text;
1745 FControls := TStringList.Create;
1746 FIndents := TStringList.Create;
1747 FFont := TFont.Create;
1748 FFont.Assign(TORExposedControl(AParent).Font);
1749 FControls.Text := Text;
1750 if(FControls.Count > 1) then
1751 begin
1752 for i := 1 to FControls.Count-1 do
1753 FControls[i] := EOL_MARKER + FControls[i];
1754 if not ScreenReaderSystemActive then
1755 StripScreenReaderCodes(FControls);
1756 end;
1757 FFirstBuild := TRUE;
1758 FPanel := TDlgFieldPanel.Create(AParent.Owner);
1759 FPanel.Parent := AParent;
1760 FPanel.BevelOuter := bvNone;
1761 FPanel.Caption := '';
1762 FPanel.Font.Assign(FFont);
1763 UpdateColorsFor508Compliance(FPanel, TRUE);
1764 idx := 0;
1765 while (idx < FControls.Count) do
1766 begin
1767 txt := FControls[idx];
1768 i := pos(TemplateFieldBeginSignature, txt);
1769 if(i > 0) then
1770 begin
1771 if(copy(txt, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
1772 begin
1773 CtrlID := StrToIntDef(copy(txt, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
1774 delete(txt,i + TemplateFieldSignatureLen, FieldIDLen);
1775 end
1776 else
1777 CtrlID := 0;
1778 j := pos(TemplateFieldEndSignature, copy(txt, i + TemplateFieldSignatureLen, MaxInt));
1779 if(j > 0) then
1780 begin
1781 inc(j, i + TemplateFieldSignatureLen - 1);
1782 flen := j - i - TemplateFieldSignatureLen;
1783 FldName := copy(txt, i + TemplateFieldSignatureLen, flen);
1784 Fld := GetTemplateField(FldName, FALSE);
1785 delete(txt,i,flen + TemplateFieldSignatureLen + 1);
1786 if(assigned(Fld)) then
1787 begin
1788 FControls[idx] := copy(txt,1,i-1);
1789 if(Fld.Required) then
1790 begin
1791 if ScreenReaderSystemActive then
1792 begin
1793 if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then
1794 FControls[idx] := FControls[idx] + ScreenReaderStopCode;
1795 end;
1796 FControls[idx] := FControls[idx] + '*';
1797 end;
1798 Fld.CreateDialogControls(Self, idx, CtrlID);
1799 FControls.Insert(idx+1,copy(txt,i,MaxInt));
1800 end
1801 else
1802 begin
1803 FControls[idx] := txt;
1804 dec(idx);
1805 end;
1806 end
1807 else
1808 begin
1809 delete(txt,i,TemplateFieldSignatureLen);
1810 FControls[idx] := txt;
1811 dec(idx);
1812 end;
1813 end;
1814 inc(idx);
1815 end;
1816 if ScreenReaderSystemActive then
1817 begin
1818 idx := 0;
1819 while (idx < FControls.Count) do
1820 begin
1821 txt := FControls[idx];
1822 i := pos(ScreenReaderStopCode, txt);
1823 if i > 0 then
1824 begin
1825 FControls[idx] := copy(txt, 1, i-1);
1826 txt := copy(txt, i + ScreenReaderStopCodeLen, MaxInt);
1827 FControls.Insert(idx+1, SR_BREAK + txt);
1828 end;
1829 inc(idx);
1830 end;
1831 end;
1832end;
1833
1834destructor TTemplateDialogEntry.Destroy;
1835begin
1836 if assigned(FOnDestroy) then
1837 FOnDestroy(Self);
1838 KillLabels;
1839 KillObj(@FControls, TRUE);
1840 if FPanelDying then
1841 FPanel := nil
1842 else
1843 FreeAndNil(FPanel);
1844 FreeAndNil(FFont);
1845 FreeAndNil(FIndents);
1846 inherited;
1847end;
1848
1849procedure TTemplateDialogEntry.DoChange(Sender: TObject);
1850begin
1851 if (not FUpdating) and assigned(FOnChange) then
1852 FOnChange(Self);
1853end;
1854
1855function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
1856 var FoundEntry: boolean; AutoWrap: boolean;
1857 emField: string = ''): string;
1858var
1859 x, i, j, ind, idx: integer;
1860 Ctrl: TControl;
1861 Done: boolean;
1862 iString: string;
1863 iField: TTemplateField;
1864 iTemp: TStringList;
1865
1866 function GetOriginalItem(istr: string): string;
1867 begin
1868 Result := '';
1869 if emField <> '' then
1870 begin
1871 iField := GetTemplateField(emField,FALSE);
1872 iTemp := nil;
1873 if ifield <> nil then
1874 try
1875 iTemp := TStringList.Create;
1876 iTemp.Text := StripEmbedded(iField.Items);
1877 x := iTemp.IndexOf(istr);
1878 if x >= 0 then
1879 begin
1880 iTemp.Text := iField.Items;
1881 Result := iTemp.Strings[x];
1882 end;
1883 finally
1884 iTemp.Free;
1885 end;
1886 end;
1887 end;
1888
1889
1890begin
1891 Result := '';
1892 Done := FALSE;
1893 ind := -1;
1894 for i := 0 to FControls.Count-1 do
1895 begin
1896 Ctrl := TControl(FControls.Objects[i]);
1897 if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
1898 begin
1899 FoundEntry := TRUE;
1900 Done := TRUE;
1901 if ind < 0 then
1902 begin
1903 idx := FIndents.IndexOfObject(Ctrl);
1904 if idx >= 0 then
1905 ind := StrToIntDef(Piece(FIndents[idx], U, 2), 0)
1906 else
1907 ind := 0;
1908 end;
1909 if(Ctrl is TCPRSTemplateFieldLabel) then
1910 begin
1911 if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin
1912 if emField <> '' then begin
1913 iField := GetTemplateField(emField,FALSE);
1914 case iField.FldType of
1915 dftHyperlink: if iField.EditDefault <> '' then
1916 Result := iField.EditDefault
1917 else
1918 Result := iField.URL;
1919 dftText: begin
1920 iString := iField.Items;
1921 if copy(iString,length(iString)-1,2) = CRLF then
1922 delete(iString,length(iString)-1,2);
1923 Result := iString;
1924 end;
1925 else {case}
1926 Result := TCPRSTemplateFieldLabel(Ctrl).Caption
1927 end; {case iField.FldType}
1928 end {if emField}
1929 else
1930 Result := TCPRSTemplateFieldLabel(Ctrl).Caption;
1931 end;
1932 end
1933 else
1934 if(Ctrl is TEdit) then
1935 Result := TEdit(Ctrl).Text
1936 else
1937 if(Ctrl is TORComboBox) then begin
1938 Result := TORComboBox(Ctrl).Text;
1939 iString := GetOriginalItem(Result);
1940 if iString <> '' then
1941 Result := iString;
1942 end
1943 else
1944 if(Ctrl is TORDateCombo) then
1945 Result := TORDateCombo(Ctrl).Text + ':' + FloatToStr(TORDateCombo(Ctrl).FMDate)
1946 else
1947 if(Ctrl is TORDateBox) then
1948 Result := TORDateBox(Ctrl).Text
1949 else
1950 if(Ctrl is TRichEdit) then
1951 begin
1952 if((ind = 0) and (not AutoWrap)) then
1953 Result := TRichEdit(Ctrl).Lines.Text
1954 else
1955 begin
1956 for j := 0 to TRichEdit(Ctrl).Lines.Count-1 do
1957 begin
1958 if AutoWrap then
1959 begin
1960 if(Result <> '') then
1961 Result := Result + ' ';
1962 Result := Result + TRichEdit(Ctrl).Lines[j];
1963 end
1964 else
1965 begin
1966 if(Result <> '') then
1967 Result := Result + CRLF;
1968 Result := Result + StringOfChar(' ', ind) + TRichEdit(Ctrl).Lines[j];
1969 end;
1970 end;
1971 ind := 0;
1972 end;
1973 end
1974 else
1975 if(Ctrl is TORCheckBox) then
1976 begin
1977 Done := FALSE;
1978 if(TORCheckBox(Ctrl).Checked) then
1979 begin
1980 if(Result <> '') then
1981 begin
1982 if NoCommas then
1983 Result := Result + '|'
1984 else
1985 Result := Result + ', ';
1986 end;
1987 iString := GetOriginalItem(TORCheckBox(Ctrl).Caption);
1988 if iString <> '' then
1989 Result := Result + iString
1990 else
1991 Result := Result + TORCheckBox(Ctrl).Caption;
1992 end;
1993 end
1994 else
1995 if(Ctrl is TfraTemplateFieldButton) then
1996 begin
1997 Result := TfraTemplateFieldButton(Ctrl).ButtonText;
1998 iString := GetOriginalItem(Result);
1999 if iString <> '' then
2000 Result := iString;
2001 end
2002 else
2003 if(Ctrl is TPanel) then
2004 begin
2005 for j := 0 to Ctrl.ComponentCount-1 do
2006 if Ctrl.Components[j] is TUpDown then
2007 begin
2008 Result := IntToStr(TUpDown(Ctrl.Components[j]).Position);
2009 break;
2010 end;
2011 end;
2012 end;
2013 if Done then break;
2014 end;
2015 if (ind > 0) and (not NoCommas) then
2016 Result := StringOfChar(' ', ind) + Result;
2017end;
2018
2019function TTemplateDialogEntry.GetFieldValues: string;
2020var
2021 i: integer;
2022 Ctrl: TControl;
2023 CtrlID: integer;
2024 TmpIDs: TList;
2025 TmpSL: TStringList;
2026 Dummy: boolean;
2027
2028begin
2029 Result := '';
2030 TmpIDs := TList.Create;
2031 try
2032 TmpSL := TStringList.Create;
2033 try
2034 for i := 0 to FControls.Count-1 do
2035 begin
2036 Ctrl := TControl(FControls.Objects[i]);
2037 if(assigned(Ctrl)) then
2038 begin
2039 CtrlID := Ctrl.Tag;
2040 if(TmpIDs.IndexOf(Pointer(CtrlID)) < 0) then
2041 begin
2042 TmpSL.Add(IntToStr(CtrlID) + U + GetControlText(CtrlID, TRUE, Dummy, FALSE));
2043 TmpIDs.Add(Pointer(CtrlID));
2044 end;
2045 end;
2046 end;
2047 Result := TmpSL.CommaText;
2048 finally
2049 TmpSL.Free;
2050 end;
2051 finally
2052 TmpIDs.Free;
2053 end;
2054end;
2055
2056function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl;
2057 OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
2058var
2059 i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
2060 MaxTextLen: integer; {Max num of chars per line in pixels}
2061 MaxChars: integer; {Max num of chars per line}
2062 txt: string;
2063 ctrl: TControl;
2064 LastLineBlank: boolean;
2065 sLbl: TCPRSDialogStaticLabel;
2066 nLbl: TVA508ChainedLabel;
2067 sLblHeight: integer;
2068 TabOrdr: integer;
2069
2070const
2071 FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
2072 overlay the focus rect on its parent panel.}
2073
2074 procedure Add2TabOrder(ctrl: TWinControl);
2075 begin
2076 ctrl.TabOrder := TabOrdr;
2077 inc(TabOrdr);
2078 end;
2079
2080 function StripSRCode(var txt: string; code: string; len: integer): integer;
2081 begin
2082 Result := pos(code, txt);
2083 if Result > 0 then
2084 begin
2085 delete(txt,Result,len);
2086 dec(Result);
2087 end
2088 else
2089 Result := -1;
2090 end;
2091
2092 procedure DoLabel(Atxt: string);
2093 var
2094 ctrl: TControl;
2095 tempLbl: TVA508ChainedLabel;
2096
2097 begin
2098 if ScreenReaderSystemActive then
2099 begin
2100 if assigned(sLbl) then
2101 begin
2102 tempLbl := TVA508ChainedLabel.Create(nil);
2103 if assigned(nLbl) then
2104 nLbl.NextLabel := tempLbl
2105 else
2106 sLbl.NextLabel := tempLbl;
2107 nLbl := tempLbl;
2108 ctrl := nLbl;
2109 end
2110 else
2111 begin
2112 sLbl := TCPRSDialogStaticLabel.Create(nil);
2113 ctrl := sLbl;
2114 end;
2115 end
2116 else
2117 ctrl := TLabel.Create(nil);
2118 SetOrdProp(ctrl, ShowAccelCharProperty, ord(FALSE));
2119 SetStrProp(ctrl, CaptionProperty, Atxt);
2120 ctrl.Parent := FPanel;
2121 ctrl.Left := x;
2122 ctrl.Top := y;
2123 if ctrl = sLbl then
2124 begin
2125 Add2TabOrder(sLbl);
2126 sLbl.Height := sLblHeight;
2127 ScreenReaderSystem_CurrentLabel(sLbl);
2128 end;
2129 if ScreenReaderSystemActive then
2130 ScreenReaderSystem_AddText(Atxt);
2131 UpdateColorsFor508Compliance(ctrl);
2132 inc(x, ctrl.Width);
2133 end;
2134
2135 procedure Init;
2136 var
2137 lbl : TLabel;
2138 begin
2139 if(FFirstBuild) then
2140 FFirstBuild := FALSE
2141 else
2142 KillLabels;
2143 y := FOCUS_RECT_MARGIN; {placement of labels on panel so they don't cover the}
2144 x := FOCUS_RECT_MARGIN; {focus rectangle}
2145 MaxX := 0;
2146 //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2); AGP commentout line for
2147 //reminder spacing
2148 ybase := FontHeightPixel(FFont.Handle) + 2;
2149 yinc := ybase;
2150 LastLineBlank := FALSE;
2151 sLbl := nil;
2152 nLbl := nil;
2153 TabOrdr := 0;
2154 if ScreenReaderSystemActive then
2155 begin
2156 ScreenReaderSystem_CurrentCheckBox(OwningCheckBox);
2157 lbl := TLabel.Create(nil);
2158 try
2159 lbl.Parent := FPanel;
2160 sLblHeight := lbl.Height + 2;
2161 finally
2162 lbl.Free;
2163 end;
2164
2165 end;
2166 end;
2167
2168 procedure Text508Work;
2169 var
2170 ContinueCode: boolean;
2171 begin
2172 if StripCode(txt, SR_BREAK) then
2173 begin
2174 ScreenReaderSystem_Stop;
2175 nLbl := nil;
2176 sLbl := nil;
2177 end;
2178
2179 ContinueCode := FALSE;
2180 while StripSRCode(txt, ScreenReaderContinueCode, ScreenReaderContinueCodeLen) >= 0 do
2181 ContinueCode := TRUE;
2182 while StripSRCode(txt, ScreenReaderContinueCodeOld, ScreenReaderContinueCodeOldLen) >= 0 do
2183 ContinueCode := TRUE;
2184 if ContinueCode then
2185 ScreenReaderSystem_Continue;
2186 end;
2187
2188 procedure Ctrl508Work(ctrl: TControl);
2189 var
2190 lbl: TCPRSTemplateFieldLabel;
2191 begin
2192 if (Ctrl is TCPRSTemplateFieldLabel) and (not (Ctrl is TCPRSDialogHyperlinkLabel)) then
2193 begin
2194 lbl := Ctrl as TCPRSTemplateFieldLabel;
2195 if trim(lbl.Caption) <> '' then
2196 begin
2197 ScreenReaderSystem_CurrentLabel(lbl);
2198 ScreenReaderSystem_AddText(lbl.Caption);
2199 end
2200 else
2201 begin
2202 lbl.TabStop := FALSE;
2203 ScreenReaderSystem_Stop;
2204 end;
2205 end
2206 else
2207 begin
2208 if ctrl is TWinControl then
2209 Add2TabOrder(TWinControl(ctrl));
2210 if Supports(ctrl, ICPRSDialogComponent) then
2211 ScreenReaderSystem_CurrentComponent(ctrl as ICPRSDialogComponent);
2212 end;
2213 sLbl := nil;
2214 nLbl := nil;
2215 end;
2216
2217 procedure NextLine;
2218 begin
2219 if(MaxX < x) then
2220 MaxX := x;
2221 x := FOCUS_RECT_MARGIN; {leave two pixels on the left for the Focus Rect}
2222 inc(y, yinc);
2223 yinc := ybase;
2224 end;
2225
2226begin
2227 MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
2228 if(FFirstBuild or (FPanel.Width <> MaxLen)) then
2229 begin
2230 Init;
2231 for i := 0 to FControls.Count-1 do
2232 begin
2233 txt := FControls[i];
2234 if ScreenReaderSystemActive then
2235 Text508Work;
2236 if StripCode(txt,EOL_MARKER) then
2237 begin
2238 if((x <> 0) or LastLineBlank) then
2239 NextLine;
2240 LastLineBlank := (txt = '');
2241 end;
2242 if(txt <> '') then
2243 begin
2244 while(txt <> '') do
2245 begin
2246 cnt := NumCharsFitInWidth(FFont.Handle, txt, MaxTextLen-x);
2247 MaxChars := cnt;
2248 if(cnt >= length(txt)) then
2249 begin
2250 DoLabel(txt);
2251 txt := '';
2252 end
2253 else
2254 if(cnt < 1) then
2255 NextLine
2256 else
2257 begin
2258 repeat
2259 if(txt[cnt+1] = ' ') then
2260 begin
2261 DoLabel(copy(txt,1,cnt));
2262 NextLine;
2263 txt := copy(txt, cnt + 1, MaxInt);
2264 break;
2265 end
2266 else
2267 dec(cnt);
2268 until(cnt = 0);
2269 if(cnt = 0) then
2270 begin
2271 if(x = FOCUS_RECT_MARGIN) then {If x is at the far left margin...}
2272 begin
2273 DoLabel(Copy(txt,1,MaxChars));
2274 NextLine;
2275 txt := copy(txt, MaxChars + 1, MaxInt);
2276 end
2277 else
2278 NextLine;
2279 end;
2280 end;
2281 end;
2282 end
2283 else
2284 begin
2285 ctrl := TControl(FControls.Objects[i]);
2286 if(assigned(ctrl)) then
2287 begin
2288 if ScreenReaderSystemActive then
2289 Ctrl508Work(ctrl);
2290 idx := FIndents.IndexOfObject(Ctrl);
2291 if idx >= 0 then
2292 ind := StrToIntDef(Piece(FIndents[idx], U, 1), 0)
2293 else
2294 ind := 0;
2295 if(x > 0) then
2296 begin
2297 if (x < MaxLen) and (Ctrl is TORCheckBox) and (TORCheckBox(Ctrl).StringData = NewLine) then
2298 x := MaxLen;
2299 if((ctrl.Width + x + ind) > MaxLen) then
2300 NextLine;
2301 end;
2302 inc(x,ind);
2303 Ctrl.Left := x;
2304 Ctrl.Top := y;
2305 inc(x, Ctrl.Width + 4);
2306 if yinc <= Ctrl.Height then
2307 yinc := Ctrl.Height + 2;
2308 if (x < MaxLen) and ((Ctrl is TRichEdit) or
2309 ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
2310 x := MaxLen;
2311 end;
2312 end;
2313 end;
2314 NextLine;
2315 FPanel.Height := (y-1) + (FOCUS_RECT_MARGIN * 2); //AGP added Focus_rect_margin for Reminder spacing
2316 FPanel.Width := MaxX + FOCUS_RECT_MARGIN;
2317 end;
2318 if(FFieldValues <> '') then
2319 SetFieldValues(FFieldValues);
2320 if ScreenReaderSystemActive then
2321 ScreenReaderSystem_Stop;
2322 Result := FPanel;
2323end;
2324
2325function TTemplateDialogEntry.GetText: string;
2326begin
2327 Result := ResolveTemplateFields(FText, FALSE);
2328end;
2329
2330procedure TTemplateDialogEntry.KillLabels;
2331var
2332 i, idx: integer;
2333 obj: TObject;
2334 max: integer;
2335
2336begin
2337 if(assigned(FPanel)) then
2338 begin
2339 max := FPanel.ControlCount-1;
2340 for i := max downto 0 do
2341 begin
2342// deleting TVA508StaticText can delete several TVA508ChainedLabel components
2343 if i < FPanel.ControlCount then
2344 begin
2345 obj := FPanel.Controls[i];
2346 if (not (obj is TVA508ChainedLabel)) and
2347 ((obj is TLabel) or (obj is TVA508StaticText)) then
2348 begin
2349 idx := FControls.IndexOfObject(obj);
2350 if idx < 0 then
2351 obj.Free;
2352 end;
2353 end;
2354 end;
2355 end;
2356end;
2357
2358procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
2359 const Value: boolean);
2360var
2361 M: TMethod;
2362
2363begin
2364 FAutoDestroyOnPanelFree := Value;
2365 if(Value) then
2366 begin
2367 M.Data := Self;
2368 M.Code := @PanelDestroy;
2369 FPanel.OnDestroy := TNotifyEvent(M);
2370 end
2371 else
2372 FPanel.OnDestroy := nil;
2373end;
2374
2375procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
2376var
2377 cnt, i, j: integer;
2378 Ctrl: TControl;
2379 Done: boolean;
2380
2381begin
2382 FUpdating := TRUE;
2383 try
2384 Done := FALSE;
2385 cnt := 0;
2386 for i := 0 to FControls.Count-1 do
2387 begin
2388 Ctrl := TControl(FControls.Objects[i]);
2389 if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
2390 begin
2391 Done := TRUE;
2392 if(Ctrl is TLabel) then
2393 TLabel(Ctrl).Caption := AText
2394 else
2395 if(Ctrl is TEdit) then
2396 TEdit(Ctrl).Text := AText
2397 else
2398 if(Ctrl is TORComboBox) then
2399 TORComboBox(Ctrl).SelectByID(AText)
2400 else
2401 if(Ctrl is TRichEdit) then
2402 TRichEdit(Ctrl).Lines.Text := AText
2403 else
2404 if(Ctrl is TORDateCombo) then
2405 TORDateCombo(Ctrl).FMDate := MakeFMDateTime(piece(AText,':',2))
2406 else
2407 if(Ctrl is TORDateBox) then
2408 TORDateBox(Ctrl).Text := AText
2409 else
2410 if(Ctrl is TORCheckBox) then
2411 begin
2412 Done := FALSE;
2413 TORCheckBox(Ctrl).Checked := FALSE; //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV
2414 if(cnt = 0) then
2415 cnt := DelimCount(AText, '|') + 1;
2416 for j := 1 to cnt do
2417 begin
2418 if(TORCheckBox(Ctrl).Caption = piece(AText,'|',j)) then
2419 TORCheckBox(Ctrl).Checked := TRUE;
2420 end;
2421 end
2422 else
2423 if(Ctrl is TfraTemplateFieldButton) then
2424 TfraTemplateFieldButton(Ctrl).ButtonText := AText
2425 else
2426 if(Ctrl is TPanel) then
2427 begin
2428 for j := 0 to Ctrl.ComponentCount-1 do
2429 if Ctrl.Components[j] is TUpDown then
2430 begin
2431 TUpDown(Ctrl.Components[j]).Position := StrToIntDef(AText,0);
2432 break;
2433 end;
2434 end;
2435 end;
2436 if Done then break;
2437 end;
2438 finally
2439 FUpdating := FALSE;
2440 end;
2441end;
2442
2443procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
2444var
2445 i: integer;
2446 TmpSL: TStringList;
2447
2448begin
2449 FFieldValues := Value;
2450 TmpSL := TStringList.Create;
2451 try
2452 TmpSL.CommaText := Value;
2453 for i := 0 to TmpSL.Count-1 do
2454 SetControlText(StrToIntDef(Piece(TmpSL[i], U, 1), 0), Piece(TmpSL[i], U, 2));
2455 finally
2456 TmpSL.Free;
2457 end;
2458end;
2459
2460function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean;
2461var
2462 p: integer;
2463begin
2464 p := pos(code, txt);
2465 Result := (p > 0);
2466 if Result then
2467 begin
2468 while p > 0 do
2469 begin
2470 delete(txt, p, 1);
2471 p := pos(code, txt);
2472 end;
2473 end;
2474end;
2475
2476procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
2477begin
2478 EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
2479 DoChange(Sender);
2480end;
2481
2482function StripEmbedded(iItems: string): string;
2483{7/26/01 S Monson
2484 Returns the field will all embedded fields removed}
2485var
2486 p1, p2, icur: integer;
2487Begin
2488 p1 := pos(TemplateFieldBeginSignature,iItems);
2489 icur := 0;
2490 while p1 > 0 do
2491 begin
2492 p2 := pos(TemplateFieldEndSignature,copy(iItems,icur+p1+TemplateFieldSignatureLen,maxint));
2493 if p2 > 0 then
2494 begin
2495 delete(iItems,p1+icur,TemplateFieldSignatureLen+p2+TemplateFieldSignatureEndLen-1);
2496 icur := icur + p1 - 1;
2497 p1 := pos(TemplateFieldBeginSignature,copy(iItems,icur+1,maxint));
2498 end
2499 else
2500 p1 := 0;
2501 end;
2502 Result := iItems;
2503end;
2504
2505procedure StripScreenReaderCodes(var Text: string);
2506var
2507 p, j: integer;
2508begin
2509 for j := low(ScreenReaderCodes) to high(ScreenReaderCodes) do
2510 begin
2511 p := 1;
2512 while (p > 0) do
2513 begin
2514 p := posex(ScreenReaderCodes[j], Text, p);
2515 if p > 0 then
2516 delete(Text, p, ScreenReaderCodeLens[j]);
2517 end;
2518 end;
2519end;
2520
2521procedure StripScreenReaderCodes(SL: TStrings);
2522var
2523 temp: string;
2524 i: integer;
2525
2526begin
2527 for i := 0 to SL.Count - 1 do
2528 begin
2529 temp := SL[i];
2530 StripScreenReaderCodes(temp);
2531 SL[i] := temp;
2532 end;
2533end;
2534
2535function HasScreenReaderBreakCodes(SL: TStrings): boolean;
2536var
2537 i: integer;
2538
2539begin
2540 Result := TRUE;
2541 for i := 0 to SL.Count - 1 do
2542 begin
2543 if pos(ScreenReaderCodeSignature, SL[i]) > 0 then
2544 exit;
2545 end;
2546 Result := FALSE;
2547end;
2548
2549initialization
2550
2551finalization
2552 KillObj(@uTmplFlds, TRUE);
2553 KillObj(@uEntries, TRUE);
2554
2555end.
Note: See TracBrowser for help on using the repository browser.