Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

source: cprs/branches/tmg-cprs/CPRS-Chart/Templates/uTemplateFields.pas@ 465

Last change on this file since 465 was 453, checked in by Kevin Toppenberg, 16 years ago
Initial upload of TMG-CPRS 1.0.26.69
File size: 73.9 KB

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

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

Download in other formats: