source: cprs/branches/foia-cprs/CPRS-Chart/Templates/uTemplateFields.pas@ 809

Last change on this file since 809 was 460, checked in by Kevin Toppenberg, 16 years ago

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