Context Navigation

source: cprs/trunk/CPRS-Chart/Templates/uTemplateFields.pas@ 1672

Last change on this file since 1672 was 829, checked in by Kevin Toppenberg, 14 years ago
Upgrade to version 27
File size: 74.0 KB

Rev	Line
[456]	1	unit uTemplateFields;
	2
	3	interface
	4
	5	uses
	6	Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
[829]	7	Graphics, ORClasses, ComCtrls, ORDtTm, uDlgComponents, TypInfo, ORFn, StrUtils;
[456]	8
	9	type
	10	TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
[829]	11	dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText,
	12	// keep dftScreenReader as last entry - users can not create this type of field
	13	dftScreenReader);
[456]	14
	15	TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
	16	dtCombo, dtYear, dtYearMonth);
	17
	18	const
	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
	29	type
	30	TTemplateDialogEntry = class(TObject)
	31	private
	32	FID: string;
	33	FFont: TFont;
[829]	34	FPanel: TDlgFieldPanel;
[456]	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);
[829]	51	function StripCode(var txt: string; code: char): boolean;
[456]	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;
[829]	62	function GetPanel(MaxLen: integer; AParent: TWinControl;
	63	OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
[456]	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
	162	function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
	163	procedure FreeEntries(SL: TStrings);
	164	procedure AssignFieldIDs(var Txt: string); overload;
	165	procedure AssignFieldIDs(SL: TStrings); overload;
	166	function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
	167	function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
	168	function HasTemplateField(txt: string): boolean;
	169
	170	function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
	171	function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
	172	function SaveTemplateFieldErrors: string;
	173	procedure ClearModifiedTemplateFields;
	174	function AnyTemplateFieldsModified: boolean;
	175	procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
	176	function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
	177	procedure EnsureText(edt: TEdit; ud: TUpDown);
	178	procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
	179	function StripEmbedded(iItems: string): string;
[829]	180	procedure StripScreenReaderCodes(var Text: string); overload;
	181	procedure StripScreenReaderCodes(SL: TStrings); overload;
	182	function HasScreenReaderBreakCodes(SL: TStrings): boolean;
[456]	183
	184	const
[829]	185	TemplateFieldSignature = '{FLD';
	186	TemplateFieldBeginSignature = TemplateFieldSignature + ':';
[456]	187	TemplateFieldEndSignature = '}';
[829]	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;
[456]	204	MissingFieldsTxt = 'One or more required fields must still be entered.';
	205
[829]	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
[456]	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',
[829]	226	{ dftText } 'T',
	227	{ dftScreenReader } 'S');
[456]	228
	229	TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
	230	{ dftUnknown } (('',''),
[829]	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'));
[456]	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',
[829]	263	{ dftTExt } 'TEXT',
	264	{ dftScreenReader } 'SRST');
[456]	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;
[829]	277
[456]	278	implementation
	279
	280	uses
[829]	281	rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
	282	VAUtils, VA508AccessibilityManager, VA508AccessibilityRouter;
