Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

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

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

Line
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: