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

Last change on this file since 468 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
2unit uTemplateFields;
3
4interface
5
6uses
7 Forms, SysUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
8 Graphics, ORClasses, ComCtrls, ORDtTm;
9
10type
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
17const
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
28type
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
159function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
160procedure FreeEntries(SL: TStrings);
161procedure AssignFieldIDs(var Txt: string); overload;
162procedure AssignFieldIDs(SL: TStrings); overload;
163function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
164function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
165function HasTemplateField(txt: string): boolean;
166
167function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
168function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
169function SaveTemplateFieldErrors: string;
170procedure ClearModifiedTemplateFields;
171function AnyTemplateFieldsModified: boolean;
172procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
173function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
174procedure EnsureText(edt: TEdit; ud: TUpDown);
175procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
176function StripEmbedded(iItems: string): string;
177
178const
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
184Const
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
198function 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
214function 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
226Const
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
252type
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
268implementation
269
270uses
271 ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
272 DKLang; //kt
273
274const
275 NewTemplateField = 'NEW TEMPLATE FIELD';
276 TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
277 TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
278
279
280var
281 uTmplFlds: TList = nil;
282 uEntries: TStringList = nil;
283
284 uNewTemplateFieldIDCnt: longint = 0;
285 uRadioGroupIndex: integer = 0;
286
287 uInternalFieldIDCount: integer = 0;
288
289const
290 FieldIDDelim = '`';
291 FieldIDLen = 6;
292 NewLine = 'NL';
293
294type
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
310function MissingFieldsTxt : string;
311begin Result := DKLangConstW('uTemplateFields_One_or_more_required_fields_must_still_be_enteredx');
312end;
313
314//kt 8-17-07 Added to replace constant with function
315function TemplateFieldTypeDesc(index: TTemplateFieldType; Short : boolean) : string;
316begin
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}
331end;
332
333//kt 8-17-07 Added to replace constant with function
334function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
335begin
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}
346end;
347
348function GetNewFieldID: string;
349begin
350 inc(uInternalFieldIDCount);
351 Result := IntToStr(uInternalFieldIDCount);
352 Result := FieldIDDelim +
353 copy(StringOfChar('0', FieldIDLen-2) + Result, length(Result), FieldIDLen-1);
354end;
355
356function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
357var
358 idx: integer;
359
360begin
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]);
373end;
374
375procedure FreeEntries(SL: TStrings);
376var
377 i, idx, cnt: integer;
378
379begin
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;
400end;
401
402procedure AssignFieldIDs(var Txt: string);
403var
404 i: integer;
405
406begin
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;
421end;
422
423procedure AssignFieldIDs(SL: TStrings);
424var
425 i: integer;
426 txt: string;
427
428begin
429 for i := 0 to SL.Count-1 do
430 begin
431 txt := SL[i];
432 AssignFieldIDs(txt);
433 SL[i] := txt;
434 end;
435end;
436
437procedure WordWrapText(var Txt: string);
438var
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
499begin
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;
516end;
517
518function ResolveTemplateFields(Text: string;
519 AutoWrap: boolean;
520 Hidden: boolean = FALSE;
521 IncludeEmbedded: boolean = FALSE): string;
522var
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
539begin
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);
600end;
601
602function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList = nil): boolean;
603var
604 flen, CtrlID, i, j: integer;
605 Entry: TTemplateDialogEntry;
606 Fld: TTemplateField;
607 Temp, NewTxt, FldName: string;
608 FoundEntry: boolean;
609
610begin
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);
662end;
663
664function HasTemplateField(txt: string): boolean;
665begin
666 Result := (pos(TemplateFieldBeginSignature, txt) > 0);
667end;
668
669function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
670var
671 i, idx: integer;
672 AData: TStrings;
673
674begin
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]);
709end;
710
711function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
712//const
713//DUPFLD = 'Field Name is not unique'; <-- original line. //kt 8/8/2007
714
715var
716 i: integer;
717 msg: string;
718 DUPFLD : string; //kt
719
720begin
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);
752end;
753
754function SaveTemplateFieldErrors: string;
755var
756 i: integer;
757 Errors: TStringList;
758 Fld: TTemplateField;
759 msg: string;
760
761begin
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;
794end;
795
796procedure ClearModifiedTemplateFields;
797var
798 i: integer;
799 Fld: TTemplateField;
800
801begin
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;
815end;
816
817function AnyTemplateFieldsModified: boolean;
818var
819 i: integer;
820
821begin
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;
834end;
835
836procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
837var
838 i, j, k, flen, BadCount: integer;
839 flddesc, tmp, fld: string;
840 TmpList: TStringList;
841 InactiveList: TStringList;
842 FldObj: TTemplateField;
843
844begin
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;
938end;
939
940function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
941var
942 Errors: TStringList;
943 btns: TMsgDlgButtons;
944
945begin
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;
969end;
970
971procedure EnsureText(edt: TEdit; ud: TUpDown);
972var
973 v: integer;
974 s: string;
975
976begin
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;
987end;
988
989function TemplateFieldCode2Field(const Code: string): TTemplateFieldType;
990var
991 typ: TTemplateFieldType;
992
993begin
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;
1001end;
1002
1003function TemplateDateCode2DateType(const Code: string): TTmplFldDateType;
1004var
1005 typ: TTmplFldDateType;
1006
1007begin
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;
1015end;
1016
1017procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
1018var
1019 i: integer;
1020 tmp, output: string;
1021 ftype: TTemplateFieldType;
1022 dtype: TTmplFldDateType;
1023
1024begin
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;
1045end;
1046
1047{ TTemplateField }
1048
1049constructor TTemplateField.Create(AData: TStrings);
1050var
1051 tmp, p1: string;
1052 AFID, i,idx,cnt: integer;
1053
1054begin
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);
1113end;
1114
1115function TTemplateField.GetTemplateFieldDefault: string;
1116begin
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;
1134end;
1135
1136procedure TTemplateField.CreateDialogControls(Entry: TTemplateDialogEntry;
1137 var Index: Integer; CtrlID: integer);
1138
1139var
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
1183begin
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;
1419end;
1420
1421function TTemplateField.CanModify: boolean;
1422begin
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;
1434end;
1435
1436procedure TTemplateField.SetEditDefault(const Value: string);
1437begin
1438 if(FEditDefault <> Value) and CanModify then
1439 FEditDefault := Value;
1440end;
1441
1442procedure TTemplateField.SetFldName(const Value: string);
1443begin
1444 if(FFldName <> Value) and CanModify then
1445 begin
1446 FFldName := Value;
1447 FNameChanged := TRUE;
1448 end;
1449end;
1450
1451procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
1452begin
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;
1488end;
1489
1490procedure TTemplateField.SetID(const Value: string);
1491begin
1492// if(FID <> Value) and CanModify then
1493 FID := Value;
1494end;
1495
1496procedure TTemplateField.SetInactive(const Value: boolean);
1497begin
1498 if(FInactive <> Value) and CanModify then
1499 FInactive := Value;
1500end;
1501
1502procedure TTemplateField.SetItemDefault(const Value: string);
1503begin
1504 if(FItemDefault <> Value) and CanModify then
1505 FItemDefault := Value;
1506end;
1507
1508procedure TTemplateField.SetItems(const Value: string);
1509begin
1510 if(FItems <> Value) and CanModify then
1511 FItems := Value;
1512end;
1513
1514procedure TTemplateField.SetLMText(const Value: string);
1515begin
1516 if(FLMText <> Value) and CanModify then
1517 FLMText := Value;
1518end;
1519
1520procedure TTemplateField.SetMaxLen(const Value: integer);
1521begin
1522 if(FMaxLen <> Value) and CanModify then
1523 FMaxLen := Value;
1524end;
1525
1526procedure TTemplateField.SetNotes(const Value: string);
1527begin
1528 if(FNotes <> Value) and CanModify then
1529 FNotes := Value;
1530end;
1531
1532function TTemplateField.SaveError: string;
1533var
1534 TmpSL, FldSL: TStringList;
1535 AID,Res: string;
1536 idx, i: integer;
1537 IEN64: Int64;
1538 NewRec: boolean;
1539
1540begin
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;
1639end;
1640
1641procedure TTemplateField.Assign(AFld: TTemplateField);
1642begin
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;
1662end;
1663
1664function TTemplateField.Width: integer;
1665var
1666 i, ilen: integer;
1667 TmpSL: TStringList;
1668
1669begin
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;
1695end;
1696
1697destructor TTemplateField.Destroy;
1698begin
1699 uTmplFlds.Remove(Self);
1700 inherited;
1701end;
1702
1703procedure TTemplateField.SetRequired(const Value: boolean);
1704begin
1705 if(FRequired <> Value) and CanModify then
1706 FRequired := Value;
1707end;
1708
1709function TTemplateField.NewField: boolean;
1710begin
1711 Result := (StrToIntDef(FID,0) <= 0);
1712end;
1713
1714procedure TTemplateField.SetSepLines(const Value: boolean);
1715begin
1716 if(FSepLines <> Value) and CanModify then
1717 FSepLines := Value
1718end;
1719
1720procedure TTemplateField.SetIncrement(const Value: integer);
1721begin
1722 if(FIncrement <> Value) and CanModify then
1723 FIncrement := Value;
1724end;
1725
1726procedure TTemplateField.SetIndent(const Value: integer);
1727begin
1728 if(FIndent <> Value) and CanModify then
1729 FIndent := Value;
1730end;
1731
1732procedure TTemplateField.SetMaxVal(const Value: integer);
1733begin
1734 if(FMaxVal <> Value) and CanModify then
1735 FMaxVal := Value;
1736end;
1737
1738procedure TTemplateField.SetMinVal(const Value: integer);
1739begin
1740 if(FMinVal <> Value) and CanModify then
1741 FMinVal := Value;
1742end;
1743
1744procedure TTemplateField.SetPad(const Value: integer);
1745begin
1746 if(FPad <> Value) and CanModify then
1747 FPad := Value;
1748end;
1749
1750procedure TTemplateField.SetTextLen(const Value: integer);
1751begin
1752 if(FTextLen <> Value) and CanModify then
1753 FTextLen := Value;
1754end;
1755
1756procedure TTemplateField.SetURL(const Value: string);
1757begin
1758 if(FURL <> Value) and CanModify then
1759 FURL := Value;
1760end;
1761
1762function TTemplateField.GetRequired: boolean;
1763begin
1764 if FFldType in NoRequired then
1765 Result := FALSE
1766 else
1767 Result := FRequired;
1768end;
1769
1770procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
1771begin
1772 if(FDateType <> Value) and CanModify then
1773 FDateType := Value;
1774end;
1775
1776{ TTemplateDialogEntry }
1777const
1778 EOL_MARKER = #182;
1779
1780procedure PanelDestroy(AData: Pointer; Sender: TObject);
1781var
1782 idx: integer;
1783 dlg: TTemplateDialogEntry;
1784
1785begin
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;
1792end;
1793
1794constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
1795var
1796 CtrlID, idx, i, j, flen: integer;
1797 txt, FldName: string;
1798 Fld: TTemplateField;
1799
1800begin
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;
1862end;
1863
1864destructor TTemplateDialogEntry.Destroy;
1865begin
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;
1877end;
1878
1879procedure TTemplateDialogEntry.DoChange(Sender: TObject);
1880begin
1881 if (not FUpdating) and assigned(FOnChange) then
1882 FOnChange(Self);
1883end;
1884
1885function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
1886 var FoundEntry: boolean; AutoWrap: boolean;
1887 emField: string = ''): string;
1888var
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
1920begin
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;
2047end;
2048
2049function TTemplateDialogEntry.GetFieldValues: string;
2050var
2051 i: integer;
2052 Ctrl: TControl;
2053 CtrlID: integer;
2054 TmpIDs: TList;
2055 TmpSL: TStringList;
2056 Dummy: boolean;
2057
2058begin
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;
2084end;
2085
2086function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
2087var
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;
2094const
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
2120begin
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;
2223end;
2224
2225function TTemplateDialogEntry.GetText: string;
2226begin
2227 Result := ResolveTemplateFields(FText, FALSE);
2228end;
2229
2230procedure TTemplateDialogEntry.KillLabels;
2231var
2232 i, idx: integer;
2233 obj: TObject;
2234
2235begin
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;
2247end;
2248
2249procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
2250 const Value: boolean);
2251var
2252 M: TMethod;
2253
2254begin
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;
2264end;
2265
2266procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
2267var
2268 cnt, i, j: integer;
2269 Ctrl: TControl;
2270 Done: boolean;
2271
2272begin
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;
2331end;
2332
2333procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
2334var
2335 i: integer;
2336 TmpSL: TStringList;
2337
2338begin
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;
2348end;
2349
2350procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
2351begin
2352 EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
2353 DoChange(Sender);
2354end;
2355
2356{ TFieldPanel }
2357
2358destructor TFieldPanel.Destroy;
2359begin
2360 if(assigned(FOnDestroy)) then
2361 FOnDestroy(Self);
2362 inherited;
2363end;
2364
2365{intercept the paint event to draw the focus rect if FFocused is true}
2366function TFieldPanel.GetFocus: boolean;
2367begin
2368 result := Focused;
2369end;
2370
2371procedure TFieldPanel.Paint;
2372var
2373 DC: HDC;
2374 R: TRect;
2375
2376begin
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;
2392end;
2393
2394procedure TFieldPanel.SetTheFocus(const Value: boolean);
2395begin
2396 if Value then
2397 SetFocus;
2398end;
2399
2400{ TWebLabel }
2401
2402procedure TWebLabel.Clicked(Sender: TObject);
2403begin
2404 GotoWebPage(FAddr);
2405end;
2406
2407procedure TWebLabel.Init(Addr: string);
2408begin
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;
2418end;
2419
2420function StripEmbedded(iItems: string): string;
2421{7/26/01 S Monson
2422 Returns the field will all embedded fields removed}
2423var
2424 p1, p2, icur: integer;
2425Begin
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;
2441end;
2442
2443initialization
2444
2445finalization
2446 KillObj(@uTmplFlds, TRUE);
2447 KillObj(@uEntries, TRUE);
2448
2449end.
Note: See TracBrowser for help on using the repository browser.