[456]	283
	284	const
	285	NewTemplateField = 'NEW TEMPLATE FIELD';
	286	TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
	287	TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
	288
	289	var
	290	uTmplFlds: TList = nil;
	291	uEntries: TStringList = nil;
	292
	293	uNewTemplateFieldIDCnt: longint = 0;
	294	uRadioGroupIndex: integer = 0;
	295
	296	uInternalFieldIDCount: integer = 0;
	297
	298	const
	299	FieldIDDelim = '`';
	300	FieldIDLen = 6;
	301	NewLine = 'NL';
	302
	303	function GetNewFieldID: string;
	304	begin
	305	inc(uInternalFieldIDCount);
	306	Result := IntToStr(uInternalFieldIDCount);
	307	Result := FieldIDDelim +
	308	copy(StringOfChar('0', FieldIDLen-2) + Result, length(Result), FieldIDLen-1);
	309	end;
	310
	311	function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
	312	var
	313	idx: integer;
	314
	315	begin
	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]);
	328	end;
	329
	330	procedure FreeEntries(SL: TStrings);
	331	var
	332	i, idx, cnt: integer;
	333
	334	begin
	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;
	355	end;
	356
	357	procedure AssignFieldIDs(var Txt: string);
	358	var
	359	i: integer;
	360
	361	begin
	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;
	376	end;
	377
	378	procedure AssignFieldIDs(SL: TStrings);
	379	var
	380	i: integer;
	381	txt: string;
	382
	383	begin
	384	for i := 0 to SL.Count-1 do
	385	begin
	386	txt := SL[i];
	387	AssignFieldIDs(txt);
	388	SL[i] := txt;
	389	end;
	390	end;
	391
	392	procedure WordWrapText(var Txt: string);
	393	var
	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
	454	begin
	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;
	471	end;
	472
	473	function ResolveTemplateFields(Text: string;
	474	AutoWrap: boolean;
	475	Hidden: boolean = FALSE;
	476	IncludeEmbedded: boolean = FALSE): string;
	477	var
	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
	494	begin
	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);
	555	end;
	556
	557	function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
	558	var
	559	flen, CtrlID, i, j: integer;
	560	Entry: TTemplateDialogEntry;
	561	Fld: TTemplateField;
	562	Temp, NewTxt, FldName: string;
	563	FoundEntry: boolean;
	564
	565	begin
	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);
	617	end;
	618
	619	function HasTemplateField(txt: string): boolean;
	620	begin
	621	Result := (pos(TemplateFieldBeginSignature, txt) > 0);
	622	end;
	623
	624	function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
	625	var
	626	i, idx: integer;
	627	AData: TStrings;
	628
	629	begin
	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]);
	664	end;
	665
	666	function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
	667	const
	668	DUPFLD = 'Field Name is not unique';
	669
	670	var
	671	i: integer;
	672	msg: string;
	673
	674	begin
	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
[829]	701	ShowMsg(msg);
[456]	702	end;
	703
	704	function SaveTemplateFieldErrors: string;
	705	var
	706	i: integer;
	707	Errors: TStringList;
	708	Fld: TTemplateField;
	709	msg: string;
	710
	711	begin
	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;
	743	end;
	744
	745	procedure ClearModifiedTemplateFields;
	746	var
	747	i: integer;
	748	Fld: TTemplateField;
	749
	750	begin
	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;
	764	end;
	765
	766	function AnyTemplateFieldsModified: boolean;
	767	var
	768	i: integer;
	769
	770	begin
	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;
	783	end;
	784
	785	procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
	786	var
	787	i, j, k, flen, BadCount: integer;
	788	flddesc, tmp, fld: string;
	789	TmpList: TStringList;
	790	InactiveList: TStringList;
	791	FldObj: TTemplateField;
	792
	793	begin
	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:');
[829]	868	FastAddStrings(InactiveList, AList);
[456]	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;
	879	end;
	880
	881	function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
	882	var
	883	Errors: TStringList;
	884	btns: TMsgDlgButtons;
	885
	886	begin
	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;
	908	end;
	909
	910	procedure EnsureText(edt: TEdit; ud: TUpDown);
	911	var
	912	v: integer;
	913	s: string;
	914
	915	begin
	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;
	926	end;
	927
	928	function TemplateFieldCode2Field(const Code: string): TTemplateFieldType;
	929	var
	930	typ: TTemplateFieldType;
	931
	932	begin
	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;
	940	end;
	941
	942	function TemplateDateCode2DateType(const Code: string): TTmplFldDateType;
	943	var
	944	typ: TTmplFldDateType;
	945
	946	begin
	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;
	954	end;
	955
	956	procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
	957	var
	958	i: integer;
	959	tmp, output: string;
	960	ftype: TTemplateFieldType;
	961	dtype: TTmplFldDateType;
	962
	963	begin
	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;
	982	end;
	983
	984	{ TTemplateField }
	985
	986	constructor TTemplateField.Create(AData: TStrings);
	987	var
	988	tmp, p1: string;
	989	AFID, i,idx,cnt: integer;
	990
	991	begin
	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);
	1050	end;
	1051
	1052	function TTemplateField.GetTemplateFieldDefault: string;
	1053	begin
	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;
	1071	end;
	1072
	1073	procedure TTemplateField.CreateDialogControls(Entry: TTemplateDialogEntry;
	1074	var Index: Integer; CtrlID: integer);
	1075
	1076	var
	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;
[829]	1086	lbl: TCPRSTemplateFieldLabel;
[456]	1087	re: TRichEdit;
[829]	1088	pnl: TCPRSDialogNumber;
[456]	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
	1119	begin
	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
[829]	1129	edt := TCPRSDialogFieldEdit.Create(nil);
	1130	(edt as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1142	UpdateColorsFor508Compliance(edt, TRUE);
[456]	1143	ctrl := edt;
	1144	end;
	1145
	1146	dftComboBox:
	1147	begin
[829]	1148	cbo := TCPRSDialogComboBox.Create(nil);
	1149	(cbo as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1174	UpdateColorsFor508Compliance(cbo, TRUE);
[456]	1175	ctrl := cbo;
	1176	end;
	1177
	1178	dftButton:
	1179	begin
	1180	btn := TfraTemplateFieldButton.Create(nil);
[829]	1181	(btn as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1190	UpdateColorsFor508Compliance(btn);
[456]	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
[829]	1204	cb := TCPRSDialogCheckBox.Create(nil);
	1205	if i = 0 then
	1206	(cb as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1224	UpdateColorsFor508Compliance(cb);
[456]	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
[829]	1243	dcbo := TCPRSDialogDateCombo.Create(nil);
	1244	(dcbo as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1253	UpdateColorsFor508Compliance(dcbo, TRUE);
[456]	1254	ctrl := dcbo;
	1255	end
	1256	else
	1257	begin
[829]	1258	dbox := TCPRSDialogDateBox.Create(nil);
	1259	(dbox as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1272	UpdateColorsFor508Compliance(dbox, TRUE);
[456]	1273	ctrl := dbox;
	1274	end;
	1275	end;
	1276
	1277	dftNumber:
	1278	begin
[829]	1279	pnl := TCPRSDialogNumber.CreatePanel(nil);
	1280	(pnl as ICPRSDialogComponent).RequiredField := Required;
[456]	1281	pnl.Parent := Entry.FPanel;
	1282	pnl.BevelOuter := bvNone;
	1283	pnl.Tag := CtrlID;
[829]	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!
[456]	1289	i := Increment;
	1290	if i < 1 then i := 1;
[829]	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);
[456]	1297	ctrl := pnl;
	1298	end;
	1299
	1300	dftHyperlink, dftText:
	1301	begin
	1302	if (FFldType = dftHyperlink) and User.WebAccess then
[829]	1303	lbl := TCPRSDialogHyperlinkLabel.Create(nil)
[456]	1304	else
[829]	1305	lbl := TCPRSTemplateFieldLabel.Create(nil);
[456]	1306	lbl.Parent := Entry.FPanel;
	1307	lbl.ShowAccelChar := FALSE;
[829]	1308	lbl.Exclude := FSepLines;
[456]	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;
[829]	1323	if lbl is TCPRSDialogHyperlinkLabel then
	1324	TCPRSDialogHyperlinkLabel(lbl).Init(FURL);
[456]	1325	lbl.Tag := CtrlID;
[829]	1326	UpdateColorsFor508Compliance(lbl);
[456]	1327	ctrl := lbl;
	1328	end;
	1329
	1330	dftWP:
	1331	begin
[829]	1332	re := TCPRSDialogRichEdit.Create(nil);
	1333	(re as ICPRSDialogComponent).RequiredField := Required;
[456]	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;
[829]	1351	UpdateColorsFor508Compliance(re, TRUE);
[456]	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;
	1362	end;
	1363
	1364	function TTemplateField.CanModify: boolean;
	1365	begin
	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
[829]	1371	ShowMsg('Template Field ' + FFldName + ' is currently being edited by another user.');
[456]	1372	end
	1373	else
	1374	Result := TRUE;
	1375	if(Result) then FModified := TRUE;
	1376	end;
	1377
	1378	procedure TTemplateField.SetEditDefault(const Value: string);
	1379	begin
	1380	if(FEditDefault <> Value) and CanModify then
	1381	FEditDefault := Value;
	1382	end;
	1383
	1384	procedure TTemplateField.SetFldName(const Value: string);
	1385	begin
	1386	if(FFldName <> Value) and CanModify then
	1387	begin
	1388	FFldName := Value;
	1389	FNameChanged := TRUE;
	1390	end;
	1391	end;
	1392
	1393	procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
	1394	begin
	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;
	1430	end;
	1431
	1432	procedure TTemplateField.SetID(const Value: string);
	1433	begin
	1434	// if(FID <> Value) and CanModify then
	1435	FID := Value;
	1436	end;
	1437
	1438	procedure TTemplateField.SetInactive(const Value: boolean);
	1439	begin
	1440	if(FInactive <> Value) and CanModify then
	1441	FInactive := Value;
	1442	end;
	1443
	1444	procedure TTemplateField.SetItemDefault(const Value: string);
	1445	begin
	1446	if(FItemDefault <> Value) and CanModify then
	1447	FItemDefault := Value;
	1448	end;
	1449
	1450	procedure TTemplateField.SetItems(const Value: string);
	1451	begin
	1452	if(FItems <> Value) and CanModify then
	1453	FItems := Value;
	1454	end;
	1455
	1456	procedure TTemplateField.SetLMText(const Value: string);
	1457	begin
	1458	if(FLMText <> Value) and CanModify then
	1459	FLMText := Value;
	1460	end;
	1461
	1462	procedure TTemplateField.SetMaxLen(const Value: integer);
	1463	begin
	1464	if(FMaxLen <> Value) and CanModify then
	1465	FMaxLen := Value;
	1466	end;
	1467
	1468	procedure TTemplateField.SetNotes(const Value: string);
	1469	begin
	1470	if(FNotes <> Value) and CanModify then
	1471	FNotes := Value;
	1472	end;
	1473
	1474	function TTemplateField.SaveError: string;
	1475	var
	1476	TmpSL, FldSL: TStringList;
	1477	AID,Res: string;
	1478	idx, i: integer;
	1479	IEN64: Int64;
	1480	NewRec: boolean;
	1481
	1482	begin
	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;
	1580	end;
	1581
	1582	procedure TTemplateField.Assign(AFld: TTemplateField);
	1583	begin
	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;
	1603	end;
	1604
	1605	function TTemplateField.Width: integer;
	1606	var
	1607	i, ilen: integer;
	1608	TmpSL: TStringList;
	1609
	1610	begin
	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;
	1636	end;
	1637
	1638	destructor TTemplateField.Destroy;
	1639	begin
	1640	uTmplFlds.Remove(Self);
	1641	inherited;
	1642	end;
	1643
	1644	procedure TTemplateField.SetRequired(const Value: boolean);
	1645	begin
	1646	if(FRequired <> Value) and CanModify then
	1647	FRequired := Value;
	1648	end;
	1649
	1650	function TTemplateField.NewField: boolean;
	1651	begin
	1652	Result := (StrToIntDef(FID,0) <= 0);
	1653	end;
	1654
	1655	procedure TTemplateField.SetSepLines(const Value: boolean);
	1656	begin
	1657	if(FSepLines <> Value) and CanModify then
	1658	FSepLines := Value
	1659	end;
	1660
	1661	procedure TTemplateField.SetIncrement(const Value: integer);
	1662	begin
	1663	if(FIncrement <> Value) and CanModify then
	1664	FIncrement := Value;
	1665	end;
	1666
	1667	procedure TTemplateField.SetIndent(const Value: integer);
	1668	begin
	1669	if(FIndent <> Value) and CanModify then
	1670	FIndent := Value;
	1671	end;
	1672
	1673	procedure TTemplateField.SetMaxVal(const Value: integer);
	1674	begin
	1675	if(FMaxVal <> Value) and CanModify then
	1676	FMaxVal := Value;
	1677	end;
	1678
	1679	procedure TTemplateField.SetMinVal(const Value: integer);
	1680	begin
	1681	if(FMinVal <> Value) and CanModify then
	1682	FMinVal := Value;
	1683	end;
	1684
	1685	procedure TTemplateField.SetPad(const Value: integer);
	1686	begin
	1687	if(FPad <> Value) and CanModify then
	1688	FPad := Value;
	1689	end;
	1690
	1691	procedure TTemplateField.SetTextLen(const Value: integer);
	1692	begin
	1693	if(FTextLen <> Value) and CanModify then
	1694	FTextLen := Value;
	1695	end;
	1696
	1697	procedure TTemplateField.SetURL(const Value: string);
	1698	begin
	1699	if(FURL <> Value) and CanModify then
	1700	FURL := Value;
	1701	end;
	1702
	1703	function TTemplateField.GetRequired: boolean;
	1704	begin
	1705	if FFldType in NoRequired then
	1706	Result := FALSE
	1707	else
	1708	Result := FRequired;
	1709	end;
	1710
	1711	procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
	1712	begin
	1713	if(FDateType <> Value) and CanModify then
	1714	FDateType := Value;
	1715	end;
	1716
	1717	{ TTemplateDialogEntry }
	1718	const
	1719	EOL_MARKER = #182;
[829]	1720	SR_BREAK = #186;
[456]	1721
	1722	procedure PanelDestroy(AData: Pointer; Sender: TObject);
	1723	var
	1724	idx: integer;
	1725	dlg: TTemplateDialogEntry;
	1726
	1727	begin
	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;
	1734	end;
	1735
	1736	constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
	1737	var
	1738	CtrlID, idx, i, j, flen: integer;
	1739	txt, FldName: string;
	1740	Fld: TTemplateField;
	1741
	1742	begin
	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
[829]	1751	begin
[456]	1752	for i := 1 to FControls.Count-1 do
	1753	FControls[i] := EOL_MARKER + FControls[i];
[829]	1754	if not ScreenReaderSystemActive then
	1755	StripScreenReaderCodes(FControls);
	1756	end;
[456]	1757	FFirstBuild := TRUE;
[829]	1758	FPanel := TDlgFieldPanel.Create(AParent.Owner);
[456]	1759	FPanel.Parent := AParent;
	1760	FPanel.BevelOuter := bvNone;
	1761	FPanel.Caption := '';
	1762	FPanel.Font.Assign(FFont);
[829]	1763	UpdateColorsFor508Compliance(FPanel, TRUE);
[456]	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
[829]	1790	begin
	1791	if ScreenReaderSystemActive then
	1792	begin
	1793	if Fld.FFldType in [dftCheckBoxes, dftRadioButtons] then
	1794	FControls[idx] := FControls[idx] + ScreenReaderStopCode;
	1795	end;
[456]	1796	FControls[idx] := FControls[idx] + '*';
[829]	1797	end;
[456]	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;
[829]	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;
[456]	1832	end;
	1833
	1834	destructor TTemplateDialogEntry.Destroy;
	1835	begin
	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;
	1847	end;
	1848
	1849	procedure TTemplateDialogEntry.DoChange(Sender: TObject);
	1850	begin
	1851	if (not FUpdating) and assigned(FOnChange) then
	1852	FOnChange(Self);
	1853	end;
	1854
	1855	function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
	1856	var FoundEntry: boolean; AutoWrap: boolean;
	1857	emField: string = ''): string;
	1858	var
	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
	1890	begin
	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;
[829]	1909	if(Ctrl is TCPRSTemplateFieldLabel) then
[456]	1910	begin
[829]	1911	if not TCPRSTemplateFieldLabel(Ctrl).Exclude then begin
[456]	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}
[829]	1926	Result := TCPRSTemplateFieldLabel(Ctrl).Caption
[456]	1927	end; {case iField.FldType}
	1928	end {if emField}
	1929	else
[829]	1930	Result := TCPRSTemplateFieldLabel(Ctrl).Caption;
[456]	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;
	2017	end;
	2018
	2019	function TTemplateDialogEntry.GetFieldValues: string;
	2020	var
	2021	i: integer;
	2022	Ctrl: TControl;
	2023	CtrlID: integer;
	2024	TmpIDs: TList;
	2025	TmpSL: TStringList;
	2026	Dummy: boolean;
	2027
	2028	begin
	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;
	2054	end;
	2055
[829]	2056	function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl;
	2057	OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel;
[456]	2058	var
[829]	2059	i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer;
[456]	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;
[829]	2065	sLbl: TCPRSDialogStaticLabel;
	2066	nLbl: TVA508ChainedLabel;
	2067	sLblHeight: integer;
	2068	TabOrdr: integer;
	2069
[456]	2070	const
	2071	FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
	2072	overlay the focus rect on its parent panel.}
[829]	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
[456]	2092	procedure DoLabel(Atxt: string);
	2093	var
[829]	2094	ctrl: TControl;
	2095	tempLbl: TVA508ChainedLabel;
[456]	2096
	2097	begin
[829]	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);
[456]	2133	end;
	2134
[829]	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
[456]	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
	2226	begin
	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
[829]	2230	Init;
[456]	2231	for i := 0 to FControls.Count-1 do
	2232	begin
	2233	txt := FControls[i];
[829]	2234	if ScreenReaderSystemActive then
	2235	Text508Work;
	2236	if StripCode(txt,EOL_MARKER) then
[456]	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
[829]	2288	if ScreenReaderSystemActive then
	2289	Ctrl508Work(ctrl);
[456]	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
[829]	2307	yinc := Ctrl.Height + 2;
[456]	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);
[829]	2320	if ScreenReaderSystemActive then
	2321	ScreenReaderSystem_Stop;
[456]	2322	Result := FPanel;
	2323	end;
	2324
	2325	function TTemplateDialogEntry.GetText: string;
	2326	begin
	2327	Result := ResolveTemplateFields(FText, FALSE);
	2328	end;
	2329
	2330	procedure TTemplateDialogEntry.KillLabels;
	2331	var
	2332	i, idx: integer;
	2333	obj: TObject;
[829]	2334	max: integer;
[456]	2335
	2336	begin
	2337	if(assigned(FPanel)) then
	2338	begin
[829]	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
[456]	2344	begin
	2345	obj := FPanel.Controls[i];
[829]	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;
[456]	2353	end;
[829]	2354	end;
[456]	2355	end;
	2356	end;
	2357
	2358	procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
	2359	const Value: boolean);
	2360	var
	2361	M: TMethod;
	2362
	2363	begin
	2364	FAutoDestroyOnPanelFree := Value;
	2365	if(Value) then
	2366	begin
	2367	M.Data := Self;
	2368	M.Code := @PanelDestroy;
[829]	2369	FPanel.OnDestroy := TNotifyEvent(M);
[456]	2370	end
	2371	else
[829]	2372	FPanel.OnDestroy := nil;
[456]	2373	end;
	2374
	2375	procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
	2376	var
	2377	cnt, i, j: integer;
	2378	Ctrl: TControl;
	2379	Done: boolean;
	2380
	2381	begin
	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;
[829]	2413	TORCheckBox(Ctrl).Checked := FALSE; //<-PSI-06-170-ADDED THIS LINE - v27.23 - RV
[456]	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;
	2441	end;
	2442
	2443	procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
	2444	var
	2445	i: integer;
	2446	TmpSL: TStringList;
	2447
	2448	begin
	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;
	2458	end;
	2459
[829]	2460	function TTemplateDialogEntry.StripCode(var txt: string; code: char): boolean;
[456]	2461	var
[829]	2462	p: integer;
[456]	2463	begin
[829]	2464	p := pos(code, txt);
	2465	Result := (p > 0);
	2466	if Result then
[456]	2467	begin
[829]	2468	while p > 0 do
	2469	begin
	2470	delete(txt, p, 1);
	2471	p := pos(code, txt);
[456]	2472	end;
	2473	end;
	2474	end;
	2475
[829]	2476	procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
[456]	2477	begin
[829]	2478	EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
	2479	DoChange(Sender);
[456]	2480	end;
	2481
	2482	function StripEmbedded(iItems: string): string;
	2483	{7/26/01 S Monson
	2484	Returns the field will all embedded fields removed}
	2485	var
	2486	p1, p2, icur: integer;
	2487	Begin
	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;
	2503	end;
	2504
[829]	2505	procedure StripScreenReaderCodes(var Text: string);
	2506	var
	2507	p, j: integer;
	2508	begin
	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;
	2519	end;
	2520
	2521	procedure StripScreenReaderCodes(SL: TStrings);
	2522	var
	2523	temp: string;
	2524	i: integer;
	2525
	2526	begin
	2527	for i := 0 to SL.Count - 1 do
	2528	begin
	2529	temp := SL[i];
	2530	StripScreenReaderCodes(temp);
	2531	SL[i] := temp;
	2532	end;
	2533	end;
	2534
	2535	function HasScreenReaderBreakCodes(SL: TStrings): boolean;
	2536	var
	2537	i: integer;
	2538
	2539	begin
	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;
	2547	end;
	2548
[456]	2549	initialization
	2550
	2551	finalization
	2552	KillObj(@uTmplFlds, TRUE);
	2553	KillObj(@uEntries, TRUE);
	2554
	2555	end.

Note: See TracBrowser for help on using the repository browser.

Download in other formats: