| 1 | //kt -- Modified with SourceScanner on 8/8/2007
 | 
|---|
| 2 | unit uTemplateFields;
 | 
|---|
| 3 | 
 | 
|---|
| 4 | interface
 | 
|---|
| 5 | 
 | 
|---|
| 6 | uses
 | 
|---|
| 7 |   Forms, SysUtils, StrUtils, Classes, Dialogs, StdCtrls, ExtCtrls, Controls, Contnrs,
 | 
|---|
| 8 |   Graphics, ORClasses, ComCtrls, ORDtTm, uEvaluate;
 | 
|---|
| 9 | 
 | 
|---|
| 10 | type
 | 
|---|
| 11 |   TTemplateFieldType = (dftUnknown, dftEditBox, dftComboBox, dftButton, dftCheckBoxes,
 | 
|---|
| 12 |                         dftRadioButtons, dftDate, dftNumber, dftHyperlink, dftWP, dftText);
 | 
|---|
| 13 | 
 | 
|---|
| 14 |   TTmplFldDateType = (dtUnknown, dtDate, dtDateTime, dtDateReqTime,
 | 
|---|
| 15 |                                  dtCombo, dtYear, dtYearMonth);
 | 
|---|
| 16 | 
 | 
|---|
| 17 | const
 | 
|---|
| 18 |   FldItemTypes  = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons, dftWP, dftText];
 | 
|---|
| 19 |   SepLinesTypes = [dftCheckBoxes, dftRadioButtons];
 | 
|---|
| 20 |   EditLenTypes  = [dftEditBox, dftComboBox, dftWP];
 | 
|---|
| 21 |   EditDfltTypes = [dftEditBox, dftHyperlink];
 | 
|---|
| 22 |   EditDfltType2 = [dftEditBox, dftHyperlink, dftDate];
 | 
|---|
| 23 |   ItemDfltTypes = [dftComboBox, dftButton, dftCheckBoxes, dftRadioButtons];
 | 
|---|
| 24 |   NoRequired    = [dftHyperlink, dftText];
 | 
|---|
| 25 |   ExcludeText   = [dftHyperlink, dftText];
 | 
|---|
| 26 |   DateComboTypes = [dtCombo, dtYear, dtYearMonth];
 | 
|---|
| 27 | 
 | 
|---|
| 28 | type
 | 
|---|
| 29 |   TTemplateDialogEntry = class(TObject)
 | 
|---|
| 30 |   private
 | 
|---|
| 31 |     FID: string;
 | 
|---|
| 32 |     FFont: TFont;
 | 
|---|
| 33 |     FPanel: TPanel;
 | 
|---|
| 34 |     FControls: TStringList;
 | 
|---|
| 35 |     FIndents: TStringList;
 | 
|---|
| 36 |     FFirstBuild: boolean;
 | 
|---|
| 37 |     FOnChange: TNotifyEvent;
 | 
|---|
| 38 |     FText: string;
 | 
|---|
| 39 |     FInternalID: string;
 | 
|---|
| 40 |     FObj: TObject;
 | 
|---|
| 41 |     FFieldValues: string;
 | 
|---|
| 42 |     FUpdating: boolean;
 | 
|---|
| 43 |     FAutoDestroyOnPanelFree: boolean;
 | 
|---|
| 44 |     FPanelDying: boolean;
 | 
|---|
| 45 |     FOnDestroy: TNotifyEvent;
 | 
|---|
| 46 |     FHTMLMode : boolean; //kt added 12/28/09
 | 
|---|
| 47 |     FAnswerOpenTag : string; //kt added 12/28/09
 | 
|---|
| 48 |     FAnswerCloseTag : string; //kt added 12/28/09
 | 
|---|
| 49 |     procedure KillLabels;
 | 
|---|
| 50 |     function GetFieldValues: string;
 | 
|---|
| 51 |     procedure SetFieldValues(const Value: string);
 | 
|---|
| 52 |     procedure SetAutoDestroyOnPanelFree(const Value: boolean);
 | 
|---|
| 53 |     procedure SetAnswerHTMLTag(Value : string); //kt 12/28/09
 | 
|---|
| 54 | 
 | 
|---|
| 55 |   protected
 | 
|---|
| 56 |     procedure UpDownChange(Sender: TObject);
 | 
|---|
| 57 |     procedure DoChange(Sender: TObject);
 | 
|---|
| 58 |     function GetControlText(CtrlID: integer; NoCommas: boolean;
 | 
|---|
| 59 |                             var FoundEntry: boolean; AutoWrap: boolean;
 | 
|---|
| 60 |                             emField: string = ''): string;
 | 
|---|
| 61 |     procedure SetControlText(CtrlID: integer; AText: string);
 | 
|---|
| 62 |   public
 | 
|---|
| 63 |     constructor Create(AParent: TWinControl; AID, Text: string);
 | 
|---|
| 64 |     destructor Destroy; override;
 | 
|---|
| 65 |     function GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
 | 
|---|
| 66 |     function GetText: string;
 | 
|---|
| 67 |     property Text: string read FText write FText;
 | 
|---|
| 68 |     property InternalID: string read FInternalID write FInternalID;
 | 
|---|
| 69 |     property ID: string read FID;
 | 
|---|
| 70 |     property Obj: TObject read FObj write FObj;
 | 
|---|
| 71 |     property OnChange: TNotifyEvent read FOnChange write FOnChange;
 | 
|---|
| 72 |     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
 | 
|---|
| 73 |     property FieldValues: string read GetFieldValues write SetFieldValues;
 | 
|---|
| 74 |     property HTMLMode : boolean read FHTMLMode write FHTMLMode; //kt added 12/28/09
 | 
|---|
| 75 |     property AnswerHTMLTag : string read FAnswerOpenTag write SetAnswerHTMLTag;  //kt added 12/28/09
 | 
|---|
| 76 |     property AutoDestroyOnPanelFree: boolean read FAutoDestroyOnPanelFree
 | 
|---|
| 77 |                                              write SetAutoDestroyOnPanelFree;
 | 
|---|
| 78 |   end;
 | 
|---|
| 79 | 
 | 
|---|
| 80 |   TTemplateField = class(TObject)
 | 
|---|
| 81 |   private
 | 
|---|
| 82 |     FMaxLen: integer;
 | 
|---|
| 83 |     FFldName: string;
 | 
|---|
| 84 |     FNameChanged: boolean;
 | 
|---|
| 85 |     FLMText: string;
 | 
|---|
| 86 |     FEditDefault: string;
 | 
|---|
| 87 |     FNotes: string;
 | 
|---|
| 88 |     FItems: string;
 | 
|---|
| 89 |     FInactive: boolean;
 | 
|---|
| 90 |     FItemDefault: string;
 | 
|---|
| 91 |     FFldType: TTemplateFieldType;
 | 
|---|
| 92 |     FRequired: boolean;
 | 
|---|
| 93 |     FSepLines: boolean;
 | 
|---|
| 94 |     FTextLen: integer;
 | 
|---|
| 95 |     FIndent: integer;
 | 
|---|
| 96 |     FPad: integer;
 | 
|---|
| 97 |     FMinVal: integer;
 | 
|---|
| 98 |     FMaxVal: integer;
 | 
|---|
| 99 |     FIncrement: integer;
 | 
|---|
| 100 |     FURL: string;
 | 
|---|
| 101 |     FDateType: TTmplFldDateType;
 | 
|---|
| 102 |     FModified: boolean;
 | 
|---|
| 103 |     FID: string;
 | 
|---|
| 104 |     FLocked: boolean;
 | 
|---|
| 105 |     procedure SetEditDefault(const Value: string);
 | 
|---|
| 106 |     procedure SetFldName(const Value: string);
 | 
|---|
| 107 |     procedure SetFldType(const Value: TTemplateFieldType);
 | 
|---|
| 108 |     procedure SetInactive(const Value: boolean);
 | 
|---|
| 109 |     procedure SetRequired(const Value: boolean);
 | 
|---|
| 110 |     procedure SetSepLines(const Value: boolean);
 | 
|---|
| 111 |     procedure SetItemDefault(const Value: string);
 | 
|---|
| 112 |     procedure SetItems(const Value: string);
 | 
|---|
| 113 |     procedure SetLMText(const Value: string);
 | 
|---|
| 114 |     procedure SetMaxLen(const Value: integer);
 | 
|---|
| 115 |     procedure SetNotes(const Value: string);
 | 
|---|
| 116 |     procedure SetID(const Value: string);
 | 
|---|
| 117 |     procedure SetIncrement(const Value: integer);
 | 
|---|
| 118 |     procedure SetIndent(const Value: integer);
 | 
|---|
| 119 |     procedure SetMaxVal(const Value: integer);
 | 
|---|
| 120 |     procedure SetMinVal(const Value: integer);
 | 
|---|
| 121 |     procedure SetPad(const Value: integer);
 | 
|---|
| 122 |     procedure SetTextLen(const Value: integer);
 | 
|---|
| 123 |     procedure SetURL(const Value: string);
 | 
|---|
| 124 |     function GetTemplateFieldDefault: string;
 | 
|---|
| 125 |     procedure CreateDialogControls(Entry: TTemplateDialogEntry;
 | 
|---|
| 126 |                                    var Index: Integer; CtrlID: integer);
 | 
|---|
| 127 |     function SaveError: string;
 | 
|---|
| 128 |     function Width: integer;
 | 
|---|
| 129 |     function GetRequired: boolean;
 | 
|---|
| 130 |     procedure SetDateType(const Value: TTmplFldDateType);
 | 
|---|
| 131 |   public
 | 
|---|
| 132 |     constructor Create(AData: TStrings);
 | 
|---|
| 133 |     destructor Destroy; override;
 | 
|---|
| 134 |     procedure Assign(AFld: TTemplateField);
 | 
|---|
| 135 |     function NewField: boolean;
 | 
|---|
| 136 |     function CanModify: boolean;
 | 
|---|
| 137 |     property ID: string read FID write SetID;
 | 
|---|
| 138 |     property FldName: string read FFldName write SetFldName;
 | 
|---|
| 139 |     property NameChanged: boolean read FNameChanged;
 | 
|---|
| 140 |     property FldType: TTemplateFieldType read FFldType write SetFldType;
 | 
|---|
| 141 |     property MaxLen: integer read FMaxLen write SetMaxLen;
 | 
|---|
| 142 |     property EditDefault: string read FEditDefault write SetEditDefault;
 | 
|---|
| 143 |     property Items: string read FItems write SetItems;
 | 
|---|
| 144 |     property ItemDefault: string read FItemDefault write SetItemDefault;
 | 
|---|
| 145 |     property LMText: string read FLMText write SetLMText;
 | 
|---|
| 146 |     property Inactive: boolean read FInactive write SetInactive;
 | 
|---|
| 147 |     property Required: boolean read GetRequired write SetRequired;
 | 
|---|
| 148 |     property SepLines: boolean read FSepLines write SetSepLines;
 | 
|---|
| 149 |     property TextLen: integer read FTextLen write SetTextLen;
 | 
|---|
| 150 |     property Indent: integer read FIndent write SetIndent;
 | 
|---|
| 151 |     property Pad: integer read FPad write SetPad;
 | 
|---|
| 152 |     property MinVal: integer read FMinVal write SetMinVal;
 | 
|---|
| 153 |     property MaxVal: integer read FMaxVal write SetMaxVal;
 | 
|---|
| 154 |     property Increment: integer read FIncrement write SetIncrement;
 | 
|---|
| 155 |     property URL: string read FURL write SetURL;
 | 
|---|
| 156 |     property DateType: TTmplFldDateType read FDateType write SetDateType;
 | 
|---|
| 157 |     property Notes: string read FNotes write SetNotes;
 | 
|---|
| 158 |     property TemplateFieldDefault: string read GetTemplateFieldDefault;
 | 
|---|
| 159 |   end;
 | 
|---|
| 160 | 
 | 
|---|
| 161 |   TIntStruc = class(TObject)
 | 
|---|
| 162 |   public
 | 
|---|
| 163 |     x: integer;
 | 
|---|
| 164 |   end;
 | 
|---|
| 165 | 
 | 
|---|
| 166 | function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
 | 
|---|
| 167 | procedure FreeEntries(SL: TStrings);
 | 
|---|
| 168 | //kt 3/26/10 --> original  procedure AssignFieldIDs(var Txt: string); overload;
 | 
|---|
| 169 | procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList=nil); overload;  //kt 3/26/10
 | 
|---|
| 170 | //kt 3/26/10 --> original procedure AssignFieldIDs(SL: TStrings); overload;
 | 
|---|
| 171 | procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList=nil); overload; //kt 3/26/10
 | 
|---|
| 172 | procedure HideFormulas(SL : TStrings; Formulas : TStringList); //kt added 3/26/10
 | 
|---|
| 173 | procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10
 | 
|---|
| 174 | //function RestoreTransformFormulas(var Txt : string; Formulas, NameToObjID : TStringList) : boolean; overload; //kt added 3/26/10
 | 
|---|
| 175 | function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; {overload; }//kt added 3/26/10
 | 
|---|
| 176 | //kt 12/28/09 originial --> function ResolveTemplateFields(Text: string; AutoWrap: boolean; Hidden: boolean = FALSE; IncludeEmbedded: boolean = FALSE): string;
 | 
|---|
| 177 | function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean;
 | 
|---|
| 178 | function ResolveTemplateFields(Text: string;
 | 
|---|
| 179 |                                AutoWrap: boolean;
 | 
|---|
| 180 |                                Hidden: boolean = FALSE;
 | 
|---|
| 181 |                                IncludeEmbedded: boolean = FALSE;
 | 
|---|
| 182 |                                HTMLMode : boolean = FALSE; //kt added 12/28/09
 | 
|---|
| 183 |                                HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
 | 
|---|
| 184 |                                HTMLAnswerCloseTag : string = '' //kt added 12/28/09
 | 
|---|
| 185 |                                ): string;
 | 
|---|
| 186 | function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList =  nil): boolean;
 | 
|---|
| 187 | function HasTemplateField(txt: string): boolean;
 | 
|---|
| 188 | 
 | 
|---|
| 189 | function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
 | 
|---|
| 190 | function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
 | 
|---|
| 191 | function SaveTemplateFieldErrors: string;
 | 
|---|
| 192 | procedure ClearModifiedTemplateFields;
 | 
|---|
| 193 | function AnyTemplateFieldsModified: boolean;
 | 
|---|
| 194 | procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
 | 
|---|
| 195 | function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
 | 
|---|
| 196 | procedure EnsureText(edt: TEdit; ud: TUpDown);
 | 
|---|
| 197 | procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
 | 
|---|
| 198 | function StripEmbedded(iItems: string): string;
 | 
|---|
| 199 | function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer; //kt added
 | 
|---|
| 200 | function FormatFormula(test: string): string;  //elh  04/09/10
 | 
|---|
| 201 | 
 | 
|---|
| 202 | type
 | 
|---|
| 203 |   TMGExtension = (tmgeFN,tmgeOBJ);
 | 
|---|
| 204 |   TMGExtMatch = record
 | 
|---|
| 205 |     Signature : string;
 | 
|---|
| 206 |     SigLen : integer;
 | 
|---|
| 207 |     EndTag : char;
 | 
|---|
| 208 |   end;
 | 
|---|
| 209 |   TMGExtArray = array[tmgeFN..tmgeOBJ] of TMGExtMatch;
 | 
|---|
| 210 | 
 | 
|---|
| 211 | const
 | 
|---|
| 212 |   TemplateFieldBeginSignature = '{FLD:';
 | 
|---|
| 213 |   TemplateFieldEndSignature = '}';
 | 
|---|
| 214 |   HTML_BEGIN_TAG = '{HTML:';                      //kt
 | 
|---|
| 215 |   HTML_ENDING_TAG = '}';                          //kt
 | 
|---|
| 216 |   HTML_BEGIN_TAGLEN = length(HTML_BEGIN_TAG);     //kt
 | 
|---|
| 217 |   HTML_ENDING_TAGLEN = length(HTML_ENDING_TAG);   //kt
 | 
|---|
| 218 |   FN_BEGIN_SIGNATURE = '{FN:';                    //kt
 | 
|---|
| 219 |   FN_BEGIN_TAG = '{';                             //kt
 | 
|---|
| 220 |   FN_END_TAG = '}';                               //kt
 | 
|---|
| 221 |   FN_BEGIN_SIGNATURE_LEN = length(FN_BEGIN_SIGNATURE);//kt
 | 
|---|
| 222 |   FN_END_TAGLEN = length(FN_END_TAG);             //kt
 | 
|---|
| 223 |   FN_SHOW_TEXT = '{%_____%-#';                    //kt
 | 
|---|
| 224 |   FN_SHOW_TEXT_END = '}';                         //kt
 | 
|---|
| 225 |   FN_SHOW_TEXT_LEN = length(FN_SHOW_TEXT);        //kt
 | 
|---|
| 226 |   FN_SHOW_TEXT_END_LEN = length(FN_SHOW_TEXT_END);//kt
 | 
|---|
| 227 |   FN_FIELD_TAG = '[FLD:';                         //kt
 | 
|---|
| 228 |   FN_FIELD_TAG_LEN = length(FN_FIELD_TAG);        //kt
 | 
|---|
| 229 |   FN_OBJ_TAG = '[OBJ:';                           //kt
 | 
|---|
| 230 |   FN_OBJ_TAG_LEN = length(FN_OBJ_TAG);            //kt
 | 
|---|
| 231 |   FLD_OBJ_SIGNATURE = '{OBJ:';                    //kt
 | 
|---|
| 232 |   FLD_OBJ_END_TAG = '}';                          //kt
 | 
|---|
| 233 |   FLD_OBJ_SIG_LEN = length(FLD_OBJ_SIGNATURE);    //kt
 | 
|---|
| 234 |   OBJ_SHOW_TEXT = '{OBJ%_____%-#';                //kt
 | 
|---|
| 235 |   OBJ_SHOW_TEXT_END = '}';                        //kt
 | 
|---|
| 236 |   OBJ_SHOW_TEXT_LEN = length(OBJ_SHOW_TEXT);      //kt
 | 
|---|
| 237 |   TMG_MATCH : TMGExtArray =
 | 
|---|
| 238 |    (  (Signature : FN_BEGIN_SIGNATURE;
 | 
|---|
| 239 |        SigLen    : FN_BEGIN_SIGNATURE_LEN;
 | 
|---|
| 240 |        EndTag    : FN_END_TAG),
 | 
|---|
| 241 | 
 | 
|---|
| 242 |       (Signature : FLD_OBJ_SIGNATURE;
 | 
|---|
| 243 |        SigLen    : FLD_OBJ_SIG_LEN;
 | 
|---|
| 244 |        EndTag    : FLD_OBJ_END_TAG)
 | 
|---|
| 245 |    );
 | 
|---|
| 246 | 
 | 
|---|
| 247 | 
 | 
|---|
| 248 |   //MissingFieldsTxt = 'One or more required fields must still be entered.';  <-- original line.  //kt 8/8/2007
 | 
|---|
| 249 |   function MissingFieldsTxt : string;  //kt added
 | 
|---|
| 250 | 
 | 
|---|
| 251 | Const
 | 
|---|
| 252 |   TemplateFieldTypeCodes: array[TTemplateFieldType] of string[1] =
 | 
|---|
| 253 |                          {  dftUnknown      } ('',
 | 
|---|
| 254 |                          {  dftEditBox      }  'E',
 | 
|---|
| 255 |                          {  dftComboBox     }  'C',
 | 
|---|
| 256 |                          {  dftButton       }  'B',
 | 
|---|
| 257 |                          {  dftCheckBoxes   }  'X',
 | 
|---|
| 258 |                          {  dftRadioButtons }  'R',
 | 
|---|
| 259 |                          {  dftDate         }  'D',
 | 
|---|
| 260 |                          {  dftNumber       }  'N',
 | 
|---|
| 261 |                          {  dftHyperlink    }  'H',
 | 
|---|
| 262 |                          {  dftWP           }  'W',
 | 
|---|
| 263 |                          {  dftText         }  'T');
 | 
|---|
| 264 | 
 | 
|---|
| 265 | function TemplateFieldTypeDesc(index: TTemplateFieldType; short : boolean) : string;
 | 
|---|
| 266 | (* //kt replaced with function below
 | 
|---|
| 267 |   TemplateFieldTypeDesc: array[TTemplateFieldType, boolean] of string =
 | 
|---|
| 268 |                          {  dftUnknown      } (('',''),
 | 
|---|
| 269 |                          {  dftEditBox      }  ('Edit Box',       'Edit'),
 | 
|---|
| 270 |                          {  dftComboBox     }  ('Combo Box',      'Combo'),
 | 
|---|
| 271 |                          {  dftButton       }  ('Button',         'Button'),
 | 
|---|
| 272 |                          {  dftCheckBoxes   }  ('Check Boxes',    'Check'),
 | 
|---|
| 273 |                          {  dftRadioButtons }  ('Radio Buttons',  'Radio'),
 | 
|---|
| 274 |                          {  dftDate         }  ('Date',           'Date'),
 | 
|---|
| 275 |                          {  dftNumber       }  ('Number',         'Num'),
 | 
|---|
| 276 |                          {  dftHyperlink    }  ('Hyperlink',      'Link'),
 | 
|---|
| 277 |                          {  dftWP           }  ('Word Processing','WP'),
 | 
|---|
| 278 |                          {  dftWP           }  ('Display Text',   'Text'));
 | 
|---|
| 279 | *)
 | 
|---|
| 280 | 
 | 
|---|
| 281 | function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
 | 
|---|
| 282 | (*  //kt replaced with function below
 | 
|---|
| 283 |   TemplateDateTypeDesc: array[TTmplFldDateType, boolean] of string =
 | 
|---|
| 284 |                          { dtUnknown        } (('',''),
 | 
|---|
| 285 | //                       { dtDate           }  ('Date',           'Date'),  <-- original line.  //kt 8/8/2007
 | 
|---|
| 286 | //                       { dtDateTime       }  ('Date & Time',    'Time'),  <-- original line.  //kt 8/8/2007
 | 
|---|
| 287 | //                       { dtDateReqTime    }  ('Date & Req Time','R.Time'),  <-- original line.  //kt 8/8/2007
 | 
|---|
| 288 | //                       { dtCombo          }  ('Date Combo',     'C.Date'),  <-- original line.  //kt 8/8/2007
 | 
|---|
| 289 | //                       { dtYear           }  ('Year',           'Year'),  <-- original line.  //kt 8/8/2007
 | 
|---|
| 290 | //                       { dtYearMonth      }  ('Year & Month',   'Month'));  <-- original line.  //kt 8/8/2007
 | 
|---|
| 291 | *)
 | 
|---|
| 292 | 
 | 
|---|
| 293 | Const
 | 
|---|
| 294 |   FldNames: array[TTemplateFieldType] of string =
 | 
|---|
| 295 |                    { dftUnknown      }  ('',
 | 
|---|
| 296 |                    { dftEditBox      }  'EDIT',
 | 
|---|
| 297 |                    { dftComboBox     }  'LIST',
 | 
|---|
| 298 |                    { dftButton       }  'BTTN',
 | 
|---|
| 299 |                    { dftCheckBoxes   }  'CBOX',
 | 
|---|
| 300 |                    { dftRadioButtons }  'RBTN',
 | 
|---|
| 301 |                    { dftDate         }  'DATE',
 | 
|---|
| 302 |                    { dftNumber       }  'NUMB',
 | 
|---|
| 303 |                    { dftHyperlink    }  'LINK',
 | 
|---|
| 304 |                    { dftWP           }  'WRDP',
 | 
|---|
| 305 |                    { dftTExt         }  'TEXT');
 | 
|---|
| 306 | 
 | 
|---|
| 307 |   TemplateFieldDateCodes: array[TTmplFldDateType] of string[1] =
 | 
|---|
| 308 |                          { dtUnknown        } ('',
 | 
|---|
| 309 |                          { dtDate           }  'D',
 | 
|---|
| 310 |                          { dtDateTime       }  'T',
 | 
|---|
| 311 |                          { dtDateReqTime    }  'R',
 | 
|---|
| 312 |                          { dtCombo          }  'C',
 | 
|---|
| 313 |                          { dtYear           }  'Y',
 | 
|---|
| 314 |                          { dtYearMonth      }  'M');
 | 
|---|
| 315 | 
 | 
|---|
| 316 |   MaxTFWPLines = 20;
 | 
|---|
| 317 |   MaxTFEdtLen = 70;
 | 
|---|
| 318 | 
 | 
|---|
| 319 | type
 | 
|---|
| 320 |   TFieldPanel = class(TPanel)  {This is the panel associated with the child}
 | 
|---|
| 321 |   private                      {dialog checkboxes in reminders dialogs}
 | 
|---|
| 322 |     FOnDestroy: TNotifyEvent;
 | 
|---|
| 323 |     FCanvas: TControlCanvas;    {used to draw focus rect}
 | 
|---|
| 324 |     function GetFocus: boolean;
 | 
|---|
| 325 |     procedure SetTheFocus(const Value: boolean);
 | 
|---|
| 326 |   protected                     {used to draw focus rect}
 | 
|---|
| 327 |     procedure Paint; override;  {used to draw focus rect}
 | 
|---|
| 328 |   public
 | 
|---|
| 329 |     destructor Destroy; override;
 | 
|---|
| 330 |     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
 | 
|---|
| 331 |     property Focus:  boolean read GetFocus write SetTheFocus; {to draw focus rect}
 | 
|---|
| 332 |     property OnKeyPress;        {to click the checkbox when spacebar is pressed}
 | 
|---|
| 333 |   end;
 | 
|---|
| 334 | 
 | 
|---|
| 335 | implementation
 | 
|---|
| 336 | 
 | 
|---|
| 337 | uses
 | 
|---|
| 338 |   ORFn, rTemplates, ORCtrls, mTemplateFieldButton, dShared, uConst, uCore, rCore, Windows,
 | 
|---|
| 339 |   ORNet,  //kt
 | 
|---|
| 340 |   TRPCB, //kt
 | 
|---|
| 341 |   DKLang; //kt
 | 
|---|
| 342 | 
 | 
|---|
| 343 | const
 | 
|---|
| 344 |   NewTemplateField = 'NEW TEMPLATE FIELD';
 | 
|---|
| 345 |   TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
 | 
|---|
| 346 |   TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
 | 
|---|
| 347 | 
 | 
|---|
| 348 | var
 | 
|---|
| 349 |   uTmplFlds: TList = nil;
 | 
|---|
| 350 |   uEntries: TStringList = nil;
 | 
|---|
| 351 | 
 | 
|---|
| 352 |   uNewTemplateFieldIDCnt: longint = 0;
 | 
|---|
| 353 |   uRadioGroupIndex: integer = 0;
 | 
|---|
| 354 | 
 | 
|---|
| 355 |   uInternalFieldIDCount: integer = 0;
 | 
|---|
| 356 |   uInternalFormulaCount: integer = 0;  //kt
 | 
|---|
| 357 |   uInternalTxtObjCount : integer = 0; //kt
 | 
|---|
| 358 | 
 | 
|---|
| 359 | const
 | 
|---|
| 360 |   FieldIDDelim = '`';
 | 
|---|
| 361 |   FieldIDLen = 6;
 | 
|---|
| 362 |   NewLine = 'NL';
 | 
|---|
| 363 | 
 | 
|---|
| 364 | type
 | 
|---|
| 365 |   TFieldLabel = class(TLabel)
 | 
|---|
| 366 |   private
 | 
|---|
| 367 |     FExclude: boolean;
 | 
|---|
| 368 |   public
 | 
|---|
| 369 |     property Exclude: boolean read FExclude;
 | 
|---|
| 370 |   end;
 | 
|---|
| 371 | 
 | 
|---|
| 372 |   TWebLabel = class(TFieldLabel)
 | 
|---|
| 373 |   private
 | 
|---|
| 374 |     FAddr: string;
 | 
|---|
| 375 |     procedure Clicked(Sender: TObject);
 | 
|---|
| 376 |   public
 | 
|---|
| 377 |     procedure Init(Addr: string);
 | 
|---|
| 378 |   end;
 | 
|---|
| 379 | 
 | 
|---|
| 380 | function MissingFieldsTxt : string;
 | 
|---|
| 381 | begin Result := DKLangConstW('uTemplateFields_One_or_more_required_fields_must_still_be_enteredx');
 | 
|---|
| 382 | end;
 | 
|---|
| 383 | 
 | 
|---|
| 384 | //kt  8-17-07  Added to replace constant with function
 | 
|---|
| 385 | function TemplateFieldTypeDesc(index: TTemplateFieldType; Short : boolean) : string;
 | 
|---|
| 386 | begin
 | 
|---|
| 387 |   Result := '';
 | 
|---|
| 388 |   case index of
 | 
|---|
| 389 |     dftUnknown      : Result := '';
 | 
|---|
| 390 |     dftEditBox      : if not Short then Result := DKLangConstW('uTemplateFields_Edit_Box')        else Result := DKLangConstW('uTemplateFields_Edit');
 | 
|---|
| 391 |     dftComboBox     : if not Short then Result := DKLangConstW('uTemplateFields_Combo_Box')       else Result := DKLangConstW('uTemplateFields_Combo');
 | 
|---|
| 392 |     dftButton       : if not Short then Result := DKLangConstW('uTemplateFields_Button')          else Result := DKLangConstW('uTemplateFields_Button');
 | 
|---|
| 393 |     dftCheckBoxes   : if not Short then Result := DKLangConstW('uTemplateFields_Check_Boxes')     else Result := DKLangConstW('uTemplateFields_Check');
 | 
|---|
| 394 |     dftRadioButtons : if not Short then Result := DKLangConstW('uTemplateFields_Radio_Buttons')   else Result := DKLangConstW('uTemplateFields_Radio');
 | 
|---|
| 395 |     dftDate         : if not Short then Result := DKLangConstW('uTemplateFields_Date')            else Result := DKLangConstW('uTemplateFields_Date');
 | 
|---|
| 396 |     dftNumber       : if not Short then Result := DKLangConstW('uTemplateFields_Number')          else Result := DKLangConstW('uTemplateFields_Num');
 | 
|---|
| 397 |     dftHyperlink    : if not Short then Result := DKLangConstW('uTemplateFields_Hyperlink')       else Result := DKLangConstW('uTemplateFields_Link');
 | 
|---|
| 398 |     dftWP           : if not Short then Result := DKLangConstW('uTemplateFields_Word_Processing') else Result := DKLangConstW('uTemplateFields_WP');
 | 
|---|
| 399 |     dftText         : if not Short then Result := DKLangConstW('uTemplateFields_Display_Text')    else Result := DKLangConstW('uTemplateFields_Text');
 | 
|---|
| 400 |   end; {case}
 | 
|---|
| 401 | end;
 | 
|---|
| 402 | 
 | 
|---|
| 403 | //kt  8-17-07  Added to replace constant with function
 | 
|---|
| 404 | function TemplateDateTypeDesc(index: TTmplFldDateType; Short : boolean) : string;
 | 
|---|
| 405 | begin
 | 
|---|
| 406 |   Result := '';
 | 
|---|
| 407 |   case index of
 | 
|---|
| 408 |     dtUnknown        : Result := '';
 | 
|---|
| 409 |     dtDate           : if not Short then Result := DKLangConstW('uTemplateFields_Date')            else Result := DKLangConstW('uTemplateFields_Date');
 | 
|---|
| 410 |     dtDateTime       : if not Short then Result := DKLangConstW('uTemplateFields_Date_x_Time')     else Result := DKLangConstW('uTemplateFields_Time');
 | 
|---|
| 411 |     dtDateReqTime    : if not Short then Result := DKLangConstW('uTemplateFields_Date_x_Req_Time') else Result := DKLangConstW('uTemplateFields_RxTime');
 | 
|---|
| 412 |     dtCombo          : if not Short then Result := DKLangConstW('uTemplateFields_Date_Combo')      else Result := DKLangConstW('uTemplateFields_CxDate');
 | 
|---|
| 413 |     dtYear           : if not Short then Result := DKLangConstW('uTemplateFields_Year')            else Result := DKLangConstW('uTemplateFields_Year');
 | 
|---|
| 414 |     dtYearMonth      : if not Short then Result := DKLangConstW('uTemplateFields_Year_x_Month')    else Result := DKLangConstW('uTemplateFields_Month');
 | 
|---|
| 415 |   end; {case}
 | 
|---|
| 416 | end;
 | 
|---|
| 417 | 
 | 
|---|
| 418 | function GetNewFieldID: string;
 | 
|---|
| 419 | begin
 | 
|---|
| 420 |   inc(uInternalFieldIDCount);
 | 
|---|
| 421 |   Result := IntToStr(uInternalFieldIDCount);
 | 
|---|
| 422 |   Result := FieldIDDelim +
 | 
|---|
| 423 |             copy(StringOfChar('0', FieldIDLen-2) + Result, length(Result), FieldIDLen-1);
 | 
|---|
| 424 | end;
 | 
|---|
| 425 | 
 | 
|---|
| 426 | function GetDialogEntry(AParent: TWinControl; AID, AText: string): TTemplateDialogEntry;
 | 
|---|
| 427 | var
 | 
|---|
| 428 |   idx: integer;
 | 
|---|
| 429 | 
 | 
|---|
| 430 | begin
 | 
|---|
| 431 |   Result := nil;
 | 
|---|
| 432 |   if AID = '' then exit;
 | 
|---|
| 433 |   if(not assigned(uEntries)) then
 | 
|---|
| 434 |     uEntries := TStringList.Create;
 | 
|---|
| 435 |   idx := uEntries.IndexOf(AID);
 | 
|---|
| 436 |   if(idx < 0) then
 | 
|---|
| 437 |   begin
 | 
|---|
| 438 |     Result := TTemplateDialogEntry.Create(AParent, AID, AText);
 | 
|---|
| 439 |     uEntries.AddObject(AID, Result);
 | 
|---|
| 440 |   end
 | 
|---|
| 441 |   else
 | 
|---|
| 442 |     Result := TTemplateDialogEntry(uEntries.Objects[idx]);
 | 
|---|
| 443 | end;
 | 
|---|
| 444 | 
 | 
|---|
| 445 | procedure FreeEntries(SL: TStrings);
 | 
|---|
| 446 | var
 | 
|---|
| 447 |   i, idx, cnt: integer;
 | 
|---|
| 448 | 
 | 
|---|
| 449 | begin
 | 
|---|
| 450 |   if(assigned(uEntries)) then
 | 
|---|
| 451 |   begin
 | 
|---|
| 452 |     for i := SL.Count-1 downto 0 do
 | 
|---|
| 453 |     begin
 | 
|---|
| 454 |       idx := uEntries.IndexOf(SL[i]);
 | 
|---|
| 455 |       if(idx >= 0) then
 | 
|---|
| 456 |       begin
 | 
|---|
| 457 |         cnt := uEntries.Count;
 | 
|---|
| 458 |         if(assigned(uEntries.Objects[idx])) then
 | 
|---|
| 459 |         begin
 | 
|---|
| 460 |           TTemplateDialogEntry(uEntries.Objects[idx]).AutoDestroyOnPanelFree := FALSE;
 | 
|---|
| 461 |           uEntries.Objects[idx].Free;
 | 
|---|
| 462 |         end;
 | 
|---|
| 463 |         if cnt = uEntries.Count then
 | 
|---|
| 464 |           uEntries.Delete(idx);
 | 
|---|
| 465 |       end;
 | 
|---|
| 466 |     end;
 | 
|---|
| 467 |     if(uEntries.Count = 0) then
 | 
|---|
| 468 |       uInternalFieldIDCount := 0;
 | 
|---|
| 469 |       uInternalFormulaCount := 0; //kt
 | 
|---|
| 470 |       uInternalTxtObjCount := 0; //kt
 | 
|---|
| 471 |   end;
 | 
|---|
| 472 | end;
 | 
|---|
| 473 | 
 | 
|---|
| 474 | //kt original line --> procedure AssignFieldIDs(var Txt: string);
 | 
|---|
| 475 | procedure AssignFieldIDs(var Txt: string; NameToObjID : TStringList); //kt
 | 
|---|
| 476 | var
 | 
|---|
| 477 |   i: integer;
 | 
|---|
| 478 |   p2 : integer; //kt
 | 
|---|
| 479 |   FldName : string; //kt
 | 
|---|
| 480 |   FldID : string; //kt
 | 
|---|
| 481 | 
 | 
|---|
| 482 | begin
 | 
|---|
| 483 |   i := 0;
 | 
|---|
| 484 |   while (i < length(Txt)) do begin
 | 
|---|
| 485 |     inc(i);
 | 
|---|
| 486 |     if copy(Txt,i,TemplateFieldSignatureLen) = TemplateFieldBeginSignature then begin
 | 
|---|
| 487 |       inc(i,TemplateFieldSignatureLen);
 | 
|---|
| 488 |       if(i < length(Txt)) and (copy(Txt,i,1) <> FieldIDDelim) then begin
 | 
|---|
| 489 |         p2 := PosEx(TemplateFieldEndSignature,Txt,i);           //kt
 | 
|---|
| 490 |         FldName := '';                                          //kt
 | 
|---|
| 491 |         if p2 > 0 then FldName := Trim(copy(Txt,i,(p2-i)));  //kt
 | 
|---|
| 492 |         insert(GetNewFieldID, Txt, i);
 | 
|---|
| 493 |         inc(i, FieldIDLen);
 | 
|---|
| 494 |         if (FldName <> '') and Assigned(NameToObjID) then begin                                      //kt
 | 
|---|
| 495 |           NameToObjID.AddObject(FldName,Pointer(uInternalFieldIDCount)); //kt
 | 
|---|
| 496 |         end;                                                             //kt
 | 
|---|
| 497 |       end;
 | 
|---|
| 498 |     end;
 | 
|---|
| 499 |   end;
 | 
|---|
| 500 | end;
 | 
|---|
| 501 | 
 | 
|---|
| 502 | procedure AssignFieldIDs(SL: TStrings; NameToObjID : TStringList);
 | 
|---|
| 503 | var
 | 
|---|
| 504 |   i: integer;
 | 
|---|
| 505 |   txt: string;
 | 
|---|
| 506 | 
 | 
|---|
| 507 | begin
 | 
|---|
| 508 |   for i := 0 to SL.Count-1 do
 | 
|---|
| 509 |   begin
 | 
|---|
| 510 |     txt := SL[i];
 | 
|---|
| 511 |     //kt AssignFieldIDs(txt);
 | 
|---|
| 512 |     AssignFieldIDs(txt, NameToObjID); //kt
 | 
|---|
| 513 |     SL[i] := txt;
 | 
|---|
| 514 |   end;
 | 
|---|
| 515 | end;
 | 
|---|
| 516 | 
 | 
|---|
| 517 | function CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer;
 | 
|---|
| 518 | //kt added function
 | 
|---|
| 519 | //Return the position of a closing character, ignoring all intervening nested open and close chars
 | 
|---|
| 520 | //NOTE: It is expected that StartingPos is pointing to the first opening character.
 | 
|---|
| 521 | var i : integer;
 | 
|---|
| 522 |     CloseMatchesNeeded : integer;
 | 
|---|
| 523 | begin
 | 
|---|
| 524 |   Result := 0;
 | 
|---|
| 525 |   CloseMatchesNeeded := 1;
 | 
|---|
| 526 |   for i := StartingPos to Length(Txt) do begin
 | 
|---|
| 527 |     if (Txt[i] = OpenChar) and (i <> StartingPos) then Inc(CloseMatchesNeeded);
 | 
|---|
| 528 |     if Txt[i] = CloseChar then Dec(CloseMatchesNeeded);
 | 
|---|
| 529 |     if CloseMatchesNeeded = 0 then begin
 | 
|---|
| 530 |       Result := i;
 | 
|---|
| 531 |       break;
 | 
|---|
| 532 |     end;
 | 
|---|
| 533 |   end;
 | 
|---|
| 534 | end;
 | 
|---|
| 535 | 
 | 
|---|
| 536 | 
 | 
|---|
| 537 | procedure HideFormulas(SL : TStrings; Formulas : TStringList);
 | 
|---|
| 538 | //kt added function
 | 
|---|
| 539 | //NOTE: formulas will not be allowed to use the '}' character
 | 
|---|
| 540 | var p1,p2 : integer;
 | 
|---|
| 541 |     FnStr : string;
 | 
|---|
| 542 |     SubStrA,SubStrB : string;
 | 
|---|
| 543 |     Txt : String;
 | 
|---|
| 544 | begin
 | 
|---|
| 545 |   Txt := SL.Text;
 | 
|---|
| 546 |   p1 := Pos(FN_BEGIN_SIGNATURE,Txt);
 | 
|---|
| 547 |   while (p1>0) do begin
 | 
|---|
| 548 |     SubStrA := MidStr(Txt,1,p1-1);
 | 
|---|
| 549 |     p1 := p1 + FN_BEGIN_SIGNATURE_LEN;
 | 
|---|
| 550 |     //p2 := PosEx(FN_END_TAG,Txt,p1);
 | 
|---|
| 551 |     p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1);
 | 
|---|
| 552 |     SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1);    //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box   elh  04/08/10
 | 
|---|
| 553 |     FnStr := MidStr(Txt,p1, (p2-p1));
 | 
|---|
| 554 |     FnStr := AnsiReplaceText(FnStr,#9,'');
 | 
|---|
| 555 |     FnStr := AnsiReplaceText(FnStr,#10,'');
 | 
|---|
| 556 |     FnStr := AnsiReplaceText(FnStr,#13,'');
 | 
|---|
| 557 |     //FnStr := AnsiReplaceText(FnStr,' ','');
 | 
|---|
| 558 |     inc(uInternalFormulaCount);
 | 
|---|
| 559 |     Formulas.AddObject(FnStr,Pointer(uInternalFormulaCount));
 | 
|---|
| 560 |     Txt := SubStrA + FN_SHOW_TEXT + IntToStr(uInternalFormulaCount) + FN_SHOW_TEXT_END + SubStrB;
 | 
|---|
| 561 |     p1 := PosEx(FN_BEGIN_SIGNATURE,Txt,p1);
 | 
|---|
| 562 |   end;
 | 
|---|
| 563 |   SL.Text := Txt;
 | 
|---|
| 564 | end;
 | 
|---|
| 565 | 
 | 
|---|
| 566 | procedure HideTxtObjects(SL : TStrings; TxtObjects : TStringList); //kt added 3/28/10
 | 
|---|
| 567 | //kt added function
 | 
|---|
| 568 | var p1,p2 : integer;
 | 
|---|
| 569 |     FnStr : string;
 | 
|---|
| 570 |     SubStrA,SubStrB : string;
 | 
|---|
| 571 |     Txt : String;
 | 
|---|
| 572 | begin
 | 
|---|
| 573 |   Txt := SL.Text;
 | 
|---|
| 574 |   p1 := Pos(FLD_OBJ_SIGNATURE,Txt);
 | 
|---|
| 575 |   while (p1>0) do begin
 | 
|---|
| 576 |     SubStrA := MidStr(Txt,1,p1-1);
 | 
|---|
| 577 |     p1 := p1 + FN_OBJ_TAG_LEN;
 | 
|---|
| 578 |     p2 := CloseCharPos(FN_BEGIN_TAG, FN_END_TAG, Txt, p1);
 | 
|---|
| 579 |     SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1);  //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box   elh  04/13/10
 | 
|---|
| 580 |     FnStr := MidStr(Txt,p1, (p2-p1));
 | 
|---|
| 581 |     FnStr := AnsiReplaceText(FnStr,#9,'');
 | 
|---|
| 582 |     FnStr := AnsiReplaceText(FnStr,#10,'');
 | 
|---|
| 583 |     FnStr := AnsiReplaceText(FnStr,#13,'');
 | 
|---|
| 584 |     inc(uInternalTxtObjCount);
 | 
|---|
| 585 |     TxtObjects.AddObject(FnStr,Pointer(uInternalTxtObjCount));
 | 
|---|
| 586 |     Txt := SubStrA + OBJ_SHOW_TEXT + IntToStr(uInternalTxtObjCount) + OBJ_SHOW_TEXT_END + SubStrB;
 | 
|---|
| 587 |     p1 := PosEx(FLD_OBJ_SIGNATURE,Txt,p1);
 | 
|---|
| 588 |   end;
 | 
|---|
| 589 |   SL.Text := Txt;
 | 
|---|
| 590 | end;
 | 
|---|
| 591 | 
 | 
|---|
| 592 | function InsideMarkers(var S : string; MarkerCh : char; P : integer) : boolean;
 | 
|---|
| 593 | //Function returns if position P is inside characters MarkerCh.
 | 
|---|
| 594 | //e.g. S =  'xxx|xxxxx|xxxxx'  MarkerCh='|'
 | 
|---|
| 595 | //     P = 2  ==> result is false
 | 
|---|
| 596 | //     P = 5  ==> result is true
 | 
|---|
| 597 | //     P = 12 ==> result is false
 | 
|---|
| 598 | 
 | 
|---|
| 599 | var p1,p2 : integer;
 | 
|---|
| 600 |     Inside : boolean;
 | 
|---|
| 601 | begin
 | 
|---|
| 602 |   Inside := false;
 | 
|---|
| 603 |   p1 := Pos(MarkerCh,S);
 | 
|---|
| 604 |   while (p1 > 0) do begin
 | 
|---|
| 605 |     if (p1 >= P) then break;
 | 
|---|
| 606 |     p1 := PosEx(MarkerCh,S,p1+1);
 | 
|---|
| 607 |     if (p1 > 0) and (p1 > P) then Inside := not Inside;
 | 
|---|
| 608 |   end;
 | 
|---|
| 609 |   Result := Inside;
 | 
|---|
| 610 | end;
 | 
|---|
| 611 | 
 | 
|---|
| 612 | function SubstuteIDs(Txt : string; NameToObjID : TStringList) : string;
 | 
|---|
| 613 | //kt added function
 | 
|---|
| 614 | //Prefix any field names with their FldID's, in format of FieldIDDelim+FldID
 | 
|---|
| 615 | // E.g. [FLD:1:NUM1-16] --> `00001NUM1-16`
 | 
|---|
| 616 | //Note: Field ID's are started with character FieldIDDelim, and are of a fixed length (FieldIDLen)
 | 
|---|
| 617 | 
 | 
|---|
| 618 | (*  Syntax examples:
 | 
|---|
| 619 | 
 | 
|---|
| 620 |  {FN:[FLD:1:NUMB1-16]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
 | 
|---|
| 621 |  {FN:[OBJ:TABLE1]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
 | 
|---|
| 622 |  {FN:[OBJ:TABLE2("POTASSIUM")]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}, or
 | 
|---|
| 623 |  {FN:[OBJ:TABLE2([FLD:1:NUMB1-16])]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}
 | 
|---|
| 624 |  {FN:[OBJ:TABLE2((5+3)/2)]-[FLD:2:NUMB1-16]-[FLD:3:NUMB1-16]}
 | 
|---|
| 625 |  (arbitrary deep nesting)
 | 
|---|
| 626 |  Note: arguments should be round by matching [ ]'s
 | 
|---|
| 627 |        An argument will start with a TYPE (so far, FLD or OBJ) and ':'
 | 
|---|
| 628 | 
 | 
|---|
| 629 |        If TYPE is FLD, there will be :number:, with number being same
 | 
|---|
| 630 |        as number in old format (i.e. ...]#2).
 | 
|---|
| 631 |        If number not provided, then default value is 1
 | 
|---|
| 632 | 
 | 
|---|
| 633 |        If TYPE is OBJ, then this indicates that the parameter name (e.g. TABLE) is
 | 
|---|
| 634 |        the name of a TIU TEXT object, that will be processed on the server.
 | 
|---|
| 635 |        Parameters should be resolved before passing to the server.
 | 
|---|
| 636 | *)
 | 
|---|
| 637 | 
 | 
|---|
| 638 | var i,j,p1,p2 : integer;
 | 
|---|
| 639 |     SubStrA,SubStrB, NumStr : string;
 | 
|---|
| 640 |     FldIDNum,CountofSimilar : integer;
 | 
|---|
| 641 |     FldIDNumStr : string;
 | 
|---|
| 642 |     CountOfSimStr : string;
 | 
|---|
| 643 |     Temp,FldName : string;
 | 
|---|
| 644 |     Skip : boolean;
 | 
|---|
| 645 | begin
 | 
|---|
| 646 |   for i := 0 to NameToObjID.Count-1 do begin
 | 
|---|
| 647 |     CountofSimilar := 0;
 | 
|---|
| 648 |     FldName := NameToObjID.Strings[i];
 | 
|---|
| 649 |     for j := 0 to i do begin
 | 
|---|
| 650 |       if NameToObjID.Strings[j] = FldName then inc(CountofSimilar);     //Changed from i to j  elh  04/08/10
 | 
|---|
| 651 |     end;
 | 
|---|
| 652 |     CountOfSimStr := IntToStr(CountofSimilar);
 | 
|---|
| 653 |     FldIDNum := Integer(NameToObjID.Objects[i]);
 | 
|---|
| 654 |     FldIDNumStr := IntToStr(FldIDNum);
 | 
|---|
| 655 |     FldIDNumStr := FieldIDDelim + StringOfChar('0', FieldIDLen-1-Length(FldIDNumStr)) + FldIDNumStr;
 | 
|---|
| 656 |     p1 := 1;
 | 
|---|
| 657 |     p1 := PosEx(FldName,Txt,p1);
 | 
|---|
| 658 |     while InsideMarkers(Txt, FieldIDDelim, p1) do begin //Ignore included fieldnames from prior cycle.
 | 
|---|
| 659 |       p2 := PosEx(FieldIDDelim,Txt,p1+1);
 | 
|---|
| 660 |       if p2 >0 then begin
 | 
|---|
| 661 |          p1 := p2+1;
 | 
|---|
| 662 |          p1 := PosEx(FldName,Txt,p1);
 | 
|---|
| 663 |       end else p1 := 999;  //error condition.
 | 
|---|
| 664 |     end;
 | 
|---|
| 665 |     while (p1>0) and (p1 < 999) do begin
 | 
|---|
| 666 |       Skip := false;
 | 
|---|
| 667 |       SubStrA := MidStr(Txt,1,p1-1);
 | 
|---|
| 668 |       SubStrB := MidStr(Txt, p1+Length(FldName), 999);
 | 
|---|
| 669 |       if (LeftStr(SubStrB,1)=']') and (Pos(FN_FIELD_TAG,SubStrA) > 0) then begin
 | 
|---|
| 670 |         NumStr := piece(RightStr(SubStrA,7),':',2);
 | 
|---|
| 671 |         SubStrA := LeftStr(SubStrA,Length(SubStrA)-7);
 | 
|---|
| 672 |         p2 := 2;
 | 
|---|
| 673 |         SubStrB := MidStr(SubStrB,p2,999);
 | 
|---|
| 674 |         if NumStr <> CountOfSimStr then begin
 | 
|---|
| 675 |           Skip := true;
 | 
|---|
| 676 |           Inc(p1);
 | 
|---|
| 677 |         end;
 | 
|---|
| 678 |       end else begin
 | 
|---|
| 679 |          Skip := true;
 | 
|---|
| 680 |          Inc(p1);
 | 
|---|
| 681 |       end;
 | 
|---|
| 682 |       if not Skip then begin
 | 
|---|
| 683 |         Txt := SubStrA + FldIDNumStr +FldName + FieldIDDelim;
 | 
|---|
| 684 |         p1 := Length(Txt);
 | 
|---|
| 685 |         Txt := Txt + SubStrB;
 | 
|---|
| 686 |       end;
 | 
|---|
| 687 |       p1 := PosEx(FldName,Txt,p1);
 | 
|---|
| 688 |     end;
 | 
|---|
| 689 |   end;
 | 
|---|
| 690 |   Result := Txt;
 | 
|---|
| 691 | end;
 | 
|---|
| 692 | 
 | 
|---|
| 693 | 
 | 
|---|
| 694 | function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean;
 | 
|---|
| 695 | //kt added 3/26/10
 | 
|---|
| 696 | //Returns if any changes made
 | 
|---|
| 697 | //Replace formula text back in, and change field names into FldID's
 | 
|---|
| 698 | 
 | 
|---|
| 699 |   function GetFormula(NumStr : string) : string;
 | 
|---|
| 700 |   //Return formula text based on provided index number of formula
 | 
|---|
| 701 |   var num, i : integer;
 | 
|---|
| 702 |       PtrNum : Pointer;
 | 
|---|
| 703 |   begin
 | 
|---|
| 704 |     Result := '';
 | 
|---|
| 705 |     try
 | 
|---|
| 706 |       Num := StrToInt(NumStr);
 | 
|---|
| 707 |       PtrNum := Pointer(Num);
 | 
|---|
| 708 |       for i := 0 to Formulas.Count-1 do begin
 | 
|---|
| 709 |         if Formulas.Objects[i] = PtrNum then begin
 | 
|---|
| 710 |           Result := Formulas.Strings[i];
 | 
|---|
| 711 |           break;
 | 
|---|
| 712 |         end;
 | 
|---|
| 713 |       end;
 | 
|---|
| 714 |     except
 | 
|---|
| 715 |       on EConvertError do Result := '??';
 | 
|---|
| 716 |     end;
 | 
|---|
| 717 |   end;
 | 
|---|
| 718 | 
 | 
|---|
| 719 | var p1,p2 : integer;
 | 
|---|
| 720 |     count : integer;
 | 
|---|
| 721 |     FnStr : string;
 | 
|---|
| 722 |     Txt : string;
 | 
|---|
| 723 |     SubStrA,SubStrB : string;
 | 
|---|
| 724 | begin
 | 
|---|
| 725 |   Txt := SL.Text;
 | 
|---|
| 726 |   Result := false;
 | 
|---|
| 727 |   p1 := Pos(FN_SHOW_TEXT,Txt);
 | 
|---|
| 728 |   while (p1>0) do begin
 | 
|---|
| 729 |     SubStrA := MidStr(Txt,1,p1-1);
 | 
|---|
| 730 |     p1 := p1 + FN_SHOW_TEXT_LEN;
 | 
|---|
| 731 |     p2 := PosEx(FN_SHOW_TEXT_END,Txt,p1);
 | 
|---|
| 732 |     SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1);   //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box   elh  04/13/10
 | 
|---|
| 733 |     FnStr := MidStr(Txt,p1, (p2-p1));
 | 
|---|
| 734 |     FnStr := GetFormula(FnStr);
 | 
|---|
| 735 |     FnStr := SubstuteIDs(FnStr,NameToObjID);
 | 
|---|
| 736 |     Txt := SubStrA + FN_BEGIN_SIGNATURE + FnStr + FN_END_TAG + SubStrB;
 | 
|---|
| 737 |     Result := true;
 | 
|---|
| 738 |     p1 := PosEx(FN_SHOW_TEXT,Txt,p1);
 | 
|---|
| 739 |   end;
 | 
|---|
| 740 |   SL.Text := Txt;
 | 
|---|
| 741 | end;
 | 
|---|
| 742 | 
 | 
|---|
| 743 | {
 | 
|---|
| 744 | function RestoreTransformFormulas(SL : TStrings; Formulas, NameToObjID : TStringList) : boolean; overload;
 | 
|---|
| 745 | //kt added 3/26/10
 | 
|---|
| 746 | //Returns if any changes made
 | 
|---|
| 747 | var
 | 
|---|
| 748 |   i: integer;
 | 
|---|
| 749 |   Changed : boolean;
 | 
|---|
| 750 |   txt: string;
 | 
|---|
| 751 | 
 | 
|---|
| 752 | begin
 | 
|---|
| 753 |   Result := false;
 | 
|---|
| 754 |   for i := 0 to SL.Count-1 do begin
 | 
|---|
| 755 |     txt := SL[i];
 | 
|---|
| 756 |     Changed := RestoreTransformFormulas(txt, Formulas, NameToObjID);
 | 
|---|
| 757 |     Result := Result or Changed;
 | 
|---|
| 758 |     SL[i] := txt;
 | 
|---|
| 759 |   end;
 | 
|---|
| 760 | end;
 | 
|---|
| 761 | }
 | 
|---|
| 762 | 
 | 
|---|
| 763 | function RestoreTransformTxtObjects(SL : TStrings; TxtObjects, NameToObjID : TStringList) : boolean;
 | 
|---|
| 764 | //kt added 3/28/10
 | 
|---|
| 765 | //Returns if any changes made
 | 
|---|
| 766 | //Replace formula text back in, and change field names into FldID's
 | 
|---|
| 767 | 
 | 
|---|
| 768 |   function GetTxtObjects(NumStr : string) : string;
 | 
|---|
| 769 |   //Return TxtObject text based on provided index number of formula
 | 
|---|
| 770 |   var num, i : integer;
 | 
|---|
| 771 |       PtrNum : Pointer;
 | 
|---|
| 772 |   begin
 | 
|---|
| 773 |     Result := '';
 | 
|---|
| 774 |     try
 | 
|---|
| 775 |       Num := StrToInt(NumStr);
 | 
|---|
| 776 |       PtrNum := Pointer(Num);
 | 
|---|
| 777 |       for i := 0 to TxtObjects.Count-1 do begin
 | 
|---|
| 778 |         if TxtObjects.Objects[i] = PtrNum then begin
 | 
|---|
| 779 |           Result := TxtObjects.Strings[i];
 | 
|---|
| 780 |           break;
 | 
|---|
| 781 |         end;
 | 
|---|
| 782 |       end;
 | 
|---|
| 783 |     except
 | 
|---|
| 784 |       on EConvertError do Result := '??';
 | 
|---|
| 785 |     end;
 | 
|---|
| 786 |   end;
 | 
|---|
| 787 | 
 | 
|---|
| 788 | var p1,p2 : integer;
 | 
|---|
| 789 |     count : integer;
 | 
|---|
| 790 |     ObjStr : string;
 | 
|---|
| 791 |     SubStrA,SubStrB : string;
 | 
|---|
| 792 |     Txt : string;
 | 
|---|
| 793 | begin
 | 
|---|
| 794 |   Txt := SL.Text;
 | 
|---|
| 795 |   Result := false;
 | 
|---|
| 796 |   p1 := Pos(OBJ_SHOW_TEXT,Txt);
 | 
|---|
| 797 |   while (p1>0) do begin
 | 
|---|
| 798 |     SubStrA := MidStr(Txt,1,p1-1);
 | 
|---|
| 799 |     p1 := p1 + OBJ_SHOW_TEXT_LEN;
 | 
|---|
| 800 |     p2 := PosEx(OBJ_SHOW_TEXT_END,Txt,p1);
 | 
|---|
| 801 |     SubStrB := MidStr(Txt,p2+1,StrLen(PChar(Txt))+1);    //Changed from 999 to StrLen(PChar(Txt))+1. Some characters were getting lost including the dialog tags that trigger the dialog box   elh  04/13/10
 | 
|---|
| 802 |     ObjStr := MidStr(Txt,p1, (p2-p1));
 | 
|---|
| 803 |     ObjStr := GetTxtObjects(ObjStr);
 | 
|---|
| 804 |     ObjStr := SubstuteIDs(ObjStr,NameToObjID);
 | 
|---|
| 805 |     Txt := SubStrA + FLD_OBJ_SIGNATURE + ObjStr + FLD_OBJ_END_TAG + SubStrB;
 | 
|---|
| 806 |     Result := true;
 | 
|---|
| 807 |     p1 := PosEx(OBJ_SHOW_TEXT,Txt,p1);
 | 
|---|
| 808 |   end;
 | 
|---|
| 809 |   SL.Text := Txt;
 | 
|---|
| 810 | end;
 | 
|---|
| 811 | 
 | 
|---|
| 812 | 
 | 
|---|
| 813 | function GetRPCTIUObj(TIUObjName : string) : string;
 | 
|---|
| 814 | //kt added entire function 3/28/10
 | 
|---|
| 815 | //Based on rTemplates.GetTemplateText(BoilerPlate: TStrings);
 | 
|---|
| 816 | begin
 | 
|---|
| 817 |   TIUObjName := AnsiReplaceText(TIUObjName,'|','');
 | 
|---|
| 818 |   with RPCBrokerV do begin
 | 
|---|
| 819 |     ClearParameters := True;
 | 
|---|
| 820 |     RemoteProcedure := 'TIU TEMPLATE GETTEXT';
 | 
|---|
| 821 |     Param[0].PType := literal;
 | 
|---|
| 822 |     Param[0].Value := Patient.DFN;
 | 
|---|
| 823 |     Param[1].PType := literal;
 | 
|---|
| 824 |     Param[1].Value := Encounter.VisitStr;
 | 
|---|
| 825 |     Param[2].PType := list;
 | 
|---|
| 826 |     Param[2].Mult[IntToStr(1)+',0'] := '|' + TIUObjName + '|';
 | 
|---|
| 827 |     CallBroker;
 | 
|---|
| 828 |     RPCBrokerV.Results.Delete(0);
 | 
|---|
| 829 |     if RPCBrokerV.Results.count > 0 then begin
 | 
|---|
| 830 |       Result := RPCBrokerV.Results.Strings[0];
 | 
|---|
| 831 |     end else Result := '';
 | 
|---|
| 832 |     RPCBrokerV.Results.Clear;
 | 
|---|
| 833 |   end;
 | 
|---|
| 834 | end;
 | 
|---|
| 835 | 
 | 
|---|
| 836 | 
 | 
|---|
| 837 | Procedure EvalTIUObjects(var Formula : string);
 | 
|---|
| 838 | //kt added entire function 3/28/10
 | 
|---|
| 839 | var p1,p2 : integer;
 | 
|---|
| 840 |     OP1,OP2 : integer;
 | 
|---|
| 841 |     Problem : boolean;
 | 
|---|
| 842 |     SubStrA, SubStrB : string;
 | 
|---|
| 843 |     TIUObj,Argument,s : string;
 | 
|---|
| 844 | begin
 | 
|---|
| 845 |   p1 := Pos(FN_OBJ_TAG, Formula);
 | 
|---|
| 846 |   while (p1 > 0) do begin
 | 
|---|
| 847 |     p2 := CloseCharPos('[',']',Formula, p1+1);
 | 
|---|
| 848 |     if p2=0 then begin
 | 
|---|
| 849 |       Formula := 'ERROR.  Matching "]" not found after ' + FN_OBJ_TAG + '.';
 | 
|---|
| 850 |       Exit;
 | 
|---|
| 851 |     end;
 | 
|---|
| 852 |     SubStrA := MidStr(Formula,1,p1-1);
 | 
|---|
| 853 |     p1 := p1+FN_OBJ_TAG_LEN;
 | 
|---|
| 854 |     TIUObj := Trim(MidStr(Formula, p1, (p2-p1)));
 | 
|---|
| 855 |     SubStrB := MidStr(Formula,p2+1,999);
 | 
|---|
| 856 |     OP1 := Pos('{',TIUObj);
 | 
|---|
| 857 |     if (OP1 > 0) then begin
 | 
|---|
| 858 |       OP2 := CloseCharPos('{','}', TIUObj, OP1+1);
 | 
|---|
| 859 |       if OP2=0 then begin
 | 
|---|
| 860 |         Formula := 'ERROR.  Matching ")" not found after "(".';
 | 
|---|
| 861 |         Exit;
 | 
|---|
| 862 |       end;
 | 
|---|
| 863 |       Argument := MidStr(TIUObj,OP1+1,(OP2-(OP1+1)));
 | 
|---|
| 864 |       if Pos(FN_OBJ_TAG,Argument)>0 then begin
 | 
|---|
| 865 |         EvalTIUObjects(Argument)
 | 
|---|
| 866 |       end;
 | 
|---|
| 867 |       Problem := false;
 | 
|---|
| 868 |       s := FloatToStr(StringEval(Argument,Problem));
 | 
|---|
| 869 |       if Problem then begin
 | 
|---|
| 870 |         Formula := 'ERROR evaluating argument: [' + s + '].';
 | 
|---|
| 871 |         Exit;
 | 
|---|
| 872 |       end else begin
 | 
|---|
| 873 |         Argument := s;
 | 
|---|
| 874 |       end;
 | 
|---|
| 875 |       TIUObj := MidStr(TIUObj,1,OP1-1) + '{' + Argument + '}';
 | 
|---|
| 876 |     end;
 | 
|---|
| 877 |     TIUObj := GetRPCTIUObj(TIUObj);
 | 
|---|
| 878 |     Formula := SubStrA + TIUObj + SubStrB;
 | 
|---|
| 879 |     p1 := Pos(FN_OBJ_TAG, Formula);
 | 
|---|
| 880 |   end;
 | 
|---|
| 881 | end;
 | 
|---|
| 882 | 
 | 
|---|
| 883 | 
 | 
|---|
| 884 | 
 | 
|---|
| 885 | procedure WordWrapText(var Txt: string; HTMLMode : boolean);
 | 
|---|
| 886 | var
 | 
|---|
| 887 |   TmpSL: TStringList;
 | 
|---|
| 888 |   i: integer;
 | 
|---|
| 889 | 
 | 
|---|
| 890 |   function WrappedText(const Str: string; boolHTMLMode : boolean): string;
 | 
|---|
| 891 |   var
 | 
|---|
| 892 |     i, i2, j, k, m: integer;
 | 
|---|
| 893 |     HTMLStrLen : integer;
 | 
|---|
| 894 |     Temp, Temp1, Temp2: string;
 | 
|---|
| 895 | 
 | 
|---|
| 896 |   begin
 | 
|---|
| 897 |     Temp := Str;
 | 
|---|
| 898 |     Result := '';
 | 
|---|
| 899 |     i2 := 0;
 | 
|---|
| 900 | 
 | 
|---|
| 901 |     repeat
 | 
|---|
| 902 |       i := pos(TemplateFieldBeginSignature, Temp);
 | 
|---|
| 903 | 
 | 
|---|
| 904 |       if i>0 then
 | 
|---|
| 905 |         j := pos(TemplateFieldEndSignature, copy(Temp, i, MaxInt))
 | 
|---|
| 906 |       else
 | 
|---|
| 907 |         j := 0;
 | 
|---|
| 908 | 
 | 
|---|
| 909 |       if (j > 0) then
 | 
|---|
| 910 |         begin
 | 
|---|
| 911 |         i2 := pos(TemplateFieldBeginSignature, copy(Temp, i+TemplateFieldSignatureLen, MaxInt));
 | 
|---|
| 912 |         if (i2 = 0) then
 | 
|---|
| 913 |           i2 := MaxInt
 | 
|---|
| 914 |         else
 | 
|---|
| 915 |           i2 := i + TemplateFieldSignatureLen + i2 - 1;
 | 
|---|
| 916 |         end;
 | 
|---|
| 917 | 
 | 
|---|
| 918 |       if (i>0) and (j=0) then
 | 
|---|
| 919 |         i := 0;
 | 
|---|
| 920 | 
 | 
|---|
| 921 |       if (i>0) and (j>0) then
 | 
|---|
| 922 |         if (j > i2) then
 | 
|---|
| 923 |           begin
 | 
|---|
| 924 |           Result := Result + copy(Temp, 1, i2-1);
 | 
|---|
| 925 |           delete(Temp, 1, i2-1);
 | 
|---|
| 926 |           end
 | 
|---|
| 927 |         else
 | 
|---|
| 928 |           begin
 | 
|---|
| 929 |           for k := (i+TemplateFieldSignatureLen) to (i+j-2) do
 | 
|---|
| 930 |             if Temp[k]=' ' then
 | 
|---|
| 931 |               Temp[k]:= #1;
 | 
|---|
| 932 |           i := i + j - 1;
 | 
|---|
| 933 |           Result := Result + copy(Temp,1,i);
 | 
|---|
| 934 |           delete(Temp,1,i);
 | 
|---|
| 935 |           end;
 | 
|---|
| 936 | 
 | 
|---|
| 937 |     until (i = 0);
 | 
|---|
| 938 | 
 | 
|---|
| 939 |     Result := Result + Temp;
 | 
|---|
| 940 | 
 | 
|---|
| 941 |     //Count the HTML tag length and add to MAX_ENTRY WIDTH   elh 1-29-10
 | 
|---|
| 942 |     HTMLStrLen := 0;
 | 
|---|
| 943 |     if boolHTMLMode = True then begin
 | 
|---|
| 944 |       temp1 := Result;
 | 
|---|
| 945 |       while (pos('<',temp1)>0) and (pos('>',temp1)>0) do
 | 
|---|
| 946 |       begin
 | 
|---|
| 947 |          temp2 := MidStr(temp1,pos('<',temp1),pos('>',temp1)-pos('<',temp1)+1);
 | 
|---|
| 948 |          HTMLStrLen := HTMLStrLen + strlen(PChar(temp2));
 | 
|---|
| 949 |          temp1 := Rightstr(temp1,strlen(PChar(temp1))-pos('>',temp1));
 | 
|---|
| 950 |       end;
 | 
|---|
| 951 |     end;
 | 
|---|
| 952 | 
 | 
|---|
| 953 |     Result := WrapText(Result, #13#10, [' '], MAX_ENTRY_WIDTH+HTMLStrLen);  //added +HTMLStrLen  elh 1-29-10
 | 
|---|
| 954 |     repeat
 | 
|---|
| 955 |       i := pos(#1, Result);
 | 
|---|
| 956 |       if i > 0 then
 | 
|---|
| 957 |         Result[i] := ' ';
 | 
|---|
| 958 |     until i = 0;
 | 
|---|
| 959 |   end;
 | 
|---|
| 960 | 
 | 
|---|
| 961 | begin
 | 
|---|
| 962 |   if length(Txt) > MAX_ENTRY_WIDTH then
 | 
|---|
| 963 |   begin
 | 
|---|
| 964 |     TmpSL := TStringList.Create;
 | 
|---|
| 965 |     try
 | 
|---|
| 966 |       TmpSL.Text := Txt;
 | 
|---|
| 967 |       Txt := '';
 | 
|---|
| 968 |       for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 969 |       begin
 | 
|---|
| 970 |         if Txt <> '' then
 | 
|---|
| 971 |           Txt := Txt + CRLF;
 | 
|---|
| 972 |         Txt := Txt + WrappedText(TmpSL[i],HTMLMode);
 | 
|---|
| 973 |       end;
 | 
|---|
| 974 |     finally
 | 
|---|
| 975 |       TmpSL.Free;
 | 
|---|
| 976 |     end;
 | 
|---|
| 977 |   end;
 | 
|---|
| 978 | end;
 | 
|---|
| 979 | 
 | 
|---|
| 980 | function ResolveTemplateFields(Text: string;
 | 
|---|
| 981 |                                AutoWrap: boolean;
 | 
|---|
| 982 |                                Hidden: boolean = FALSE;
 | 
|---|
| 983 |                                IncludeEmbedded: boolean = FALSE;
 | 
|---|
| 984 |                                HTMLMode : boolean = FALSE; //kt added 12/28/09
 | 
|---|
| 985 |                                HTMLAnswerOpenTag : string = ''; //kt added 12/28/09
 | 
|---|
| 986 |                                HTMLAnswerCloseTag : string = '' //kt added 12/28/09
 | 
|---|
| 987 |                                ): string;
 | 
|---|
| 988 | var
 | 
|---|
| 989 |   flen, CtrlID, i, j: integer;
 | 
|---|
| 990 |   Entry: TTemplateDialogEntry;
 | 
|---|
| 991 |   iField, Temp, NewTxt, Fld: string;
 | 
|---|
| 992 |   FoundEntry,Problem: boolean;
 | 
|---|
| 993 |   TmplFld: TTemplateField;
 | 
|---|
| 994 |   tempSL : TStringList;
 | 
|---|
| 995 |   SubStrA, SubStrB : string;  //kt
 | 
|---|
| 996 |   ExtMode : TMGExtension; //kt
 | 
|---|
| 997 |   TempStr, FnObjStr,Argument : string; //kt
 | 
|---|
| 998 |   FnP1,FnP2,p1,p2 : integer; //kt
 | 
|---|
| 999 | 
 | 
|---|
| 1000 |   procedure AddNewTxt;
 | 
|---|
| 1001 |   begin
 | 
|---|
| 1002 |     if(NewTxt <> '') then
 | 
|---|
| 1003 |     begin
 | 
|---|
| 1004 |       insert(StringOfChar('x',length(NewTxt)), Temp, i);
 | 
|---|
| 1005 |       insert(NewTxt, Result, i);
 | 
|---|
| 1006 |       inc(i, length(NewTxt));
 | 
|---|
| 1007 |     end;
 | 
|---|
| 1008 |   end;
 | 
|---|
| 1009 | 
 | 
|---|
| 1010 | begin
 | 
|---|
| 1011 |   if(not assigned(uEntries)) then
 | 
|---|
| 1012 |     uEntries := TStringList.Create;
 | 
|---|
| 1013 |   Result := Text;
 | 
|---|
| 1014 |   Temp := Text; // Use Temp to allow template fields to contain other template field references
 | 
|---|
| 1015 |   repeat
 | 
|---|
| 1016 |     i := pos(TemplateFieldBeginSignature, Temp);
 | 
|---|
| 1017 |     if(i > 0) then
 | 
|---|
| 1018 |     begin
 | 
|---|
| 1019 |       CtrlID := 0;
 | 
|---|
| 1020 |       if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
 | 
|---|
| 1021 |       begin
 | 
|---|
| 1022 |         CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
 | 
|---|
| 1023 |         delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
 | 
|---|
| 1024 |         delete(Result,i + TemplateFieldSignatureLen, FieldIDLen);
 | 
|---|
| 1025 |       end;
 | 
|---|
| 1026 |       j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
 | 
|---|
| 1027 |       Fld := '';
 | 
|---|
| 1028 |       if(j > 0) then
 | 
|---|
| 1029 |       begin
 | 
|---|
| 1030 |         inc(j, i + TemplateFieldSignatureLen - 1);
 | 
|---|
| 1031 |         flen := j - i - TemplateFieldSignatureLen;
 | 
|---|
| 1032 |         Fld := copy(Temp,i + TemplateFieldSignatureLen, flen);
 | 
|---|
| 1033 |         delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
 | 
|---|
| 1034 |         delete(Result,i,flen + TemplateFieldSignatureLen + 1);
 | 
|---|
| 1035 |       end
 | 
|---|
| 1036 |       else
 | 
|---|
| 1037 |       begin
 | 
|---|
| 1038 |         delete(Temp,i,TemplateFieldSignatureLen);
 | 
|---|
| 1039 |         delete(Result,i,TemplateFieldSignatureLen);
 | 
|---|
| 1040 |       end;
 | 
|---|
| 1041 |       if(CtrlID > 0) then
 | 
|---|
| 1042 |       begin
 | 
|---|
| 1043 |         FoundEntry := FALSE;
 | 
|---|
| 1044 |         for j := 0 to uEntries.Count-1 do
 | 
|---|
| 1045 |         begin
 | 
|---|
| 1046 |           Entry := TTemplateDialogEntry(uEntries.Objects[j]);
 | 
|---|
| 1047 |           if(assigned(Entry)) then
 | 
|---|
| 1048 |           begin
 | 
|---|
| 1049 |             if IncludeEmbedded then
 | 
|---|
| 1050 |               iField := Fld
 | 
|---|
| 1051 |             else
 | 
|---|
| 1052 |               iField := '';
 | 
|---|
| 1053 |             NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
 | 
|---|
| 1054 |             TmplFld := GetTemplateField(Fld, FALSE);
 | 
|---|
| 1055 |             if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
 | 
|---|
| 1056 |                NewTxt := Piece(NewTxt,':',1);          {we only want the first piece of NewTxt}
 | 
|---|
| 1057 |             //kt 12/28/09 --- Start mod to wrap answers in custom HTML tag ---
 | 
|---|
| 1058 |             if (HTMLMode=true) and (NewTxt <> '') then begin
 | 
|---|
| 1059 |               NewTxt := HTMLAnswerOpenTag + NewTxt + HTMLAnswerCloseTag;   //kt 12/29/09
 | 
|---|
| 1060 |             end;
 | 
|---|
| 1061 |             //kt --- End mod to wrap answers in custom HTML tag ---
 | 
|---|
| 1062 |             AddNewTxt;
 | 
|---|
| 1063 |           end;
 | 
|---|
| 1064 |           if FoundEntry then break;
 | 
|---|
| 1065 |         end;
 | 
|---|
| 1066 |         if Hidden and (not FoundEntry) and (Fld <> '') then
 | 
|---|
| 1067 |         begin
 | 
|---|
| 1068 |           NewTxt := TemplateFieldBeginSignature + Fld + TemplateFieldEndSignature;
 | 
|---|
| 1069 |           AddNewTxt;
 | 
|---|
| 1070 |         end;
 | 
|---|
| 1071 |       end;
 | 
|---|
| 1072 |     end else begin
 | 
|---|
| 1073 |       if HTMLMode=true then begin
 | 
|---|
| 1074 |         tempSL := TStringList.create;
 | 
|---|
| 1075 |         tempSL.Text := Result;
 | 
|---|
| 1076 |         if tempSL.Count < 3 then begin
 | 
|---|
| 1077 |           Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
 | 
|---|
| 1078 |         end;
 | 
|---|
| 1079 |         tempSL.Free;
 | 
|---|
| 1080 |       end;
 | 
|---|
| 1081 |     end;
 | 
|---|
| 1082 |   until(i = 0);
 | 
|---|
| 1083 | 
 | 
|---|
| 1084 |   //kt -- begin mod ---  Entire section added.
 | 
|---|
| 1085 |   Temp := Result;
 | 
|---|
| 1086 |   for ExtMode := tmgeFN to tmgeOBJ do begin
 | 
|---|
| 1087 |     repeat
 | 
|---|
| 1088 |       i := pos(TMG_MATCH[ExtMode].Signature, Temp);
 | 
|---|
| 1089 |       if(i > 0) then begin
 | 
|---|
| 1090 |         FnP1 := i;
 | 
|---|
| 1091 |         FnP2 := CloseCharPos('{', TMG_MATCH[ExtMode].EndTag, Temp, i);
 | 
|---|
| 1092 |         //FnP2 := Pos(TMG_MATCH[ExtMode].EndTag,Temp);    //Should use CloseCharPos function
 | 
|---|
| 1093 |         p1 := FnP1 + TMG_MATCH[ExtMode].SigLen;
 | 
|---|
| 1094 |         FnObjStr := MidStr(Temp, p1, FnP2-p1);
 | 
|---|
| 1095 |         p1 := Pos(FieldIDDelim,FnObjStr);
 | 
|---|
| 1096 |         while (p1 > 0) do begin
 | 
|---|
| 1097 |           SubStrA := MidStr(FnObjStr,1,p1-1);
 | 
|---|
| 1098 |           p2 := PosEx(FieldIDDelim,FnObjStr,p1+1);
 | 
|---|
| 1099 |           Argument := MidStr(FnObjStr,p1+1,(p2-p1)-1);
 | 
|---|
| 1100 |           SubStrB := MidStr(FnObjStr,p2+1,StrLen(PChar(FnObjStr))+1);
 | 
|---|
| 1101 |           CtrlID := StrToIntDef(MidStr(Argument,1,FieldIDLen-1), 0);
 | 
|---|
| 1102 |           Fld := MidStr(Argument,FieldIDLen,StrLen(PChar(Argument))+1);
 | 
|---|
| 1103 |           if(CtrlID > 0) then begin
 | 
|---|
| 1104 |             FoundEntry := FALSE;
 | 
|---|
| 1105 |             for j := 0 to uEntries.Count-1 do begin
 | 
|---|
| 1106 |               Entry := TTemplateDialogEntry(uEntries.Objects[j]);
 | 
|---|
| 1107 |               if(assigned(Entry)) then begin
 | 
|---|
| 1108 |                 if IncludeEmbedded then
 | 
|---|
| 1109 |                   iField := Fld
 | 
|---|
| 1110 |                 else
 | 
|---|
| 1111 |                   iField := '';
 | 
|---|
| 1112 |                 NewTxt := Entry.GetControlText(CtrlID, FALSE, FoundEntry, AutoWrap, iField);
 | 
|---|
| 1113 |                 TmplFld := GetTemplateField(Fld, FALSE);
 | 
|---|
| 1114 |                 if (assigned(TmplFld)) and (TmplFld.DateType in DateComboTypes) then {if this is a TORDateBox}
 | 
|---|
| 1115 |                    NewTxt := Piece(NewTxt,':',1);          {we only want the first piece of NewTxt}
 | 
|---|
| 1116 |                 Argument := Trim(NewTxt);
 | 
|---|
| 1117 |               end;
 | 
|---|
| 1118 |             end;
 | 
|---|
| 1119 |           end else Argument := '??';
 | 
|---|
| 1120 |           FnObjStr := SubStrA + Argument + SubStrB;
 | 
|---|
| 1121 |           p1 := Pos(FieldIDDelim,FnObjStr);
 | 
|---|
| 1122 |         end;
 | 
|---|
| 1123 |         if (ExtMode = tmgeOBJ) then begin
 | 
|---|
| 1124 |           FnObjStr := FN_OBJ_TAG + FnObjStr + ']';
 | 
|---|
| 1125 |         end;
 | 
|---|
| 1126 |         FnObjStr := FormatFormula(FnObjStr);  //Added to remove all characters from the formula  elh  4/9/10
 | 
|---|
| 1127 |         if (Pos(FN_OBJ_TAG,FnObjStr)>0) then begin
 | 
|---|
| 1128 |           EvalTIUObjects(FnObjStr);
 | 
|---|
| 1129 |         end;
 | 
|---|
| 1130 |         if ExtMode = tmgeFN then begin
 | 
|---|
| 1131 |           Problem := false;
 | 
|---|
| 1132 |           TempStr := AnsiReplaceText(FnObjStr,' ','');
 | 
|---|
| 1133 |           TempStr := FloatToStr(StringEval(TempStr,Problem));
 | 
|---|
| 1134 |           if not Problem then FnObjStr := TempStr;
 | 
|---|
| 1135 |         end;
 | 
|---|
| 1136 |         SubStrA := MidStr(Temp,1,FnP1-1);
 | 
|---|
| 1137 |         SubStrB := MidStr(Temp,FnP2+1,StrLen(PChar(Temp))+1);
 | 
|---|
| 1138 |         if (HTMLMode=true) and (FnObjStr <> '') then begin
 | 
|---|
| 1139 |           FnObjStr := HTMLAnswerOpenTag + FnObjStr + HTMLAnswerCloseTag;
 | 
|---|
| 1140 |         end;
 | 
|---|
| 1141 |         Temp := SubStrA + FnObjStr + SubStrB;
 | 
|---|
| 1142 |       end else begin
 | 
|---|
| 1143 |         if HTMLMode=true then begin
 | 
|---|
| 1144 |           tempSL := TStringList.create;
 | 
|---|
| 1145 |           tempSL.Text := Result;
 | 
|---|
| 1146 |           if tempSL.Count < 3 then begin
 | 
|---|
| 1147 |             Result := HTMLAnswerOpenTag + Result + HTMLAnswerCloseTag;
 | 
|---|
| 1148 |           end;
 | 
|---|
| 1149 |           tempSL.Free;
 | 
|---|
| 1150 |         end;
 | 
|---|
| 1151 |       end;
 | 
|---|
| 1152 |     until(i = 0);
 | 
|---|
| 1153 |   end;
 | 
|---|
| 1154 |   Result := Temp;
 | 
|---|
| 1155 |   //kt -- end mod --
 | 
|---|
| 1156 | 
 | 
|---|
| 1157 |   if not AutoWrap then
 | 
|---|
| 1158 |     WordWrapText(Result,HTMLMode);
 | 
|---|
| 1159 | 
 | 
|---|
| 1160 | end;
 | 
|---|
| 1161 | 
 | 
|---|
| 1162 | function AreTemplateFieldsRequired(const Text: string; FldValues: TORStringList =  nil): boolean;
 | 
|---|
| 1163 | var
 | 
|---|
| 1164 |   flen, CtrlID, i, j: integer;
 | 
|---|
| 1165 |   Entry: TTemplateDialogEntry;
 | 
|---|
| 1166 |   Fld: TTemplateField;
 | 
|---|
| 1167 |   Temp, NewTxt, FldName: string;
 | 
|---|
| 1168 |   FoundEntry: boolean;
 | 
|---|
| 1169 |   SubStrA,SubStrB : string;
 | 
|---|
| 1170 | 
 | 
|---|
| 1171 | begin
 | 
|---|
| 1172 |   if(not assigned(uEntries)) then
 | 
|---|
| 1173 |     uEntries := TStringList.Create;
 | 
|---|
| 1174 |   Temp := Text;
 | 
|---|
| 1175 |   Result := FALSE;
 | 
|---|
| 1176 |   repeat
 | 
|---|
| 1177 |     i := pos(TemplateFieldBeginSignature, Temp);
 | 
|---|
| 1178 |     if(i > 0) then
 | 
|---|
| 1179 |     begin
 | 
|---|
| 1180 |       CtrlID := 0;
 | 
|---|
| 1181 |       if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
 | 
|---|
| 1182 |       begin
 | 
|---|
| 1183 |         CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
 | 
|---|
| 1184 |         delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
 | 
|---|
| 1185 |       end;
 | 
|---|
| 1186 |       j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
 | 
|---|
| 1187 |       if(j > 0) then
 | 
|---|
| 1188 |       begin
 | 
|---|
| 1189 |         inc(j, i + TemplateFieldSignatureLen - 1);
 | 
|---|
| 1190 |         flen := j - i - TemplateFieldSignatureLen;
 | 
|---|
| 1191 |         FldName := copy(Temp, i + TemplateFieldSignatureLen, flen);
 | 
|---|
| 1192 |         Fld := GetTemplateField(FldName, FALSE);
 | 
|---|
| 1193 |         delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
 | 
|---|
| 1194 |       end
 | 
|---|
| 1195 |       else
 | 
|---|
| 1196 |       begin
 | 
|---|
| 1197 |         delete(Temp,i,TemplateFieldSignatureLen);
 | 
|---|
| 1198 |         Fld := nil;
 | 
|---|
| 1199 |       end;
 | 
|---|
| 1200 |       if(CtrlID > 0) and (assigned(Fld)) and (Fld.Required) then
 | 
|---|
| 1201 |       begin
 | 
|---|
| 1202 |         FoundEntry := FALSE;
 | 
|---|
| 1203 |         for j := 0 to uEntries.Count-1 do
 | 
|---|
| 1204 |         begin
 | 
|---|
| 1205 |           Entry := TTemplateDialogEntry(uEntries.Objects[j]);
 | 
|---|
| 1206 |           if(assigned(Entry)) then
 | 
|---|
| 1207 |           begin
 | 
|---|
| 1208 |             NewTxt := Entry.GetControlText(CtrlID, TRUE, FoundEntry, FALSE);
 | 
|---|
| 1209 |             if FoundEntry and (NewTxt = '') then
 | 
|---|
| 1210 |               Result := TRUE;
 | 
|---|
| 1211 |           end;
 | 
|---|
| 1212 |           if FoundEntry then break;
 | 
|---|
| 1213 |         end;
 | 
|---|
| 1214 |         if (not FoundEntry) and assigned(FldValues) then
 | 
|---|
| 1215 |         begin
 | 
|---|
| 1216 |           j := FldValues.IndexOfPiece(IntToStr(CtrlID));
 | 
|---|
| 1217 |           if(j < 0) or (Piece(FldValues[j],U,2) = '') then
 | 
|---|
| 1218 |             Result := TRUE;
 | 
|---|
| 1219 |         end;
 | 
|---|
| 1220 |       end;
 | 
|---|
| 1221 |     end;
 | 
|---|
| 1222 |   until((i = 0) or Result);
 | 
|---|
| 1223 | end;
 | 
|---|
| 1224 | 
 | 
|---|
| 1225 | function HasTemplateField(txt: string): boolean;
 | 
|---|
| 1226 | begin
 | 
|---|
| 1227 |   Result := (pos(TemplateFieldBeginSignature, txt) > 0);
 | 
|---|
| 1228 | end;
 | 
|---|
| 1229 | 
 | 
|---|
| 1230 | function GetTemplateField(ATemplateField: string; ByIEN: boolean): TTemplateField;
 | 
|---|
| 1231 | var
 | 
|---|
| 1232 |   i, idx: integer;
 | 
|---|
| 1233 |   AData: TStrings;
 | 
|---|
| 1234 | 
 | 
|---|
| 1235 | begin
 | 
|---|
| 1236 |   Result := nil;
 | 
|---|
| 1237 |   if(not assigned(uTmplFlds)) then
 | 
|---|
| 1238 |     uTmplFlds := TList.Create;
 | 
|---|
| 1239 |   idx := -1;
 | 
|---|
| 1240 |   for i := 0 to uTmplFlds.Count-1 do
 | 
|---|
| 1241 |   begin
 | 
|---|
| 1242 |     if(ByIEN) then
 | 
|---|
| 1243 |     begin
 | 
|---|
| 1244 |       if(TTemplateField(uTmplFlds[i]).FID = ATemplateField) then
 | 
|---|
| 1245 |       begin
 | 
|---|
| 1246 |         idx := i;
 | 
|---|
| 1247 |         break;
 | 
|---|
| 1248 |       end;
 | 
|---|
| 1249 |     end
 | 
|---|
| 1250 |     else
 | 
|---|
| 1251 |     begin
 | 
|---|
| 1252 |       if(TTemplateField(uTmplFlds[i]).FFldName = ATemplateField) then
 | 
|---|
| 1253 |       begin
 | 
|---|
| 1254 |         idx := i;
 | 
|---|
| 1255 |         break;
 | 
|---|
| 1256 |       end;
 | 
|---|
| 1257 |     end;
 | 
|---|
| 1258 |   end;
 | 
|---|
| 1259 |   if(idx < 0) then
 | 
|---|
| 1260 |   begin
 | 
|---|
| 1261 |     if(ByIEN) then
 | 
|---|
| 1262 |       AData := LoadTemplateFieldByIEN(ATemplateField)
 | 
|---|
| 1263 |     else
 | 
|---|
| 1264 |       AData := LoadTemplateField(ATemplateField);
 | 
|---|
| 1265 |     if(AData.Count > 1) then
 | 
|---|
| 1266 |       Result := TTemplateField.Create(AData);
 | 
|---|
| 1267 |   end
 | 
|---|
| 1268 |   else
 | 
|---|
| 1269 |     Result := TTemplateField(uTmplFlds[idx]);
 | 
|---|
| 1270 | end;
 | 
|---|
| 1271 | 
 | 
|---|
| 1272 | function TemplateFieldNameProblem(Fld: TTemplateField): boolean;
 | 
|---|
| 1273 | //const
 | 
|---|
| 1274 | //DUPFLD = 'Field Name is not unique';  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1275 | 
 | 
|---|
| 1276 | var
 | 
|---|
| 1277 |   i: integer;
 | 
|---|
| 1278 |   msg: string;
 | 
|---|
| 1279 |   DUPFLD : string; //kt
 | 
|---|
| 1280 | 
 | 
|---|
| 1281 | begin
 | 
|---|
| 1282 |   DUPFLD := DKLangConstW('uTemplateFields_Field_Name_is_not_unique'); //kt added 8/8/2007
 | 
|---|
| 1283 |   msg := '';
 | 
|---|
| 1284 |   if(Fld.FldName = NewTemplateField) then
 | 
|---|
| 1285 | //  msg := 'Field Name can not be ' + NewTemplateField  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1286 |     msg := DKLangConstW('uTemplateFields_Field_Name_can_not_be') + NewTemplateField //kt added 8/8/2007
 | 
|---|
| 1287 |   else
 | 
|---|
| 1288 |   if(length(Fld.FldName) < 3) then
 | 
|---|
| 1289 | //  msg := 'Field Name must be at least three characters in length'  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1290 |     msg := DKLangConstW('uTemplateFields_Field_Name_must_be_at_least_three_characters_in_length') //kt added 8/8/2007
 | 
|---|
| 1291 |   else
 | 
|---|
| 1292 |   if(not (Fld.FldName[1] in ['A'..'Z','0'..'9'])) then
 | 
|---|
| 1293 | //  msg := 'First Field Name character must be "A" - "Z", or "0" - "9"'  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1294 |     msg := DKLangConstW('uTemplateFields_First_Field_Name_character_must_be_xAx_x_xZxx_or_x0x_x_x9x') //kt added 8/8/2007
 | 
|---|
| 1295 |   else
 | 
|---|
| 1296 |   if(assigned(uTmplFlds)) then
 | 
|---|
| 1297 |   begin
 | 
|---|
| 1298 |     for i := 0 to uTmplFlds.Count-1 do
 | 
|---|
| 1299 |     begin
 | 
|---|
| 1300 |       if(Fld <> uTmplFlds[i]) and
 | 
|---|
| 1301 |         (CompareText(TTemplateField(uTmplFlds[i]).FFldName, Fld.FFldName) = 0) then
 | 
|---|
| 1302 |       begin
 | 
|---|
| 1303 |         msg := DUPFLD;
 | 
|---|
| 1304 |         break;
 | 
|---|
| 1305 |       end;
 | 
|---|
| 1306 |     end;
 | 
|---|
| 1307 |   end;
 | 
|---|
| 1308 |   if(msg = '') and (not IsTemplateFieldNameUnique(Fld.FFldName, Fld.ID)) then
 | 
|---|
| 1309 |     msg := DUPFLD;
 | 
|---|
| 1310 |   Result := (msg <> '');
 | 
|---|
| 1311 |   if(Result) then
 | 
|---|
| 1312 |     ShowMessage(msg);
 | 
|---|
| 1313 | end;
 | 
|---|
| 1314 | 
 | 
|---|
| 1315 | function SaveTemplateFieldErrors: string;
 | 
|---|
| 1316 | var
 | 
|---|
| 1317 |   i: integer;
 | 
|---|
| 1318 |   Errors: TStringList;
 | 
|---|
| 1319 |   Fld: TTemplateField;
 | 
|---|
| 1320 |   msg: string;
 | 
|---|
| 1321 | 
 | 
|---|
| 1322 | begin
 | 
|---|
| 1323 |   Result := '';
 | 
|---|
| 1324 |   if(assigned(uTmplFlds)) then
 | 
|---|
| 1325 |   begin
 | 
|---|
| 1326 |     Errors := nil;
 | 
|---|
| 1327 |     try
 | 
|---|
| 1328 |       for i := 0 to uTmplFlds.Count-1 do
 | 
|---|
| 1329 |       begin
 | 
|---|
| 1330 |         Fld := TTemplateField(uTmplFlds[i]);
 | 
|---|
| 1331 |         if(Fld.FModified) then
 | 
|---|
| 1332 |         begin
 | 
|---|
| 1333 |           msg := Fld.SaveError;
 | 
|---|
| 1334 |           if(msg <> '') then
 | 
|---|
| 1335 |           begin
 | 
|---|
| 1336 |             if(not assigned(Errors)) then
 | 
|---|
| 1337 |             begin
 | 
|---|
| 1338 |               Errors := TStringList.Create;
 | 
|---|
| 1339 | //            Errors.Add('The following template field save errors have occurred:');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1340 |               Errors.Add(DKLangConstW('uTemplateFields_The_following_template_field_save_errors_have_occurredx')); //kt added 8/8/2007
 | 
|---|
| 1341 |               Errors.Add('');
 | 
|---|
| 1342 |             end;
 | 
|---|
| 1343 |             Errors.Add('  ' + Fld.FldName + ': ' + msg);
 | 
|---|
| 1344 |           end;
 | 
|---|
| 1345 |         end;
 | 
|---|
| 1346 |       end;
 | 
|---|
| 1347 |     finally
 | 
|---|
| 1348 |       if(assigned(Errors)) then
 | 
|---|
| 1349 |       begin
 | 
|---|
| 1350 |         Result := Errors.Text;
 | 
|---|
| 1351 |         Errors.Free;
 | 
|---|
| 1352 |       end;
 | 
|---|
| 1353 |     end;
 | 
|---|
| 1354 |   end;
 | 
|---|
| 1355 | end;
 | 
|---|
| 1356 | 
 | 
|---|
| 1357 | procedure ClearModifiedTemplateFields;
 | 
|---|
| 1358 | var
 | 
|---|
| 1359 |   i: integer;
 | 
|---|
| 1360 |   Fld: TTemplateField;
 | 
|---|
| 1361 | 
 | 
|---|
| 1362 | begin
 | 
|---|
| 1363 |   if(assigned(uTmplFlds)) then
 | 
|---|
| 1364 |   begin
 | 
|---|
| 1365 |     for i := uTmplFlds.Count-1 downto 0 do
 | 
|---|
| 1366 |     begin
 | 
|---|
| 1367 |       Fld := TTemplateField(uTmplFlds[i]);
 | 
|---|
| 1368 |       if(assigned(Fld)) and (Fld.FModified) then
 | 
|---|
| 1369 |       begin
 | 
|---|
| 1370 |         if Fld.FLocked then
 | 
|---|
| 1371 |           UnlockTemplateField(Fld.FID);
 | 
|---|
| 1372 |         Fld.Free;
 | 
|---|
| 1373 |       end;
 | 
|---|
| 1374 |     end;
 | 
|---|
| 1375 |   end;
 | 
|---|
| 1376 | end;
 | 
|---|
| 1377 | 
 | 
|---|
| 1378 | function AnyTemplateFieldsModified: boolean;
 | 
|---|
| 1379 | var
 | 
|---|
| 1380 |   i: integer;
 | 
|---|
| 1381 | 
 | 
|---|
| 1382 | begin
 | 
|---|
| 1383 |   Result := FALSE;
 | 
|---|
| 1384 |   if(assigned(uTmplFlds)) then
 | 
|---|
| 1385 |   begin
 | 
|---|
| 1386 |     for i := 0 to uTmplFlds.Count-1 do
 | 
|---|
| 1387 |     begin
 | 
|---|
| 1388 |       if(TTemplateField(uTmplFlds[i]).FModified) then
 | 
|---|
| 1389 |       begin
 | 
|---|
| 1390 |         Result := TRUE;
 | 
|---|
| 1391 |         break;
 | 
|---|
| 1392 |       end;
 | 
|---|
| 1393 |     end;
 | 
|---|
| 1394 |   end;
 | 
|---|
| 1395 | end;
 | 
|---|
| 1396 | 
 | 
|---|
| 1397 | procedure ListTemplateFields(const AText: string; AList: TStrings; ListErrors: boolean = FALSE);
 | 
|---|
| 1398 | var
 | 
|---|
| 1399 |   i, j, k, flen, BadCount: integer;
 | 
|---|
| 1400 |   flddesc, tmp, fld: string;
 | 
|---|
| 1401 |   TmpList: TStringList;
 | 
|---|
| 1402 |   InactiveList: TStringList;
 | 
|---|
| 1403 |   FldObj: TTemplateField;
 | 
|---|
| 1404 | 
 | 
|---|
| 1405 | begin
 | 
|---|
| 1406 |   if(AText = '') then exit;
 | 
|---|
| 1407 |   BadCount := 0;
 | 
|---|
| 1408 |   InactiveList := TStringList.Create;
 | 
|---|
| 1409 |   try
 | 
|---|
| 1410 |     TmpList := TStringList.Create;
 | 
|---|
| 1411 |     try
 | 
|---|
| 1412 |       TmpList.Text := AText;
 | 
|---|
| 1413 |       for k := 0 to TmpList.Count-1 do
 | 
|---|
| 1414 |       begin
 | 
|---|
| 1415 |         tmp := TmpList[k];
 | 
|---|
| 1416 |         repeat
 | 
|---|
| 1417 |           i := pos(TemplateFieldBeginSignature, tmp);
 | 
|---|
| 1418 |           if(i > 0) then
 | 
|---|
| 1419 |           begin
 | 
|---|
| 1420 |             fld := '';
 | 
|---|
| 1421 |             j := pos(TemplateFieldEndSignature, copy(tmp, i + TemplateFieldSignatureLen, MaxInt));
 | 
|---|
| 1422 |             if(j > 0) then
 | 
|---|
| 1423 |             begin
 | 
|---|
| 1424 |               inc(j, i + TemplateFieldSignatureLen - 1);
 | 
|---|
| 1425 |               flen := j - i - TemplateFieldSignatureLen;
 | 
|---|
| 1426 |               fld := copy(tmp,i + TemplateFieldSignatureLen, flen);
 | 
|---|
| 1427 |               delete(tmp, i, flen + TemplateFieldSignatureLen + 1);
 | 
|---|
| 1428 |             end
 | 
|---|
| 1429 |             else
 | 
|---|
| 1430 |             begin
 | 
|---|
| 1431 |               delete(tmp,i,TemplateFieldSignatureLen);
 | 
|---|
| 1432 |               inc(BadCount);
 | 
|---|
| 1433 |             end;
 | 
|---|
| 1434 |             if(fld <> '') then
 | 
|---|
| 1435 |             begin
 | 
|---|
| 1436 |               if ListErrors then
 | 
|---|
| 1437 |               begin
 | 
|---|
| 1438 |                 FldObj := GetTemplateField(fld, FALSE);
 | 
|---|
| 1439 |                 if assigned(FldObj) then
 | 
|---|
| 1440 |                 begin
 | 
|---|
| 1441 |                   if FldObj.Inactive then
 | 
|---|
| 1442 |                     InactiveList.Add('  "' + fld + '"');
 | 
|---|
| 1443 |                   flddesc := '';
 | 
|---|
| 1444 |                 end
 | 
|---|
| 1445 |                 else
 | 
|---|
| 1446 |                   flddesc := '  "' + fld + '"';
 | 
|---|
| 1447 |               end
 | 
|---|
| 1448 |               else
 | 
|---|
| 1449 |                 flddesc := fld;
 | 
|---|
| 1450 |               if(flddesc <> '') and (AList.IndexOf(flddesc) < 0) then
 | 
|---|
| 1451 |                 AList.Add(flddesc)
 | 
|---|
| 1452 |             end;
 | 
|---|
| 1453 |           end;
 | 
|---|
| 1454 |         until (i = 0);
 | 
|---|
| 1455 |       end;
 | 
|---|
| 1456 |     finally
 | 
|---|
| 1457 |       TmpList.Free;
 | 
|---|
| 1458 |     end;
 | 
|---|
| 1459 |     if ListErrors then
 | 
|---|
| 1460 |     begin
 | 
|---|
| 1461 |       if(AList.Count > 0) then
 | 
|---|
| 1462 | //      AList.Insert(0, 'The following template fields were not found:');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1463 |         AList.Insert(0, DKLangConstW('uTemplateFields_The_following_template_fields_were_not_foundx')); //kt added 8/8/2007
 | 
|---|
| 1464 |       if (BadCount > 0) then
 | 
|---|
| 1465 |       begin
 | 
|---|
| 1466 |         if(BadCount = 1) then
 | 
|---|
| 1467 | //        tmp := 'A template field marker "' + TemplateFieldBeginSignature +  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1468 |           tmp := DKLangConstW('uTemplateFields_A_template_field_marker_x') + TemplateFieldBeginSignature + //kt added 8/8/2007
 | 
|---|
| 1469 | //               '" was found without a'  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1470 |                  DKLangConstW('uTemplateFields_x_was_found_without_a') //kt added 8/8/2007
 | 
|---|
| 1471 |         else
 | 
|---|
| 1472 | //        tmp := IntToStr(BadCount) + ' template field markers "' + TemplateFieldBeginSignature +  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1473 |           tmp := IntToStr(BadCount) + DKLangConstW('uTemplateFields_template_field_markers_x') + TemplateFieldBeginSignature + //kt added 8/8/2007
 | 
|---|
| 1474 | //               '" were found without';  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1475 |                  DKLangConstW('uTemplateFields_x_were_found_without'); //kt added 8/8/2007
 | 
|---|
| 1476 |         if(AList.Count > 0) then
 | 
|---|
| 1477 |           AList.Add('');
 | 
|---|
| 1478 | //      AList.Add(tmp + ' matching "' + TemplateFieldEndSignature + '"');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1479 |         AList.Add(tmp + DKLangConstW('uTemplateFields_matching_x') + TemplateFieldEndSignature + '"'); //kt added 8/8/2007
 | 
|---|
| 1480 |       end;
 | 
|---|
| 1481 |       if(InactiveList.Count > 0) then
 | 
|---|
| 1482 |       begin
 | 
|---|
| 1483 |         if(AList.Count > 0) then
 | 
|---|
| 1484 |           AList.Add('');
 | 
|---|
| 1485 | //      AList.Add('The following inactive template fields were found:');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1486 |         AList.Add(DKLangConstW('uTemplateFields_The_following_inactive_template_fields_were_foundx')); //kt added 8/8/2007
 | 
|---|
| 1487 |         AList.AddStrings(InactiveList);
 | 
|---|
| 1488 |       end;
 | 
|---|
| 1489 |       if(AList.Count > 0) then
 | 
|---|
| 1490 |       begin
 | 
|---|
| 1491 | //      AList.Insert(0, 'Text contains template field errors:');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1492 |         AList.Insert(0, DKLangConstW('uTemplateFields_Text_contains_template_field_errorsx')); //kt added 8/8/2007
 | 
|---|
| 1493 |         AList.Insert(1, '');
 | 
|---|
| 1494 |       end;
 | 
|---|
| 1495 |     end;
 | 
|---|
| 1496 |   finally
 | 
|---|
| 1497 |     InactiveList.Free;
 | 
|---|
| 1498 |   end;
 | 
|---|
| 1499 | end;
 | 
|---|
| 1500 | 
 | 
|---|
| 1501 | function BoilerplateTemplateFieldsOK(const AText: string; Msg: string = ''): boolean;
 | 
|---|
| 1502 | var
 | 
|---|
| 1503 |   Errors: TStringList;
 | 
|---|
| 1504 |   btns: TMsgDlgButtons;
 | 
|---|
| 1505 | 
 | 
|---|
| 1506 | begin
 | 
|---|
| 1507 |   Result := TRUE;
 | 
|---|
| 1508 |   Errors := TStringList.Create;
 | 
|---|
| 1509 |   try
 | 
|---|
| 1510 |     ListTemplateFields(AText, Errors, TRUE);
 | 
|---|
| 1511 |     if(Errors.Count > 0) then
 | 
|---|
| 1512 |     begin
 | 
|---|
| 1513 |       if(Msg = 'OK') then
 | 
|---|
| 1514 |         btns := [mbOK]
 | 
|---|
| 1515 |       else
 | 
|---|
| 1516 |       begin
 | 
|---|
| 1517 |         btns := [mbAbort, mbIgnore];
 | 
|---|
| 1518 |         Errors.Add('');
 | 
|---|
| 1519 |         if(Msg = '') then
 | 
|---|
| 1520 | //        Msg := 'text insertion';  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1521 |           Msg := DKLangConstW('uTemplateFields_text_insertion'); //kt added 8/8/2007
 | 
|---|
| 1522 | //      Errors.Add('Do you want to Abort ' + Msg + ', or Ignore the error and continue?');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1523 |         Errors.Add(DKLangConstW('uTemplateFields_Do_you_want_to_Abort')+' ' + Msg + DKLangConstW('uTemplateFields_x_or_Ignore_the_error_and_continuex')); //kt added 8/8/2007
 | 
|---|
| 1524 |       end;
 | 
|---|
| 1525 |       Result := (MessageDlg(Errors.Text, mtError, btns, 0) = mrIgnore);
 | 
|---|
| 1526 |     end;
 | 
|---|
| 1527 |   finally
 | 
|---|
| 1528 |     Errors.Free;
 | 
|---|
| 1529 |   end;
 | 
|---|
| 1530 | end;
 | 
|---|
| 1531 | 
 | 
|---|
| 1532 | procedure EnsureText(edt: TEdit; ud: TUpDown);
 | 
|---|
| 1533 | var
 | 
|---|
| 1534 |   v: integer;
 | 
|---|
| 1535 |   s: string;
 | 
|---|
| 1536 | 
 | 
|---|
| 1537 | begin
 | 
|---|
| 1538 |   if assigned(ud.Associate) then
 | 
|---|
| 1539 |   begin
 | 
|---|
| 1540 |     v := StrToIntDef(edt.Text, ud.Position);
 | 
|---|
| 1541 |     if (v < ud.Min) or (v > ud.Max) then
 | 
|---|
| 1542 |       v := ud.Position;
 | 
|---|
| 1543 |     s := IntToStr(v);
 | 
|---|
| 1544 |     if edt.Text <> s then
 | 
|---|
| 1545 |       edt.Text := s;
 | 
|---|
| 1546 |   end;
 | 
|---|
| 1547 |   edt.SelStart := edt.GetTextLen;    
 | 
|---|
| 1548 | end;
 | 
|---|
| 1549 | 
 | 
|---|
| 1550 | function TemplateFieldCode2Field(const Code: string): TTemplateFieldType;
 | 
|---|
| 1551 | var
 | 
|---|
| 1552 |   typ: TTemplateFieldType;
 | 
|---|
| 1553 | 
 | 
|---|
| 1554 | begin
 | 
|---|
| 1555 |   Result := dftUnknown;
 | 
|---|
| 1556 |   for typ := low(TTemplateFieldType) to high(TTemplateFieldType) do
 | 
|---|
| 1557 |     if Code = TemplateFieldTypeCodes[typ] then
 | 
|---|
| 1558 |     begin
 | 
|---|
| 1559 |       Result := typ;
 | 
|---|
| 1560 |       break;
 | 
|---|
| 1561 |     end;
 | 
|---|
| 1562 | end;
 | 
|---|
| 1563 | 
 | 
|---|
| 1564 | function TemplateDateCode2DateType(const Code: string): TTmplFldDateType;
 | 
|---|
| 1565 | var
 | 
|---|
| 1566 |   typ: TTmplFldDateType;
 | 
|---|
| 1567 | 
 | 
|---|
| 1568 | begin
 | 
|---|
| 1569 |   Result := dtUnknown;
 | 
|---|
| 1570 |   for typ := low(TTmplFldDateType) to high(TTmplFldDateType) do
 | 
|---|
| 1571 |     if Code = TemplateFieldDateCodes[typ] then
 | 
|---|
| 1572 |     begin
 | 
|---|
| 1573 |       Result := typ;
 | 
|---|
| 1574 |       break;
 | 
|---|
| 1575 |     end;
 | 
|---|
| 1576 | end;
 | 
|---|
| 1577 | 
 | 
|---|
| 1578 | procedure ConvertCodes2Text(sl: TStrings; Short: boolean);
 | 
|---|
| 1579 | var
 | 
|---|
| 1580 |   i: integer;
 | 
|---|
| 1581 |   tmp, output: string;
 | 
|---|
| 1582 |   ftype: TTemplateFieldType;
 | 
|---|
| 1583 |   dtype: TTmplFldDateType;
 | 
|---|
| 1584 | 
 | 
|---|
| 1585 | begin
 | 
|---|
| 1586 |   for i := 0 to sl.Count-1 do
 | 
|---|
| 1587 |   begin
 | 
|---|
| 1588 |     tmp := sl[i];
 | 
|---|
| 1589 |     if piece(tmp,U,4) = BOOLCHAR[TRUE] then
 | 
|---|
| 1590 |       output := '* '
 | 
|---|
| 1591 |     else
 | 
|---|
| 1592 |       output := '  ';
 | 
|---|
| 1593 |     ftype := TemplateFieldCode2Field(Piece(tmp, U, 3));
 | 
|---|
| 1594 |     if ftype = dftDate then
 | 
|---|
| 1595 |     begin
 | 
|---|
| 1596 |       dtype := TemplateDateCode2DateType(Piece(tmp, U, 5));
 | 
|---|
| 1597 |       //kt output := output + TemplateDateTypeDesc[dtype, short];
 | 
|---|
| 1598 |       output := output + TemplateDateTypeDesc(dtype, short);
 | 
|---|
| 1599 |     end
 | 
|---|
| 1600 |     else
 | 
|---|
| 1601 |       //kt output := output + TemplateFieldTypeDesc[ftype, short];
 | 
|---|
| 1602 |       output := output + TemplateFieldTypeDesc(ftype, short);
 | 
|---|
| 1603 |     SetPiece(tmp, U, 3, output);
 | 
|---|
| 1604 |     sl[i] := tmp;
 | 
|---|
| 1605 |   end;
 | 
|---|
| 1606 | end;
 | 
|---|
| 1607 | 
 | 
|---|
| 1608 | { TTemplateField }
 | 
|---|
| 1609 | 
 | 
|---|
| 1610 | constructor TTemplateField.Create(AData: TStrings);
 | 
|---|
| 1611 | var
 | 
|---|
| 1612 |   tmp, p1: string;
 | 
|---|
| 1613 |   AFID, i,idx,cnt: integer;
 | 
|---|
| 1614 | 
 | 
|---|
| 1615 | begin
 | 
|---|
| 1616 |   AFID := 0;
 | 
|---|
| 1617 |   if(assigned(AData)) then
 | 
|---|
| 1618 |   begin
 | 
|---|
| 1619 |     if AData.Count > 0 then
 | 
|---|
| 1620 |       AFID := StrToIntDef(AData[0],0);
 | 
|---|
| 1621 |     if(AFID > 0) and (AData.Count > 1) then
 | 
|---|
| 1622 |     begin
 | 
|---|
| 1623 |       FID := IntToStr(AFID);
 | 
|---|
| 1624 |       FFldName := Piece(AData[1],U,1);
 | 
|---|
| 1625 |       FFldType := TemplateFieldCode2Field(Piece(AData[1],U,2));
 | 
|---|
| 1626 |       FInactive := (Piece(AData[1],U,3) = '1');
 | 
|---|
| 1627 |       FMaxLen := StrToIntDef(Piece(AData[1],U,4),0);
 | 
|---|
| 1628 |       FEditDefault := Piece(AData[1],U,5);
 | 
|---|
| 1629 |       FLMText := Piece(AData[1],U,6);
 | 
|---|
| 1630 |       idx := StrToIntDef(Piece(AData[1],U,7),0);
 | 
|---|
| 1631 |       cnt := 0;
 | 
|---|
| 1632 |       for i := 2 to AData.Count-1 do
 | 
|---|
| 1633 |       begin
 | 
|---|
| 1634 |         tmp := AData[i];
 | 
|---|
| 1635 |         p1 := Piece(tmp,U,1);
 | 
|---|
| 1636 |         tmp := Piece(tmp,U,2);
 | 
|---|
| 1637 |         if(p1 = 'D') then
 | 
|---|
| 1638 |           FNotes := FNotes + tmp + CRLF
 | 
|---|
| 1639 |         else
 | 
|---|
| 1640 |         if(p1 = 'U') then
 | 
|---|
| 1641 |           FURL := tmp
 | 
|---|
| 1642 |         else
 | 
|---|
| 1643 |         if(p1 = 'I') then
 | 
|---|
| 1644 |         begin
 | 
|---|
| 1645 |           inc(cnt);
 | 
|---|
| 1646 |           FItems := FItems + tmp + CRLF;
 | 
|---|
| 1647 |           if(cnt=idx) then
 | 
|---|
| 1648 |             FItemDefault := tmp;
 | 
|---|
| 1649 |         end;
 | 
|---|
| 1650 |       end;
 | 
|---|
| 1651 |       FRequired  := (Piece(AData[1],U,8) = '1');
 | 
|---|
| 1652 |       FSepLines  := (Piece(AData[1],U,9) = '1');
 | 
|---|
| 1653 |       FTextLen   := StrToIntDef(Piece(AData[1],U,10),0);
 | 
|---|
| 1654 |       FIndent    := StrToIntDef(Piece(AData[1],U,11),0);
 | 
|---|
| 1655 |       FPad       := StrToIntDef(Piece(AData[1],U,12),0);
 | 
|---|
| 1656 |       FMinVal    := StrToIntDef(Piece(AData[1],U,13),0);
 | 
|---|
| 1657 |       FMaxVal    := StrToIntDef(Piece(AData[1],U,14),0);
 | 
|---|
| 1658 |       FIncrement := StrToIntDef(Piece(AData[1],U,15),0);
 | 
|---|
| 1659 |       FDateType  := TemplateDateCode2DateType(Piece(AData[1],U,16));
 | 
|---|
| 1660 |       FModified  := FALSE;
 | 
|---|
| 1661 |       FNameChanged := FALSE;
 | 
|---|
| 1662 |     end;
 | 
|---|
| 1663 |   end;
 | 
|---|
| 1664 |   if(AFID = 0) then
 | 
|---|
| 1665 |   begin
 | 
|---|
| 1666 |     inc(uNewTemplateFieldIDCnt);
 | 
|---|
| 1667 |     FID := IntToStr(-uNewTemplateFieldIDCnt);
 | 
|---|
| 1668 |     FFldName := NewTemplateField;
 | 
|---|
| 1669 |     FModified := TRUE;
 | 
|---|
| 1670 |   end;
 | 
|---|
| 1671 |   if(not assigned(uTmplFlds)) then
 | 
|---|
| 1672 |     uTmplFlds := TList.Create;
 | 
|---|
| 1673 |   uTmplFlds.Add(Self);
 | 
|---|
| 1674 | end;
 | 
|---|
| 1675 | 
 | 
|---|
| 1676 | function TTemplateField.GetTemplateFieldDefault: string;
 | 
|---|
| 1677 | begin
 | 
|---|
| 1678 |     case FFldType of
 | 
|---|
| 1679 |       dftEditBox, dftNumber:  Result := FEditDefault;
 | 
|---|
| 1680 | 
 | 
|---|
| 1681 |       dftComboBox,
 | 
|---|
| 1682 |       dftButton,
 | 
|---|
| 1683 |       dftCheckBoxes,          {Clear out embedded fields}
 | 
|---|
| 1684 |       dftRadioButtons:        Result := StripEmbedded(FItemDefault);
 | 
|---|
| 1685 | 
 | 
|---|
| 1686 |       dftDate:                if FEditDefault <> '' then Result := FEditDefault;
 | 
|---|
| 1687 | 
 | 
|---|
| 1688 |       dftHyperlink, dftText:  if FEditDefault <> '' then
 | 
|---|
| 1689 |                                  Result := StripEmbedded(FEditDefault)
 | 
|---|
| 1690 |                               else
 | 
|---|
| 1691 |                                  Result := URL;
 | 
|---|
| 1692 | 
 | 
|---|
| 1693 |       dftWP:                  Result := Items;
 | 
|---|
| 1694 |     end;
 | 
|---|
| 1695 | end;
 | 
|---|
| 1696 | 
 | 
|---|
| 1697 | procedure TTemplateField.CreateDialogControls(Entry: TTemplateDialogEntry;
 | 
|---|
| 1698 |                                      var Index: Integer; CtrlID: integer);
 | 
|---|
| 1699 | 
 | 
|---|
| 1700 | var
 | 
|---|
| 1701 |   i, Aht, w, tmp, AWdth: integer;
 | 
|---|
| 1702 |   STmp: string;
 | 
|---|
| 1703 |   TmpSL: TStringList;
 | 
|---|
| 1704 |   edt: TEdit;
 | 
|---|
| 1705 |   cbo: TORComboBox;
 | 
|---|
| 1706 |   cb: TORCheckBox;
 | 
|---|
| 1707 |   btn: TfraTemplateFieldButton;
 | 
|---|
| 1708 |   dbox: TORDateBox;
 | 
|---|
| 1709 |   dcbo: TORDateCombo;
 | 
|---|
| 1710 |   lbl: TFieldLabel;
 | 
|---|
| 1711 |   re: TRichEdit;
 | 
|---|
| 1712 |   pnl: TPanel;
 | 
|---|
| 1713 |   ud: TUpDown;
 | 
|---|
| 1714 |   DefDate: TFMDateTime;
 | 
|---|
| 1715 |   ctrl: TControl;
 | 
|---|
| 1716 | 
 | 
|---|
| 1717 |   function wdth: integer;
 | 
|---|
| 1718 |   begin
 | 
|---|
| 1719 |     if(Awdth < 0) then
 | 
|---|
| 1720 |       Awdth := FontWidthPixel(Entry.FFont.Handle);
 | 
|---|
| 1721 |     Result := Awdth;
 | 
|---|
| 1722 |   end;
 | 
|---|
| 1723 | 
 | 
|---|
| 1724 |   function ht: integer;
 | 
|---|
| 1725 |   begin
 | 
|---|
| 1726 |     if(Aht < 0) then
 | 
|---|
| 1727 |       Aht := FontHeightPixel(Entry.FFont.Handle);
 | 
|---|
| 1728 |     Result := Aht;
 | 
|---|
| 1729 |   end;
 | 
|---|
| 1730 | 
 | 
|---|
| 1731 |   procedure UpdateIndents(AControl: TControl);
 | 
|---|
| 1732 |   var
 | 
|---|
| 1733 |     idx: integer;
 | 
|---|
| 1734 | 
 | 
|---|
| 1735 |   begin
 | 
|---|
| 1736 |     if (FIndent > 0) or (FPad > 0) then
 | 
|---|
| 1737 |     begin
 | 
|---|
| 1738 |       idx := Entry.FIndents.IndexOfObject(AControl);
 | 
|---|
| 1739 |       if idx < 0 then
 | 
|---|
| 1740 |         Entry.FIndents.AddObject(IntToStr(FIndent * wdth) + U + IntToStr(FPad), AControl);
 | 
|---|
| 1741 |     end;
 | 
|---|
| 1742 |   end;
 | 
|---|
| 1743 | 
 | 
|---|
| 1744 | begin
 | 
|---|
| 1745 |   if(not FInactive) and (FFldType <> dftUnknown) then
 | 
|---|
| 1746 |   begin
 | 
|---|
| 1747 |     AWdth := -1;
 | 
|---|
| 1748 |     Aht := -1;
 | 
|---|
| 1749 |     ctrl := nil;
 | 
|---|
| 1750 | 
 | 
|---|
| 1751 |     case FFldType of
 | 
|---|
| 1752 |       dftEditBox:
 | 
|---|
| 1753 |         begin
 | 
|---|
| 1754 |           edt := TEdit.Create(nil);
 | 
|---|
| 1755 |           edt.Parent := Entry.FPanel;
 | 
|---|
| 1756 |           edt.BorderStyle := bsNone;
 | 
|---|
| 1757 |           edt.Height := ht;
 | 
|---|
| 1758 |           edt.Width := (wdth * Width + 4);
 | 
|---|
| 1759 |           if FTextLen > 0 then
 | 
|---|
| 1760 |             edt.MaxLength := FTextLen
 | 
|---|
| 1761 |           else
 | 
|---|
| 1762 |             edt.MaxLength := FMaxLen;
 | 
|---|
| 1763 |           edt.Text := FEditDefault;
 | 
|---|
| 1764 |           edt.Tag := CtrlID;
 | 
|---|
| 1765 |           edt.OnChange := Entry.DoChange;
 | 
|---|
| 1766 |           ctrl := edt;
 | 
|---|
| 1767 |         end;
 | 
|---|
| 1768 | 
 | 
|---|
| 1769 |       dftComboBox:
 | 
|---|
| 1770 |         begin
 | 
|---|
| 1771 |           cbo := TORComboBox.Create(nil);
 | 
|---|
| 1772 |           cbo.Parent := Entry.FPanel;
 | 
|---|
| 1773 |           cbo.TemplateField := TRUE;
 | 
|---|
| 1774 |           w := Width;
 | 
|---|
| 1775 |           cbo.MaxLength := w;
 | 
|---|
| 1776 |           if FTextLen > 0 then
 | 
|---|
| 1777 |             cbo.MaxLength := FTextLen
 | 
|---|
| 1778 |           else
 | 
|---|
| 1779 |             cbo.ListItemsOnly := TRUE;
 | 
|---|
| 1780 |           {Clear out embedded fields}
 | 
|---|
| 1781 |           cbo.Items.Text := StripEmbedded(Items);
 | 
|---|
| 1782 |           cbo.SelectByID(StripEmbedded(FItemDefault));
 | 
|---|
| 1783 |           cbo.Tag := CtrlID;
 | 
|---|
| 1784 |           cbo.OnClick := Entry.DoChange;
 | 
|---|
| 1785 | 
 | 
|---|
| 1786 |           if cbo.Items.Count > 12 then
 | 
|---|
| 1787 |           begin
 | 
|---|
| 1788 |             cbo.Width := (wdth * w) + ScrollBarWidth + 8;
 | 
|---|
| 1789 |             cbo.DropDownCount := 12;
 | 
|---|
| 1790 |           end
 | 
|---|
| 1791 |           else
 | 
|---|
| 1792 |           begin
 | 
|---|
| 1793 |             cbo.Width := (wdth * w) + 18;
 | 
|---|
| 1794 |             cbo.DropDownCount := cbo.Items.Count;
 | 
|---|
| 1795 |           end;
 | 
|---|
| 1796 |           ctrl := cbo;
 | 
|---|
| 1797 |         end;
 | 
|---|
| 1798 | 
 | 
|---|
| 1799 |       dftButton:
 | 
|---|
| 1800 |         begin
 | 
|---|
| 1801 |           btn := TfraTemplateFieldButton.Create(nil);
 | 
|---|
| 1802 |           btn.Parent := Entry.FPanel;
 | 
|---|
| 1803 |           {Clear out embedded fields}
 | 
|---|
| 1804 |           btn.Items.Text := StripEmbedded(Items);
 | 
|---|
| 1805 |           btn.ButtonText := StripEmbedded(FItemDefault);
 | 
|---|
| 1806 |           btn.Height := ht;
 | 
|---|
| 1807 |           btn.Width := (wdth * Width) + 6;
 | 
|---|
| 1808 |           btn.Tag := CtrlID;
 | 
|---|
| 1809 |           btn.OnChange := Entry.DoChange;
 | 
|---|
| 1810 |           ctrl := btn;
 | 
|---|
| 1811 |         end;
 | 
|---|
| 1812 | 
 | 
|---|
| 1813 |       dftCheckBoxes, dftRadioButtons:
 | 
|---|
| 1814 |         begin
 | 
|---|
| 1815 |           if FFldType = dftRadioButtons then
 | 
|---|
| 1816 |             inc(uRadioGroupIndex);
 | 
|---|
| 1817 |           TmpSL := TStringList.Create;
 | 
|---|
| 1818 |           try
 | 
|---|
| 1819 |             {Clear out embedded fields}
 | 
|---|
| 1820 |             TmpSL.Text := StripEmbedded(Items);
 | 
|---|
| 1821 |             for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 1822 |             begin
 | 
|---|
| 1823 |               cb := TORCheckBox.Create(nil);
 | 
|---|
| 1824 |               cb.Parent := Entry.FPanel;
 | 
|---|
| 1825 |               cb.Caption := TmpSL[i];
 | 
|---|
| 1826 |               cb.AutoSize := TRUE;
 | 
|---|
| 1827 |               cb.AutoAdjustSize;
 | 
|---|
| 1828 |   //              cb.AutoSize := FALSE;
 | 
|---|
| 1829 |   //              cb.Height := ht;
 | 
|---|
| 1830 |               if FFldType = dftRadioButtons then
 | 
|---|
| 1831 |               begin
 | 
|---|
| 1832 |                 cb.GroupIndex := uRadioGroupIndex;
 | 
|---|
| 1833 |                 cb.RadioStyle := TRUE;
 | 
|---|
| 1834 |               end;
 | 
|---|
| 1835 |               if(TmpSL[i] = StripEmbedded(FItemDefault)) then
 | 
|---|
| 1836 |                 cb.Checked := TRUE;
 | 
|---|
| 1837 |               cb.Tag := CtrlID;
 | 
|---|
| 1838 |               if FSepLines and (FFldType in SepLinesTypes) then
 | 
|---|
| 1839 |                 cb.StringData := NewLine;
 | 
|---|
| 1840 |               cb.OnClick := Entry.DoChange;
 | 
|---|
| 1841 |               inc(Index);
 | 
|---|
| 1842 |               Entry.FControls.InsertObject(Index, '', cb);
 | 
|---|
| 1843 |               if (i=0) or FSepLines then
 | 
|---|
| 1844 |                 UpdateIndents(cb);
 | 
|---|
| 1845 |             end;
 | 
|---|
| 1846 |           finally
 | 
|---|
| 1847 |             TmpSL.Free;
 | 
|---|
| 1848 |           end;
 | 
|---|
| 1849 |         end;
 | 
|---|
| 1850 | 
 | 
|---|
| 1851 |       dftDate:
 | 
|---|
| 1852 |         begin
 | 
|---|
| 1853 |           if FEditDefault <> '' then
 | 
|---|
| 1854 |             DefDate := StrToFMDateTime(FEditDefault)
 | 
|---|
| 1855 |           else
 | 
|---|
| 1856 |             DefDate := 0;
 | 
|---|
| 1857 |           if FDateType in DateComboTypes then
 | 
|---|
| 1858 |           begin
 | 
|---|
| 1859 |             dcbo := TORDateCombo.Create(nil);
 | 
|---|
| 1860 |             dcbo.Parent := Entry.FPanel;
 | 
|---|
| 1861 |             dcbo.Tag := CtrlID;
 | 
|---|
| 1862 |             dcbo.IncludeBtn := (FDateType = dtCombo);
 | 
|---|
| 1863 |             dcbo.IncludeDay := (FDateType = dtCombo);
 | 
|---|
| 1864 |             dcbo.IncludeMonth := (FDateType <> dtYear);
 | 
|---|
| 1865 |             dcbo.FMDate := DefDate;
 | 
|---|
| 1866 |             dcbo.TemplateField := TRUE;
 | 
|---|
| 1867 |             dcbo.OnChange := Entry.DoChange;
 | 
|---|
| 1868 |             ctrl := dcbo;
 | 
|---|
| 1869 |           end
 | 
|---|
| 1870 |           else
 | 
|---|
| 1871 |           begin
 | 
|---|
| 1872 |             dbox := TORDateBox.Create(nil);
 | 
|---|
| 1873 |             dbox.Parent := Entry.FPanel;
 | 
|---|
| 1874 |             dbox.Tag := CtrlID;
 | 
|---|
| 1875 |             dbox.DateOnly := (FDateType = dtDate);
 | 
|---|
| 1876 |             dbox.RequireTime := (FDateType = dtDateReqTime);
 | 
|---|
| 1877 |             dbox.TemplateField := TRUE;
 | 
|---|
| 1878 |             dbox.FMDateTime := DefDate;
 | 
|---|
| 1879 |             if (FDateType = dtDate) then
 | 
|---|
| 1880 |               tmp := 11
 | 
|---|
| 1881 |             else
 | 
|---|
| 1882 |               tmp := 17;
 | 
|---|
| 1883 |             dbox.Width := (wdth * tmp) + 18;
 | 
|---|
| 1884 |             dbox.OnChange := Entry.DoChange;
 | 
|---|
| 1885 |             ctrl := dbox;
 | 
|---|
| 1886 |           end;
 | 
|---|
| 1887 |         end;
 | 
|---|
| 1888 | 
 | 
|---|
| 1889 |       dftNumber:
 | 
|---|
| 1890 |         begin
 | 
|---|
| 1891 |           pnl := TPanel.Create(nil);
 | 
|---|
| 1892 |           pnl.Parent := Entry.FPanel;
 | 
|---|
| 1893 |           pnl.BevelOuter := bvNone;
 | 
|---|
| 1894 |           pnl.Tag := CtrlID;
 | 
|---|
| 1895 |           edt := TEdit.Create(pnl);
 | 
|---|
| 1896 |           edt.Parent := pnl;
 | 
|---|
| 1897 |           edt.BorderStyle := bsNone;
 | 
|---|
| 1898 |           edt.Height := ht;
 | 
|---|
| 1899 |           edt.Width := (wdth * 5 + 4);
 | 
|---|
| 1900 |           edt.Top := 0;
 | 
|---|
| 1901 |           edt.Left := 0;
 | 
|---|
| 1902 |           edt.AutoSelect := True; 
 | 
|---|
| 1903 |           ud := TUpDown.Create(pnl);
 | 
|---|
| 1904 |           ud.Parent := pnl;
 | 
|---|
| 1905 |           ud.Associate := edt;
 | 
|---|
| 1906 |           ud.Min := MinVal;
 | 
|---|
| 1907 |           ud.Max := MaxVal;
 | 
|---|
| 1908 |           ud.Min := MinVal; // Both ud.Min settings are needeed!
 | 
|---|
| 1909 |           i := Increment;
 | 
|---|
| 1910 |           if i < 1 then i := 1;
 | 
|---|
| 1911 |           ud.Increment := i;
 | 
|---|
| 1912 |           ud.Thousands := FALSE;
 | 
|---|
| 1913 |           ud.Position := StrToIntDef(EditDefault, 0);
 | 
|---|
| 1914 |           edt.Tag := Integer(ud);
 | 
|---|
| 1915 |           edt.OnChange := Entry.UpDownChange;
 | 
|---|
| 1916 |           pnl.Height := edt.Height;
 | 
|---|
| 1917 |           pnl.Width := edt.Width + ud.Width;
 | 
|---|
| 1918 |           ctrl := pnl;
 | 
|---|
| 1919 |         end;
 | 
|---|
| 1920 | 
 | 
|---|
| 1921 |       dftHyperlink, dftText:
 | 
|---|
| 1922 |         begin
 | 
|---|
| 1923 |           if (FFldType = dftHyperlink) and User.WebAccess then
 | 
|---|
| 1924 |             lbl := TWebLabel.Create(nil)
 | 
|---|
| 1925 |           else
 | 
|---|
| 1926 |             lbl := TFieldLabel.Create(nil);
 | 
|---|
| 1927 |           lbl.Parent := Entry.FPanel;
 | 
|---|
| 1928 |           lbl.ShowAccelChar := FALSE;
 | 
|---|
| 1929 |           lbl.FExclude := FSepLines;
 | 
|---|
| 1930 |           if (FFldType = dftHyperlink) then
 | 
|---|
| 1931 |           begin
 | 
|---|
| 1932 |             if FEditDefault <> '' then
 | 
|---|
| 1933 |               lbl.Caption := StripEmbedded(FEditDefault)
 | 
|---|
| 1934 |             else
 | 
|---|
| 1935 |               lbl.Caption := URL;
 | 
|---|
| 1936 |           end
 | 
|---|
| 1937 |           else
 | 
|---|
| 1938 |           begin
 | 
|---|
| 1939 |             STmp := StripEmbedded(Items);
 | 
|---|
| 1940 |             if copy(STmp,length(STmp)-1,2) = CRLF then
 | 
|---|
| 1941 |               delete(STmp,length(STmp)-1,2);
 | 
|---|
| 1942 |             lbl.Caption := STmp;
 | 
|---|
| 1943 |           end;
 | 
|---|
| 1944 |           if lbl is TWebLabel then
 | 
|---|
| 1945 |             TWebLabel(lbl).Init(FURL);
 | 
|---|
| 1946 |           lbl.Tag := CtrlID;
 | 
|---|
| 1947 |           ctrl := lbl;
 | 
|---|
| 1948 |         end;
 | 
|---|
| 1949 | 
 | 
|---|
| 1950 |       dftWP:
 | 
|---|
| 1951 |         begin
 | 
|---|
| 1952 |           re := TRichEdit.Create(nil);
 | 
|---|
| 1953 |           re.Parent := Entry.FPanel;
 | 
|---|
| 1954 |           re.Tag := CtrlID;
 | 
|---|
| 1955 |           tmp := FMaxLen;
 | 
|---|
| 1956 |           if tmp < 5 then
 | 
|---|
| 1957 |             tmp := 5;
 | 
|---|
| 1958 |           re.Width := wdth * tmp;
 | 
|---|
| 1959 |           tmp := FTextLen;
 | 
|---|
| 1960 |           if tmp < 2 then
 | 
|---|
| 1961 |             tmp := 2
 | 
|---|
| 1962 |           else
 | 
|---|
| 1963 |           if tmp > MaxTFWPLines then
 | 
|---|
| 1964 |             tmp := MaxTFWPLines;
 | 
|---|
| 1965 |           re.Height := ht * tmp;
 | 
|---|
| 1966 |           re.BorderStyle := bsNone;
 | 
|---|
| 1967 |           re.ScrollBars := ssVertical;
 | 
|---|
| 1968 |           re.Lines.Text := Items;
 | 
|---|
| 1969 |           re.OnChange := Entry.DoChange;
 | 
|---|
| 1970 |           ctrl := re;
 | 
|---|
| 1971 |         end;
 | 
|---|
| 1972 |     end;
 | 
|---|
| 1973 |     if assigned(ctrl) then
 | 
|---|
| 1974 |     begin
 | 
|---|
| 1975 |       inc(Index);
 | 
|---|
| 1976 |       Entry.FControls.InsertObject(Index, '', ctrl);
 | 
|---|
| 1977 |       UpdateIndents(ctrl);
 | 
|---|
| 1978 |     end;
 | 
|---|
| 1979 |   end;
 | 
|---|
| 1980 | end;
 | 
|---|
| 1981 | 
 | 
|---|
| 1982 | function TTemplateField.CanModify: boolean;
 | 
|---|
| 1983 | begin
 | 
|---|
| 1984 |   if((not FModified) and (not FLocked) and (StrToIntDef(FID,0) > 0)) then
 | 
|---|
| 1985 |   begin
 | 
|---|
| 1986 |     FLocked := LockTemplateField(FID);
 | 
|---|
| 1987 |     Result := FLocked;
 | 
|---|
| 1988 |     if(not FLocked) then
 | 
|---|
| 1989 | //    ShowMessage('Template Field ' + FFldName + ' is currently being edited by another user.');  <-- original line.  //kt 8/8/2007
 | 
|---|
| 1990 |       ShowMessage(DKLangConstW('uTemplateFields_Template_Field')+' ' + FFldName + DKLangConstW('uTemplateFields_is_currently_being_edited_by_another_userx')); //kt added 8/8/2007
 | 
|---|
| 1991 |   end
 | 
|---|
| 1992 |   else
 | 
|---|
| 1993 |     Result := TRUE;
 | 
|---|
| 1994 |   if(Result) then FModified := TRUE;
 | 
|---|
| 1995 | end;
 | 
|---|
| 1996 | 
 | 
|---|
| 1997 | procedure TTemplateField.SetEditDefault(const Value: string);
 | 
|---|
| 1998 | begin
 | 
|---|
| 1999 |   if(FEditDefault <> Value) and CanModify then
 | 
|---|
| 2000 |     FEditDefault := Value;
 | 
|---|
| 2001 | end;
 | 
|---|
| 2002 | 
 | 
|---|
| 2003 | procedure TTemplateField.SetFldName(const Value: string);
 | 
|---|
| 2004 | begin
 | 
|---|
| 2005 |   if(FFldName <> Value) and CanModify then
 | 
|---|
| 2006 |   begin
 | 
|---|
| 2007 |     FFldName := Value;
 | 
|---|
| 2008 |     FNameChanged := TRUE;
 | 
|---|
| 2009 |   end;
 | 
|---|
| 2010 | end;
 | 
|---|
| 2011 | 
 | 
|---|
| 2012 | procedure TTemplateField.SetFldType(const Value: TTemplateFieldType);
 | 
|---|
| 2013 | begin
 | 
|---|
| 2014 |   if(FFldType <> Value) and CanModify then
 | 
|---|
| 2015 |   begin
 | 
|---|
| 2016 |     FFldType := Value;
 | 
|---|
| 2017 |     if(Value = dftEditBox) then
 | 
|---|
| 2018 |     begin
 | 
|---|
| 2019 |       if (FMaxLen < 1) then
 | 
|---|
| 2020 |         FMaxLen := 1;
 | 
|---|
| 2021 |       if FTextLen < FMaxLen then
 | 
|---|
| 2022 |         FTextLen := FMaxLen;
 | 
|---|
| 2023 |     end
 | 
|---|
| 2024 |     else
 | 
|---|
| 2025 |     if(Value = dftHyperlink) and (FURL = '') then
 | 
|---|
| 2026 |       FURL := 'http://'
 | 
|---|
| 2027 |     else
 | 
|---|
| 2028 |     if(Value = dftComboBox) and (FMaxLen < 1) then
 | 
|---|
| 2029 |     begin
 | 
|---|
| 2030 |       FMaxLen := Width;
 | 
|---|
| 2031 |       if FMaxLen < 1 then
 | 
|---|
| 2032 |         FMaxLen := 1;
 | 
|---|
| 2033 |     end
 | 
|---|
| 2034 |     else
 | 
|---|
| 2035 |     if(Value = dftWP) then
 | 
|---|
| 2036 |     begin
 | 
|---|
| 2037 |       if (FMaxLen = 0) then
 | 
|---|
| 2038 |         FMaxLen := MAX_ENTRY_WIDTH
 | 
|---|
| 2039 |       else
 | 
|---|
| 2040 |       if (FMaxLen < 5) then
 | 
|---|
| 2041 |           FMaxLen := 5;
 | 
|---|
| 2042 |       if FTextLen < 2 then
 | 
|---|
| 2043 |         FTextLen := 2;
 | 
|---|
| 2044 |     end
 | 
|---|
| 2045 |     else
 | 
|---|
| 2046 |     if(Value = dftDate) and (FDateType = dtUnknown) then
 | 
|---|
| 2047 |       FDateType := dtDate;
 | 
|---|
| 2048 |   end;
 | 
|---|
| 2049 | end;
 | 
|---|
| 2050 | 
 | 
|---|
| 2051 | procedure TTemplateField.SetID(const Value: string);
 | 
|---|
| 2052 | begin
 | 
|---|
| 2053 | //  if(FID <> Value) and CanModify then
 | 
|---|
| 2054 |     FID := Value;
 | 
|---|
| 2055 | end;
 | 
|---|
| 2056 | 
 | 
|---|
| 2057 | procedure TTemplateField.SetInactive(const Value: boolean);
 | 
|---|
| 2058 | begin
 | 
|---|
| 2059 |   if(FInactive <> Value) and CanModify then
 | 
|---|
| 2060 |     FInactive := Value;
 | 
|---|
| 2061 | end;
 | 
|---|
| 2062 | 
 | 
|---|
| 2063 | procedure TTemplateField.SetItemDefault(const Value: string);
 | 
|---|
| 2064 | begin
 | 
|---|
| 2065 |   if(FItemDefault <> Value) and CanModify then
 | 
|---|
| 2066 |     FItemDefault := Value;
 | 
|---|
| 2067 | end;
 | 
|---|
| 2068 | 
 | 
|---|
| 2069 | procedure TTemplateField.SetItems(const Value: string);
 | 
|---|
| 2070 | begin
 | 
|---|
| 2071 |   if(FItems <> Value) and CanModify then
 | 
|---|
| 2072 |     FItems := Value;
 | 
|---|
| 2073 | end;
 | 
|---|
| 2074 | 
 | 
|---|
| 2075 | procedure TTemplateField.SetLMText(const Value: string);
 | 
|---|
| 2076 | begin
 | 
|---|
| 2077 |   if(FLMText <> Value) and CanModify then
 | 
|---|
| 2078 |     FLMText := Value;
 | 
|---|
| 2079 | end;
 | 
|---|
| 2080 | 
 | 
|---|
| 2081 | procedure TTemplateField.SetMaxLen(const Value: integer);
 | 
|---|
| 2082 | begin
 | 
|---|
| 2083 |   if(FMaxLen <> Value) and CanModify then
 | 
|---|
| 2084 |     FMaxLen := Value;
 | 
|---|
| 2085 | end;
 | 
|---|
| 2086 | 
 | 
|---|
| 2087 | procedure TTemplateField.SetNotes(const Value: string);
 | 
|---|
| 2088 | begin
 | 
|---|
| 2089 |   if(FNotes <> Value) and CanModify then
 | 
|---|
| 2090 |     FNotes := Value;
 | 
|---|
| 2091 | end;
 | 
|---|
| 2092 | 
 | 
|---|
| 2093 | function TTemplateField.SaveError: string;
 | 
|---|
| 2094 | var
 | 
|---|
| 2095 |   TmpSL, FldSL: TStringList;
 | 
|---|
| 2096 |   AID,Res: string;
 | 
|---|
| 2097 |   idx, i: integer;
 | 
|---|
| 2098 |   IEN64: Int64;
 | 
|---|
| 2099 |   NewRec: boolean;
 | 
|---|
| 2100 | 
 | 
|---|
| 2101 | begin
 | 
|---|
| 2102 |   if(FFldName = NewTemplateField) then
 | 
|---|
| 2103 |   begin
 | 
|---|
| 2104 | //  Result := 'Template Field can not be named "' + NewTemplateField + '"';  <-- original line.  //kt 8/8/2007
 | 
|---|
| 2105 |     Result := DKLangConstW('uTemplateFields_Template_Field_can_not_be_named_x') + NewTemplateField + '"'; //kt added 8/8/2007
 | 
|---|
| 2106 |     exit;
 | 
|---|
| 2107 |   end;
 | 
|---|
| 2108 |   Result := '';
 | 
|---|
| 2109 |   NewRec := (StrToIntDef(FID,0) < 0);
 | 
|---|
| 2110 |   if(FModified or NewRec) then
 | 
|---|
| 2111 |   begin
 | 
|---|
| 2112 |     TmpSL := TStringList.Create;
 | 
|---|
| 2113 |     try
 | 
|---|
| 2114 |       FldSL := TStringList.Create;
 | 
|---|
| 2115 |       try
 | 
|---|
| 2116 |         if(StrToIntDef(FID,0) > 0) then
 | 
|---|
| 2117 |           AID := FID
 | 
|---|
| 2118 |         else
 | 
|---|
| 2119 |           AID := '0';
 | 
|---|
| 2120 |         FldSL.Add('.01='+FFldName);
 | 
|---|
| 2121 |         FldSL.Add('.02='+TemplateFieldTypeCodes[FFldType]);
 | 
|---|
| 2122 |         FldSL.Add('.03='+BOOLCHAR[FInactive]);
 | 
|---|
| 2123 |         FldSL.Add('.04='+IntToStr(FMaxLen));
 | 
|---|
| 2124 |         FldSL.Add('.05='+FEditDefault);
 | 
|---|
| 2125 |         FldSL.Add('.06='+FLMText);
 | 
|---|
| 2126 |         idx := -1;
 | 
|---|
| 2127 |         if(FItems <> '') and (FItemDefault <> '') then
 | 
|---|
| 2128 |         begin
 | 
|---|
| 2129 |           TmpSL.Text := FItems;
 | 
|---|
| 2130 |           for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 2131 |             if(FItemDefault = TmpSL[i]) then
 | 
|---|
| 2132 |             begin
 | 
|---|
| 2133 |               idx := i;
 | 
|---|
| 2134 |               break;
 | 
|---|
| 2135 |             end;
 | 
|---|
| 2136 |         end;
 | 
|---|
| 2137 |         FldSL.Add('.07='+IntToStr(Idx+1));
 | 
|---|
| 2138 |         FldSL.Add('.08='+BOOLCHAR[fRequired]);
 | 
|---|
| 2139 |         FldSL.Add('.09='+BOOLCHAR[fSepLines]);
 | 
|---|
| 2140 |         FldSL.Add('.1=' +IntToStr(FTextLen));
 | 
|---|
| 2141 |         FldSL.Add('.11='+IntToStr(FIndent));
 | 
|---|
| 2142 |         FldSL.Add('.12='+IntToStr(FPad));
 | 
|---|
| 2143 |         FldSL.Add('.13='+IntToStr(FMinVal));
 | 
|---|
| 2144 |         FldSL.Add('.14='+IntToStr(FMaxVal));
 | 
|---|
| 2145 |         FldSL.Add('.15='+IntToStr(FIncrement));
 | 
|---|
| 2146 |         if FDateType = dtUnknown then
 | 
|---|
| 2147 |           FldSL.Add('.16=@')
 | 
|---|
| 2148 |         else
 | 
|---|
| 2149 |           FldSL.Add('.16='+TemplateFieldDateCodes[FDateType]);
 | 
|---|
| 2150 | 
 | 
|---|
| 2151 |         if FURL='' then
 | 
|---|
| 2152 |           FldSL.Add('3=@')
 | 
|---|
| 2153 |         else
 | 
|---|
| 2154 |           FldSL.Add('3='+FURL);
 | 
|---|
| 2155 | 
 | 
|---|
| 2156 |         if(FNotes <> '') or (not NewRec) then
 | 
|---|
| 2157 |         begin
 | 
|---|
| 2158 |           if(FNotes = '') then
 | 
|---|
| 2159 |             FldSL.Add('2,1=@')
 | 
|---|
| 2160 |           else
 | 
|---|
| 2161 |           begin
 | 
|---|
| 2162 |             TmpSL.Text := FNotes;
 | 
|---|
| 2163 |             for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 2164 |               FldSL.Add('2,'+IntToStr(i+1)+',0='+TmpSL[i]);
 | 
|---|
| 2165 |           end;
 | 
|---|
| 2166 |         end;
 | 
|---|
| 2167 |         if((FItems <> '') or (not NewRec)) then
 | 
|---|
| 2168 |         begin
 | 
|---|
| 2169 |           if(FItems = '') then
 | 
|---|
| 2170 |             FldSL.Add('10,1=@')
 | 
|---|
| 2171 |           else
 | 
|---|
| 2172 |           begin
 | 
|---|
| 2173 |             TmpSL.Text := FItems;
 | 
|---|
| 2174 |             for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 2175 |               FldSL.Add('10,'+IntToStr(i+1)+',0='+TmpSL[i]);
 | 
|---|
| 2176 |           end;
 | 
|---|
| 2177 |         end;
 | 
|---|
| 2178 | 
 | 
|---|
| 2179 |         Res := UpdateTemplateField(AID, FldSL);
 | 
|---|
| 2180 |         IEN64 := StrToInt64Def(Piece(Res,U,1),0);
 | 
|---|
| 2181 |         if(IEN64 > 0) then
 | 
|---|
| 2182 |         begin
 | 
|---|
| 2183 |           if(NewRec) then
 | 
|---|
| 2184 |             FID := IntToStr(IEN64)
 | 
|---|
| 2185 |           else
 | 
|---|
| 2186 |             UnlockTemplateField(FID);
 | 
|---|
| 2187 |           FModified := FALSE;
 | 
|---|
| 2188 |           FNameChanged := FALSE;
 | 
|---|
| 2189 |           FLocked := FALSE;
 | 
|---|
| 2190 |         end
 | 
|---|
| 2191 |         else
 | 
|---|
| 2192 |           Result := Piece(Res, U, 2);
 | 
|---|
| 2193 |       finally
 | 
|---|
| 2194 |         FldSL.Free;
 | 
|---|
| 2195 |       end;
 | 
|---|
| 2196 |     finally
 | 
|---|
| 2197 |       TmpSL.Free;
 | 
|---|
| 2198 |     end;
 | 
|---|
| 2199 |   end;
 | 
|---|
| 2200 | end;
 | 
|---|
| 2201 | 
 | 
|---|
| 2202 | procedure TTemplateField.Assign(AFld: TTemplateField);
 | 
|---|
| 2203 | begin
 | 
|---|
| 2204 |   FMaxLen        := AFld.FMaxLen;
 | 
|---|
| 2205 |   FFldName       := AFld.FFldName;
 | 
|---|
| 2206 |   FLMText        := AFld.FLMText;
 | 
|---|
| 2207 |   FEditDefault   := AFld.FEditDefault;
 | 
|---|
| 2208 |   FNotes         := AFld.FNotes;
 | 
|---|
| 2209 |   FItems         := AFld.FItems;
 | 
|---|
| 2210 |   FInactive      := AFld.FInactive;
 | 
|---|
| 2211 |   FItemDefault   := AFld.FItemDefault;
 | 
|---|
| 2212 |   FFldType       := AFld.FFldType;
 | 
|---|
| 2213 |   FRequired      := AFld.FRequired;
 | 
|---|
| 2214 |   FSepLines      := AFld.FSepLines;
 | 
|---|
| 2215 |   FTextLen       := AFld.FTextLen;
 | 
|---|
| 2216 |   FIndent        := AFld.FIndent;
 | 
|---|
| 2217 |   FPad           := AFld.FPad;
 | 
|---|
| 2218 |   FMinVal        := AFld.FMinVal;
 | 
|---|
| 2219 |   FMaxVal        := AFld.FMaxVal;
 | 
|---|
| 2220 |   FIncrement     := AFld.FIncrement;
 | 
|---|
| 2221 |   FDateType      := AFld.FDateType;
 | 
|---|
| 2222 |   FURL           := AFld.FURL;
 | 
|---|
| 2223 | end;
 | 
|---|
| 2224 | 
 | 
|---|
| 2225 | function TTemplateField.Width: integer;
 | 
|---|
| 2226 | var
 | 
|---|
| 2227 |   i, ilen: integer;
 | 
|---|
| 2228 |   TmpSL: TStringList;
 | 
|---|
| 2229 | 
 | 
|---|
| 2230 | begin
 | 
|---|
| 2231 |   if(FFldType = dftEditBox) then
 | 
|---|
| 2232 |     Result := FMaxLen
 | 
|---|
| 2233 |   else
 | 
|---|
| 2234 |   begin
 | 
|---|
| 2235 |     if FMaxLen > 0 then
 | 
|---|
| 2236 |       Result := FMaxLen
 | 
|---|
| 2237 |     else
 | 
|---|
| 2238 |     begin
 | 
|---|
| 2239 |       Result := -1;
 | 
|---|
| 2240 |       TmpSL := TStringList.Create;
 | 
|---|
| 2241 |       try
 | 
|---|
| 2242 |         TmpSL.Text := StripEmbedded(FItems);
 | 
|---|
| 2243 |         for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 2244 |         begin
 | 
|---|
| 2245 |           ilen := length(TmpSL[i]);
 | 
|---|
| 2246 |           if(Result < ilen) then
 | 
|---|
| 2247 |             Result := ilen;
 | 
|---|
| 2248 |         end;
 | 
|---|
| 2249 |       finally
 | 
|---|
| 2250 |         TmpSL.Free;
 | 
|---|
| 2251 |       end;
 | 
|---|
| 2252 |     end;
 | 
|---|
| 2253 |   end;
 | 
|---|
| 2254 |   if Result > MaxTFEdtLen then
 | 
|---|
| 2255 |     Result := MaxTFEdtLen;
 | 
|---|
| 2256 | end;
 | 
|---|
| 2257 | 
 | 
|---|
| 2258 | destructor TTemplateField.Destroy;
 | 
|---|
| 2259 | begin
 | 
|---|
| 2260 |   uTmplFlds.Remove(Self);
 | 
|---|
| 2261 |   inherited;
 | 
|---|
| 2262 | end;
 | 
|---|
| 2263 | 
 | 
|---|
| 2264 | procedure TTemplateField.SetRequired(const Value: boolean);
 | 
|---|
| 2265 | begin
 | 
|---|
| 2266 |   if(FRequired <> Value) and CanModify then
 | 
|---|
| 2267 |     FRequired := Value;
 | 
|---|
| 2268 | end;
 | 
|---|
| 2269 | 
 | 
|---|
| 2270 | function TTemplateField.NewField: boolean;
 | 
|---|
| 2271 | begin
 | 
|---|
| 2272 |   Result := (StrToIntDef(FID,0) <= 0);
 | 
|---|
| 2273 | end;
 | 
|---|
| 2274 | 
 | 
|---|
| 2275 | procedure TTemplateField.SetSepLines(const Value: boolean);
 | 
|---|
| 2276 | begin
 | 
|---|
| 2277 |   if(FSepLines <> Value) and CanModify then
 | 
|---|
| 2278 |     FSepLines := Value
 | 
|---|
| 2279 | end;
 | 
|---|
| 2280 | 
 | 
|---|
| 2281 | procedure TTemplateField.SetIncrement(const Value: integer);
 | 
|---|
| 2282 | begin
 | 
|---|
| 2283 |   if(FIncrement <> Value) and CanModify then
 | 
|---|
| 2284 |     FIncrement := Value;
 | 
|---|
| 2285 | end;
 | 
|---|
| 2286 | 
 | 
|---|
| 2287 | procedure TTemplateField.SetIndent(const Value: integer);
 | 
|---|
| 2288 | begin
 | 
|---|
| 2289 |   if(FIndent <> Value) and CanModify then
 | 
|---|
| 2290 |     FIndent := Value;
 | 
|---|
| 2291 | end;
 | 
|---|
| 2292 | 
 | 
|---|
| 2293 | procedure TTemplateField.SetMaxVal(const Value: integer);
 | 
|---|
| 2294 | begin
 | 
|---|
| 2295 |   if(FMaxVal <> Value) and CanModify then
 | 
|---|
| 2296 |     FMaxVal := Value;
 | 
|---|
| 2297 | end;
 | 
|---|
| 2298 | 
 | 
|---|
| 2299 | procedure TTemplateField.SetMinVal(const Value: integer);
 | 
|---|
| 2300 | begin
 | 
|---|
| 2301 |   if(FMinVal <> Value) and CanModify then
 | 
|---|
| 2302 |     FMinVal := Value;
 | 
|---|
| 2303 | end;
 | 
|---|
| 2304 | 
 | 
|---|
| 2305 | procedure TTemplateField.SetPad(const Value: integer);
 | 
|---|
| 2306 | begin
 | 
|---|
| 2307 |   if(FPad <> Value) and CanModify then
 | 
|---|
| 2308 |     FPad := Value;
 | 
|---|
| 2309 | end;
 | 
|---|
| 2310 | 
 | 
|---|
| 2311 | procedure TTemplateField.SetTextLen(const Value: integer);
 | 
|---|
| 2312 | begin
 | 
|---|
| 2313 |   if(FTextLen <> Value) and CanModify then
 | 
|---|
| 2314 |     FTextLen := Value;
 | 
|---|
| 2315 | end;
 | 
|---|
| 2316 | 
 | 
|---|
| 2317 | procedure TTemplateField.SetURL(const Value: string);
 | 
|---|
| 2318 | begin
 | 
|---|
| 2319 |   if(FURL <> Value) and CanModify then
 | 
|---|
| 2320 |     FURL := Value;
 | 
|---|
| 2321 | end;
 | 
|---|
| 2322 | 
 | 
|---|
| 2323 | function TTemplateField.GetRequired: boolean;
 | 
|---|
| 2324 | begin
 | 
|---|
| 2325 |   if FFldType in NoRequired then
 | 
|---|
| 2326 |     Result := FALSE
 | 
|---|
| 2327 |   else
 | 
|---|
| 2328 |     Result := FRequired;
 | 
|---|
| 2329 | end;
 | 
|---|
| 2330 | 
 | 
|---|
| 2331 | procedure TTemplateField.SetDateType(const Value: TTmplFldDateType);
 | 
|---|
| 2332 | begin
 | 
|---|
| 2333 |   if(FDateType <> Value) and CanModify then
 | 
|---|
| 2334 |     FDateType := Value;
 | 
|---|
| 2335 | end;
 | 
|---|
| 2336 | 
 | 
|---|
| 2337 | { TTemplateDialogEntry }
 | 
|---|
| 2338 | const
 | 
|---|
| 2339 |   EOL_MARKER = #182;
 | 
|---|
| 2340 | 
 | 
|---|
| 2341 | procedure PanelDestroy(AData: Pointer; Sender: TObject);
 | 
|---|
| 2342 | var
 | 
|---|
| 2343 |   idx: integer;
 | 
|---|
| 2344 |   dlg: TTemplateDialogEntry;
 | 
|---|
| 2345 | 
 | 
|---|
| 2346 | begin
 | 
|---|
| 2347 |   dlg := TTemplateDialogEntry(AData);
 | 
|---|
| 2348 |   idx := uEntries.IndexOf(dlg.FID);
 | 
|---|
| 2349 |   if(idx >= 0) then
 | 
|---|
| 2350 |     uEntries.Delete(idx);
 | 
|---|
| 2351 |   dlg.FPanelDying := TRUE;
 | 
|---|
| 2352 |   dlg.Free;
 | 
|---|
| 2353 | end;
 | 
|---|
| 2354 | 
 | 
|---|
| 2355 | constructor TTemplateDialogEntry.Create(AParent: TWinControl; AID, Text: string);
 | 
|---|
| 2356 | var
 | 
|---|
| 2357 |   CtrlID, idx, i, j, flen: integer;
 | 
|---|
| 2358 |   txt, FldName: string;
 | 
|---|
| 2359 |   Fld: TTemplateField;
 | 
|---|
| 2360 | 
 | 
|---|
| 2361 | begin
 | 
|---|
| 2362 |   FID := AID;
 | 
|---|
| 2363 |   FText := Text;
 | 
|---|
| 2364 |   FHTMLMode := false; //kt added 12/28/09
 | 
|---|
| 2365 |   FControls := TStringList.Create;
 | 
|---|
| 2366 |   FIndents := TStringList.Create;
 | 
|---|
| 2367 |   FFont := TFont.Create;
 | 
|---|
| 2368 |   FFont.Assign(TORExposedControl(AParent).Font);
 | 
|---|
| 2369 |   FControls.Text := Text;
 | 
|---|
| 2370 |   if(FControls.Count > 1) then
 | 
|---|
| 2371 |     for i := 1 to FControls.Count-1 do
 | 
|---|
| 2372 |       FControls[i] := EOL_MARKER + FControls[i];
 | 
|---|
| 2373 |   FFirstBuild := TRUE;
 | 
|---|
| 2374 |   FPanel := TFieldPanel.Create(AParent.Owner);
 | 
|---|
| 2375 |   FPanel.Parent := AParent;
 | 
|---|
| 2376 |   FPanel.BevelOuter := bvNone;
 | 
|---|
| 2377 |   FPanel.Caption := '';
 | 
|---|
| 2378 |   FPanel.Font.Assign(FFont);
 | 
|---|
| 2379 |   idx := 0;
 | 
|---|
| 2380 |   while (idx < FControls.Count) do
 | 
|---|
| 2381 |   begin
 | 
|---|
| 2382 |     txt := FControls[idx];
 | 
|---|
| 2383 |     i := pos(TemplateFieldBeginSignature, txt);
 | 
|---|
| 2384 |     if(i > 0) then
 | 
|---|
| 2385 |     begin
 | 
|---|
| 2386 |       if(copy(txt, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
 | 
|---|
| 2387 |       begin
 | 
|---|
| 2388 |         CtrlID := StrToIntDef(copy(txt, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
 | 
|---|
| 2389 |         delete(txt,i + TemplateFieldSignatureLen, FieldIDLen);
 | 
|---|
| 2390 |       end
 | 
|---|
| 2391 |       else
 | 
|---|
| 2392 |         CtrlID := 0;
 | 
|---|
| 2393 |       j := pos(TemplateFieldEndSignature, copy(txt, i + TemplateFieldSignatureLen, MaxInt));
 | 
|---|
| 2394 |       if(j > 0) then
 | 
|---|
| 2395 |       begin
 | 
|---|
| 2396 |         inc(j, i + TemplateFieldSignatureLen - 1);
 | 
|---|
| 2397 |         flen := j - i - TemplateFieldSignatureLen;
 | 
|---|
| 2398 |         FldName := copy(txt, i + TemplateFieldSignatureLen, flen);
 | 
|---|
| 2399 |         Fld := GetTemplateField(FldName, FALSE);
 | 
|---|
| 2400 |         delete(txt,i,flen + TemplateFieldSignatureLen + 1);
 | 
|---|
| 2401 |         if(assigned(Fld)) then
 | 
|---|
| 2402 |         begin
 | 
|---|
| 2403 |           FControls[idx] := copy(txt,1,i-1);
 | 
|---|
| 2404 |           if(Fld.Required) then
 | 
|---|
| 2405 |             FControls[idx] := FControls[idx] + '*';
 | 
|---|
| 2406 |           Fld.CreateDialogControls(Self, idx, CtrlID);
 | 
|---|
| 2407 |           FControls.Insert(idx+1,copy(txt,i,MaxInt));
 | 
|---|
| 2408 |         end
 | 
|---|
| 2409 |         else
 | 
|---|
| 2410 |         begin
 | 
|---|
| 2411 |           FControls[idx] := txt;
 | 
|---|
| 2412 |           dec(idx);
 | 
|---|
| 2413 |         end;
 | 
|---|
| 2414 |       end
 | 
|---|
| 2415 |       else
 | 
|---|
| 2416 |       begin
 | 
|---|
| 2417 |         delete(txt,i,TemplateFieldSignatureLen);
 | 
|---|
| 2418 |         FControls[idx] := txt;
 | 
|---|
| 2419 |         dec(idx);
 | 
|---|
| 2420 |       end;
 | 
|---|
| 2421 |     end;
 | 
|---|
| 2422 |     inc(idx);
 | 
|---|
| 2423 |   end;
 | 
|---|
| 2424 | end;
 | 
|---|
| 2425 | 
 | 
|---|
| 2426 | destructor TTemplateDialogEntry.Destroy;
 | 
|---|
| 2427 | begin
 | 
|---|
| 2428 |   if assigned(FOnDestroy) then
 | 
|---|
| 2429 |     FOnDestroy(Self);
 | 
|---|
| 2430 |   KillLabels;
 | 
|---|
| 2431 |   KillObj(@FControls, TRUE);
 | 
|---|
| 2432 |   if FPanelDying then
 | 
|---|
| 2433 |     FPanel := nil
 | 
|---|
| 2434 |   else
 | 
|---|
| 2435 |     FreeAndNil(FPanel);
 | 
|---|
| 2436 |   FreeAndNil(FFont);
 | 
|---|
| 2437 |   FreeAndNil(FIndents);
 | 
|---|
| 2438 |   inherited;
 | 
|---|
| 2439 | end;
 | 
|---|
| 2440 | 
 | 
|---|
| 2441 | procedure TTemplateDialogEntry.DoChange(Sender: TObject);
 | 
|---|
| 2442 | begin
 | 
|---|
| 2443 |   if (not FUpdating) and assigned(FOnChange) then
 | 
|---|
| 2444 |     FOnChange(Self);
 | 
|---|
| 2445 | end;
 | 
|---|
| 2446 | 
 | 
|---|
| 2447 | function TTemplateDialogEntry.GetControlText(CtrlID: integer; NoCommas: boolean;
 | 
|---|
| 2448 |                             var FoundEntry: boolean; AutoWrap: boolean;
 | 
|---|
| 2449 |                             emField: string = ''): string;
 | 
|---|
| 2450 | var
 | 
|---|
| 2451 |   x, i, j, ind, idx: integer;
 | 
|---|
| 2452 |   Ctrl: TControl;
 | 
|---|
| 2453 |   Done: boolean;
 | 
|---|
| 2454 |   iString: string;
 | 
|---|
| 2455 |   iField: TTemplateField;
 | 
|---|
| 2456 |   iTemp: TStringList;
 | 
|---|
| 2457 | 
 | 
|---|
| 2458 |   function GetOriginalItem(istr: string): string;
 | 
|---|
| 2459 |   begin
 | 
|---|
| 2460 |     Result := '';
 | 
|---|
| 2461 |     if emField <> '' then
 | 
|---|
| 2462 |       begin
 | 
|---|
| 2463 |         iField := GetTemplateField(emField,FALSE);
 | 
|---|
| 2464 |         iTemp := nil;
 | 
|---|
| 2465 |         if ifield <> nil then
 | 
|---|
| 2466 |           try
 | 
|---|
| 2467 |             iTemp := TStringList.Create;
 | 
|---|
| 2468 |             iTemp.Text := StripEmbedded(iField.Items);
 | 
|---|
| 2469 |             x := iTemp.IndexOf(istr);
 | 
|---|
| 2470 |             if x >= 0 then
 | 
|---|
| 2471 |               begin
 | 
|---|
| 2472 |               iTemp.Text := iField.Items;
 | 
|---|
| 2473 |               Result := iTemp.Strings[x];
 | 
|---|
| 2474 |               end;
 | 
|---|
| 2475 |           finally
 | 
|---|
| 2476 |             iTemp.Free;
 | 
|---|
| 2477 |           end;
 | 
|---|
| 2478 |       end;
 | 
|---|
| 2479 |   end;
 | 
|---|
| 2480 | 
 | 
|---|
| 2481 | 
 | 
|---|
| 2482 | begin
 | 
|---|
| 2483 |   Result := '';
 | 
|---|
| 2484 |   Done := FALSE;
 | 
|---|
| 2485 |   ind := -1;
 | 
|---|
| 2486 |   for i := 0 to FControls.Count-1 do
 | 
|---|
| 2487 |   begin
 | 
|---|
| 2488 |     Ctrl := TControl(FControls.Objects[i]);
 | 
|---|
| 2489 |     if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
 | 
|---|
| 2490 |     begin
 | 
|---|
| 2491 |       FoundEntry := TRUE;
 | 
|---|
| 2492 |       Done := TRUE;
 | 
|---|
| 2493 |       if ind < 0 then
 | 
|---|
| 2494 |       begin
 | 
|---|
| 2495 |         idx := FIndents.IndexOfObject(Ctrl);
 | 
|---|
| 2496 |         if idx >= 0 then
 | 
|---|
| 2497 |           ind := StrToIntDef(Piece(FIndents[idx], U, 2), 0)
 | 
|---|
| 2498 |         else
 | 
|---|
| 2499 |           ind := 0;
 | 
|---|
| 2500 |       end;
 | 
|---|
| 2501 |       if(Ctrl is TFieldLabel) then
 | 
|---|
| 2502 |       begin
 | 
|---|
| 2503 |         if not TFieldLabel(Ctrl).Exclude then begin
 | 
|---|
| 2504 |           if emField <> '' then begin
 | 
|---|
| 2505 |             iField := GetTemplateField(emField,FALSE);
 | 
|---|
| 2506 |             case iField.FldType of
 | 
|---|
| 2507 |               dftHyperlink: if iField.EditDefault <> '' then
 | 
|---|
| 2508 |                               Result := iField.EditDefault
 | 
|---|
| 2509 |                             else
 | 
|---|
| 2510 |                               Result := iField.URL;
 | 
|---|
| 2511 |               dftText:      begin
 | 
|---|
| 2512 |                               iString := iField.Items;
 | 
|---|
| 2513 |                               if copy(iString,length(iString)-1,2) = CRLF then
 | 
|---|
| 2514 |                                 delete(iString,length(iString)-1,2);
 | 
|---|
| 2515 |                               Result := iString;
 | 
|---|
| 2516 |                             end;
 | 
|---|
| 2517 |             else {case}
 | 
|---|
| 2518 |               Result := TFieldLabel(Ctrl).Caption
 | 
|---|
| 2519 |             end; {case iField.FldType}
 | 
|---|
| 2520 |             end {if emField}
 | 
|---|
| 2521 |           else
 | 
|---|
| 2522 |             Result := TFieldLabel(Ctrl).Caption;
 | 
|---|
| 2523 |         end;
 | 
|---|
| 2524 |       end
 | 
|---|
| 2525 |       else
 | 
|---|
| 2526 |       if(Ctrl is TEdit) then
 | 
|---|
| 2527 |         Result := TEdit(Ctrl).Text
 | 
|---|
| 2528 |       else
 | 
|---|
| 2529 |       if(Ctrl is TORComboBox) then begin
 | 
|---|
| 2530 |         Result := TORComboBox(Ctrl).Text;
 | 
|---|
| 2531 |         iString := GetOriginalItem(Result);
 | 
|---|
| 2532 |         if iString <> '' then
 | 
|---|
| 2533 |           Result := iString;
 | 
|---|
| 2534 |         end
 | 
|---|
| 2535 |       else
 | 
|---|
| 2536 |       if(Ctrl is TORDateCombo) then
 | 
|---|
| 2537 |         Result := TORDateCombo(Ctrl).Text + ':' + FloatToStr(TORDateCombo(Ctrl).FMDate)
 | 
|---|
| 2538 |       else
 | 
|---|
| 2539 |       if(Ctrl is TORDateBox) then
 | 
|---|
| 2540 |         Result := TORDateBox(Ctrl).Text
 | 
|---|
| 2541 |       else
 | 
|---|
| 2542 |       if(Ctrl is TRichEdit) then
 | 
|---|
| 2543 |       begin
 | 
|---|
| 2544 |         if((ind = 0) and (not AutoWrap)) then
 | 
|---|
| 2545 |           Result := TRichEdit(Ctrl).Lines.Text
 | 
|---|
| 2546 |         else
 | 
|---|
| 2547 |         begin
 | 
|---|
| 2548 |           for j := 0 to TRichEdit(Ctrl).Lines.Count-1 do
 | 
|---|
| 2549 |           begin
 | 
|---|
| 2550 |             if AutoWrap then
 | 
|---|
| 2551 |             begin
 | 
|---|
| 2552 |               if(Result <> '') then
 | 
|---|
| 2553 |                 Result := Result + ' ';
 | 
|---|
| 2554 |               Result := Result + TRichEdit(Ctrl).Lines[j];
 | 
|---|
| 2555 |             end
 | 
|---|
| 2556 |             else
 | 
|---|
| 2557 |             begin
 | 
|---|
| 2558 |               if(Result <> '') then
 | 
|---|
| 2559 |                 Result := Result + CRLF;
 | 
|---|
| 2560 |               Result := Result + StringOfChar(' ', ind) + TRichEdit(Ctrl).Lines[j];
 | 
|---|
| 2561 |             end;
 | 
|---|
| 2562 |           end;
 | 
|---|
| 2563 |           ind := 0;
 | 
|---|
| 2564 |         end;
 | 
|---|
| 2565 |       end
 | 
|---|
| 2566 |       else
 | 
|---|
| 2567 |       if(Ctrl is TORCheckBox) then
 | 
|---|
| 2568 |       begin
 | 
|---|
| 2569 |         Done := FALSE;
 | 
|---|
| 2570 |         if(TORCheckBox(Ctrl).Checked) then
 | 
|---|
| 2571 |         begin
 | 
|---|
| 2572 |           if(Result <> '') then
 | 
|---|
| 2573 |           begin
 | 
|---|
| 2574 |             if NoCommas then
 | 
|---|
| 2575 |               Result := Result + '|'
 | 
|---|
| 2576 |             else
 | 
|---|
| 2577 |               Result := Result + ', ';
 | 
|---|
| 2578 |           end;
 | 
|---|
| 2579 |           iString := GetOriginalItem(TORCheckBox(Ctrl).Caption);
 | 
|---|
| 2580 |           if iString <> '' then
 | 
|---|
| 2581 |             Result := Result + iString
 | 
|---|
| 2582 |           else
 | 
|---|
| 2583 |             Result := Result + TORCheckBox(Ctrl).Caption;
 | 
|---|
| 2584 |         end;
 | 
|---|
| 2585 |       end
 | 
|---|
| 2586 |       else
 | 
|---|
| 2587 |       if(Ctrl is TfraTemplateFieldButton) then
 | 
|---|
| 2588 |         begin
 | 
|---|
| 2589 |           Result := TfraTemplateFieldButton(Ctrl).ButtonText;
 | 
|---|
| 2590 |           iString := GetOriginalItem(Result);
 | 
|---|
| 2591 |           if iString <> '' then
 | 
|---|
| 2592 |             Result := iString;
 | 
|---|
| 2593 |         end
 | 
|---|
| 2594 |       else
 | 
|---|
| 2595 |       if(Ctrl is TPanel) then
 | 
|---|
| 2596 |       begin
 | 
|---|
| 2597 |         for j := 0 to Ctrl.ComponentCount-1 do
 | 
|---|
| 2598 |           if Ctrl.Components[j] is TUpDown then
 | 
|---|
| 2599 |           begin
 | 
|---|
| 2600 |             Result := IntToStr(TUpDown(Ctrl.Components[j]).Position);
 | 
|---|
| 2601 |             break;
 | 
|---|
| 2602 |           end;
 | 
|---|
| 2603 |       end;
 | 
|---|
| 2604 |     end;
 | 
|---|
| 2605 |     if Done then break;
 | 
|---|
| 2606 |   end;
 | 
|---|
| 2607 |   if (ind > 0) and (not NoCommas) then
 | 
|---|
| 2608 |     Result := StringOfChar(' ', ind) + Result;
 | 
|---|
| 2609 | end;
 | 
|---|
| 2610 | 
 | 
|---|
| 2611 | function TTemplateDialogEntry.GetFieldValues: string;
 | 
|---|
| 2612 | var
 | 
|---|
| 2613 |   i: integer;
 | 
|---|
| 2614 |   Ctrl: TControl;
 | 
|---|
| 2615 |   CtrlID: integer;
 | 
|---|
| 2616 |   TmpIDs: TList;
 | 
|---|
| 2617 |   TmpSL: TStringList;
 | 
|---|
| 2618 |   Dummy: boolean;
 | 
|---|
| 2619 | 
 | 
|---|
| 2620 | begin
 | 
|---|
| 2621 |   Result := '';
 | 
|---|
| 2622 |   TmpIDs := TList.Create;
 | 
|---|
| 2623 |   try
 | 
|---|
| 2624 |     TmpSL := TStringList.Create;
 | 
|---|
| 2625 |     try
 | 
|---|
| 2626 |       for i := 0 to FControls.Count-1 do
 | 
|---|
| 2627 |       begin
 | 
|---|
| 2628 |         Ctrl := TControl(FControls.Objects[i]);
 | 
|---|
| 2629 |         if(assigned(Ctrl)) then
 | 
|---|
| 2630 |         begin
 | 
|---|
| 2631 |           CtrlID := Ctrl.Tag;
 | 
|---|
| 2632 |           if(TmpIDs.IndexOf(Pointer(CtrlID)) < 0) then
 | 
|---|
| 2633 |           begin
 | 
|---|
| 2634 |             TmpSL.Add(IntToStr(CtrlID) + U + GetControlText(CtrlID, TRUE, Dummy, FALSE));
 | 
|---|
| 2635 |             TmpIDs.Add(Pointer(CtrlID));
 | 
|---|
| 2636 |           end;
 | 
|---|
| 2637 |         end;
 | 
|---|
| 2638 |       end;
 | 
|---|
| 2639 |       Result := TmpSL.CommaText;
 | 
|---|
| 2640 |     finally
 | 
|---|
| 2641 |       TmpSL.Free;
 | 
|---|
| 2642 |     end;
 | 
|---|
| 2643 |   finally
 | 
|---|
| 2644 |     TmpIDs.Free;
 | 
|---|
| 2645 |   end;
 | 
|---|
| 2646 | end;
 | 
|---|
| 2647 | 
 | 
|---|
| 2648 | function TTemplateDialogEntry.GetPanel(MaxLen: integer; AParent: TWinControl): TPanel;
 | 
|---|
| 2649 | var
 | 
|---|
| 2650 |   i, x, y, cnt, idx, ind, yinc, ybase, MaxX: integer; 
 | 
|---|
| 2651 |   MaxTextLen: integer;  {Max num of chars per line in pixels}
 | 
|---|
| 2652 |   MaxChars: integer;    {Max num of chars per line}
 | 
|---|
| 2653 |   txt: string;
 | 
|---|
| 2654 |   ctrl: TControl;
 | 
|---|
| 2655 |   LastLineBlank: boolean;
 | 
|---|
| 2656 | const
 | 
|---|
| 2657 |   FOCUS_RECT_MARGIN = 2; {The margin around the panel so the label won't
 | 
|---|
| 2658 |                         overlay the focus rect on its parent panel.}
 | 
|---|
| 2659 |   procedure DoLabel(Atxt: string);
 | 
|---|
| 2660 |   var
 | 
|---|
| 2661 |     lbl: TLabel;
 | 
|---|
| 2662 | 
 | 
|---|
| 2663 |   begin
 | 
|---|
| 2664 |     lbl := TLabel.Create(nil);
 | 
|---|
| 2665 |     lbl.Parent := FPanel;
 | 
|---|
| 2666 |     lbl.ShowAccelChar := FALSE;
 | 
|---|
| 2667 |     lbl.Caption := Atxt;
 | 
|---|
| 2668 |     lbl.Left := x;
 | 
|---|
| 2669 |     lbl.Top := y;
 | 
|---|
| 2670 |     inc(x, lbl.Width);
 | 
|---|
| 2671 |   end;
 | 
|---|
| 2672 | 
 | 
|---|
| 2673 |   procedure NextLine;
 | 
|---|
| 2674 |   begin
 | 
|---|
| 2675 |     if(MaxX < x) then
 | 
|---|
| 2676 |       MaxX := x;
 | 
|---|
| 2677 |     x := FOCUS_RECT_MARGIN;  {leave two pixels on the left for the Focus Rect}
 | 
|---|
| 2678 |     inc(y, yinc);
 | 
|---|
| 2679 |     yinc := ybase;
 | 
|---|
| 2680 |   end;
 | 
|---|
| 2681 | 
 | 
|---|
| 2682 | begin
 | 
|---|
| 2683 |   MaxTextLen := MaxLen - (FOCUS_RECT_MARGIN * 2);{save room for the focus rectangle on the panel}
 | 
|---|
| 2684 |   if(FFirstBuild or (FPanel.Width <> MaxLen)) then
 | 
|---|
| 2685 |   begin
 | 
|---|
| 2686 |     if(FFirstBuild) then
 | 
|---|
| 2687 |       FFirstBuild := FALSE
 | 
|---|
| 2688 |     else
 | 
|---|
| 2689 |       KillLabels;
 | 
|---|
| 2690 |     y := FOCUS_RECT_MARGIN; {placement of labels on panel so they don't cover the}
 | 
|---|
| 2691 |     x := FOCUS_RECT_MARGIN; {focus rectangle}
 | 
|---|
| 2692 |     MaxX := 0;
 | 
|---|
| 2693 |     //ybase := FontHeightPixel(FFont.Handle) + 1 + (FOCUS_RECT_MARGIN * 2);  AGP commentout line for
 | 
|---|
| 2694 |                                                                            //reminder spacing
 | 
|---|
| 2695 |     ybase := FontHeightPixel(FFont.Handle);
 | 
|---|
| 2696 |     yinc := ybase;
 | 
|---|
| 2697 |     LastLineBlank := FALSE;
 | 
|---|
| 2698 |     for i := 0 to FControls.Count-1 do
 | 
|---|
| 2699 |     begin
 | 
|---|
| 2700 |       txt := FControls[i];
 | 
|---|
| 2701 |       if(copy(txt,1,1) = EOL_MARKER) then
 | 
|---|
| 2702 |       begin
 | 
|---|
| 2703 |         if((x <> 0) or LastLineBlank) then
 | 
|---|
| 2704 |           NextLine;
 | 
|---|
| 2705 |         delete(txt,1,1);
 | 
|---|
| 2706 |         LastLineBlank := (txt = '');
 | 
|---|
| 2707 |       end;
 | 
|---|
| 2708 |       if(txt <> '') then
 | 
|---|
| 2709 |       begin
 | 
|---|
| 2710 |         while(txt <> '') do
 | 
|---|
| 2711 |         begin
 | 
|---|
| 2712 |           cnt := NumCharsFitInWidth(FFont.Handle, txt, MaxTextLen-x);
 | 
|---|
| 2713 |           MaxChars := cnt;
 | 
|---|
| 2714 |           if(cnt >= length(txt)) then
 | 
|---|
| 2715 |           begin
 | 
|---|
| 2716 |             DoLabel(txt);
 | 
|---|
| 2717 |             txt := '';
 | 
|---|
| 2718 |           end
 | 
|---|
| 2719 |           else
 | 
|---|
| 2720 |           if(cnt < 1) then
 | 
|---|
| 2721 |             NextLine
 | 
|---|
| 2722 |           else
 | 
|---|
| 2723 |           begin
 | 
|---|
| 2724 |             repeat
 | 
|---|
| 2725 |               if(txt[cnt+1] = ' ') then
 | 
|---|
| 2726 |               begin
 | 
|---|
| 2727 |                 DoLabel(copy(txt,1,cnt));
 | 
|---|
| 2728 |                 NextLine;
 | 
|---|
| 2729 |                 txt := copy(txt, cnt + 1, MaxInt);
 | 
|---|
| 2730 |                 break;
 | 
|---|
| 2731 |               end
 | 
|---|
| 2732 |               else
 | 
|---|
| 2733 |                 dec(cnt);
 | 
|---|
| 2734 |             until(cnt = 0);
 | 
|---|
| 2735 |             if(cnt = 0) then
 | 
|---|
| 2736 |             begin
 | 
|---|
| 2737 |               if(x = FOCUS_RECT_MARGIN) then {If x is at the far left margin...}
 | 
|---|
| 2738 |               begin
 | 
|---|
| 2739 |                 DoLabel(Copy(txt,1,MaxChars));
 | 
|---|
| 2740 |                 NextLine;
 | 
|---|
| 2741 |                 txt := copy(txt, MaxChars + 1, MaxInt);
 | 
|---|
| 2742 |               end
 | 
|---|
| 2743 |               else
 | 
|---|
| 2744 |                 NextLine;
 | 
|---|
| 2745 |             end;
 | 
|---|
| 2746 |           end;
 | 
|---|
| 2747 |         end;
 | 
|---|
| 2748 |       end
 | 
|---|
| 2749 |       else
 | 
|---|
| 2750 |       begin
 | 
|---|
| 2751 |         ctrl := TControl(FControls.Objects[i]);
 | 
|---|
| 2752 |         if(assigned(ctrl)) then
 | 
|---|
| 2753 |         begin
 | 
|---|
| 2754 |           idx := FIndents.IndexOfObject(Ctrl);
 | 
|---|
| 2755 |           if idx >= 0 then
 | 
|---|
| 2756 |             ind := StrToIntDef(Piece(FIndents[idx], U, 1), 0)
 | 
|---|
| 2757 |           else
 | 
|---|
| 2758 |             ind := 0;
 | 
|---|
| 2759 |           if(x > 0) then
 | 
|---|
| 2760 |           begin
 | 
|---|
| 2761 |             if (x < MaxLen) and (Ctrl is TORCheckBox) and (TORCheckBox(Ctrl).StringData = NewLine) then
 | 
|---|
| 2762 |               x := MaxLen;
 | 
|---|
| 2763 |             if((ctrl.Width + x + ind) > MaxLen) then
 | 
|---|
| 2764 |               NextLine;
 | 
|---|
| 2765 |           end;
 | 
|---|
| 2766 |           inc(x,ind);
 | 
|---|
| 2767 |           Ctrl.Left := x;
 | 
|---|
| 2768 |           Ctrl.Top := y;
 | 
|---|
| 2769 |           inc(x, Ctrl.Width + 4);
 | 
|---|
| 2770 |           if yinc <= Ctrl.Height then
 | 
|---|
| 2771 |             yinc := Ctrl.Height + 1;
 | 
|---|
| 2772 |           if (x < MaxLen) and ((Ctrl is TRichEdit) or
 | 
|---|
| 2773 |              ((Ctrl is TLabel) and (pos(CRLF, TLabel(Ctrl).Caption) > 0))) then
 | 
|---|
| 2774 |             x := MaxLen;
 | 
|---|
| 2775 |         end;
 | 
|---|
| 2776 |       end;
 | 
|---|
| 2777 |     end;
 | 
|---|
| 2778 |     NextLine;
 | 
|---|
| 2779 |     FPanel.Height := (y-1) + (FOCUS_RECT_MARGIN * 2); //AGP added Focus_rect_margin for Reminder spacing
 | 
|---|
| 2780 |     FPanel.Width := MaxX + FOCUS_RECT_MARGIN;
 | 
|---|
| 2781 |   end;
 | 
|---|
| 2782 |   if(FFieldValues <> '') then
 | 
|---|
| 2783 |     SetFieldValues(FFieldValues);
 | 
|---|
| 2784 |   Result := FPanel;
 | 
|---|
| 2785 | end;
 | 
|---|
| 2786 | 
 | 
|---|
| 2787 | procedure TTemplateDialogEntry.SetAnswerHTMLTag(Value : string);
 | 
|---|
| 2788 | //kt 12/28/09 Added entire function
 | 
|---|
| 2789 | begin
 | 
|---|
| 2790 |   if Value='' then begin
 | 
|---|
| 2791 |     FAnswerOpenTag :='';
 | 
|---|
| 2792 |     FAnswerCloseTag := '';
 | 
|---|
| 2793 |   end else begin
 | 
|---|
| 2794 |     if Pos('<',Value)>0 then Value := Piece(Value,'<',2);
 | 
|---|
| 2795 |     if Pos('>',Value)>0 then Value := Piece(Value,'>',1);
 | 
|---|
| 2796 |     FAnswerOpenTag :='<'+Value+'>';
 | 
|---|
| 2797 |     FAnswerCloseTag := '</' + Value + '>';
 | 
|---|
| 2798 |   end;
 | 
|---|
| 2799 | end;
 | 
|---|
| 2800 | 
 | 
|---|
| 2801 | function TTemplateDialogEntry.GetText: string;
 | 
|---|
| 2802 | begin
 | 
|---|
| 2803 |   //kt Result := ResolveTemplateFields(FText, FALSE);
 | 
|---|
| 2804 |   Result := ResolveTemplateFields(FText, FALSE, FALSE, FALSE, FHTMLMode, FAnswerOpenTag, FAnswerCloseTag); //kt 12/29/09
 | 
|---|
| 2805 | end;
 | 
|---|
| 2806 | 
 | 
|---|
| 2807 | procedure TTemplateDialogEntry.KillLabels;
 | 
|---|
| 2808 | var
 | 
|---|
| 2809 |   i, idx: integer;
 | 
|---|
| 2810 |   obj: TObject;
 | 
|---|
| 2811 | 
 | 
|---|
| 2812 | begin
 | 
|---|
| 2813 |   if(assigned(FPanel)) then
 | 
|---|
| 2814 |   begin
 | 
|---|
| 2815 |     for i := FPanel.ControlCount-1 downto 0 do
 | 
|---|
| 2816 |       if(FPanel.Controls[i] is TLabel) then
 | 
|---|
| 2817 |       begin
 | 
|---|
| 2818 |         obj := FPanel.Controls[i];
 | 
|---|
| 2819 |         idx := FControls.IndexOfObject(obj);
 | 
|---|
| 2820 |         if idx < 0 then
 | 
|---|
| 2821 |           obj.Free;
 | 
|---|
| 2822 |       end;
 | 
|---|
| 2823 |   end;
 | 
|---|
| 2824 | end;
 | 
|---|
| 2825 | 
 | 
|---|
| 2826 | procedure TTemplateDialogEntry.SetAutoDestroyOnPanelFree(
 | 
|---|
| 2827 |   const Value: boolean);
 | 
|---|
| 2828 | var
 | 
|---|
| 2829 |   M: TMethod;
 | 
|---|
| 2830 | 
 | 
|---|
| 2831 | begin
 | 
|---|
| 2832 |   FAutoDestroyOnPanelFree := Value;
 | 
|---|
| 2833 |   if(Value) then
 | 
|---|
| 2834 |   begin
 | 
|---|
| 2835 |     M.Data := Self;
 | 
|---|
| 2836 |     M.Code := @PanelDestroy;
 | 
|---|
| 2837 |     TFieldPanel(FPanel).OnDestroy := TNotifyEvent(M);
 | 
|---|
| 2838 |   end
 | 
|---|
| 2839 |   else
 | 
|---|
| 2840 |     TFieldPanel(FPanel).OnDestroy := nil;
 | 
|---|
| 2841 | end;
 | 
|---|
| 2842 | 
 | 
|---|
| 2843 | procedure TTemplateDialogEntry.SetControlText(CtrlID: integer; AText: string);
 | 
|---|
| 2844 | var
 | 
|---|
| 2845 |   cnt, i, j: integer;
 | 
|---|
| 2846 |   Ctrl: TControl;
 | 
|---|
| 2847 |   Done: boolean;
 | 
|---|
| 2848 | 
 | 
|---|
| 2849 | begin
 | 
|---|
| 2850 |   FUpdating := TRUE;
 | 
|---|
| 2851 |   try
 | 
|---|
| 2852 |     Done := FALSE;
 | 
|---|
| 2853 |     cnt := 0;
 | 
|---|
| 2854 |     for i := 0 to FControls.Count-1 do
 | 
|---|
| 2855 |     begin
 | 
|---|
| 2856 |       Ctrl := TControl(FControls.Objects[i]);
 | 
|---|
| 2857 |       if(assigned(Ctrl)) and (Ctrl.Tag = CtrlID) then
 | 
|---|
| 2858 |       begin
 | 
|---|
| 2859 |         Done := TRUE;
 | 
|---|
| 2860 |         if(Ctrl is TLabel) then
 | 
|---|
| 2861 |           TLabel(Ctrl).Caption := AText
 | 
|---|
| 2862 |         else
 | 
|---|
| 2863 |         if(Ctrl is TEdit) then
 | 
|---|
| 2864 |           TEdit(Ctrl).Text := AText
 | 
|---|
| 2865 |         else
 | 
|---|
| 2866 |         if(Ctrl is TORComboBox) then
 | 
|---|
| 2867 |           TORComboBox(Ctrl).SelectByID(AText)
 | 
|---|
| 2868 |         else
 | 
|---|
| 2869 |         if(Ctrl is TRichEdit) then
 | 
|---|
| 2870 |           TRichEdit(Ctrl).Lines.Text := AText
 | 
|---|
| 2871 |         else
 | 
|---|
| 2872 |         if(Ctrl is TORDateCombo) then
 | 
|---|
| 2873 |           TORDateCombo(Ctrl).FMDate := MakeFMDateTime(piece(AText,':',2))
 | 
|---|
| 2874 |         else
 | 
|---|
| 2875 |         if(Ctrl is TORDateBox) then
 | 
|---|
| 2876 |           TORDateBox(Ctrl).Text := AText
 | 
|---|
| 2877 |         else
 | 
|---|
| 2878 |         if(Ctrl is TORCheckBox) then
 | 
|---|
| 2879 |         begin
 | 
|---|
| 2880 |           Done := FALSE;
 | 
|---|
| 2881 |           if(cnt = 0) then
 | 
|---|
| 2882 |             cnt := DelimCount(AText, '|') + 1;
 | 
|---|
| 2883 |           for j := 1 to cnt do
 | 
|---|
| 2884 |           begin
 | 
|---|
| 2885 |             if(TORCheckBox(Ctrl).Caption = piece(AText,'|',j)) then
 | 
|---|
| 2886 |               TORCheckBox(Ctrl).Checked := TRUE;
 | 
|---|
| 2887 |           end;
 | 
|---|
| 2888 |         end
 | 
|---|
| 2889 |         else
 | 
|---|
| 2890 |         if(Ctrl is TfraTemplateFieldButton) then
 | 
|---|
| 2891 |           TfraTemplateFieldButton(Ctrl).ButtonText := AText
 | 
|---|
| 2892 |         else
 | 
|---|
| 2893 |         if(Ctrl is TPanel) then
 | 
|---|
| 2894 |         begin
 | 
|---|
| 2895 |           for j := 0 to Ctrl.ComponentCount-1 do
 | 
|---|
| 2896 |             if Ctrl.Components[j] is TUpDown then
 | 
|---|
| 2897 |             begin
 | 
|---|
| 2898 |               TUpDown(Ctrl.Components[j]).Position := StrToIntDef(AText,0);
 | 
|---|
| 2899 |               break;
 | 
|---|
| 2900 |             end;
 | 
|---|
| 2901 |         end;
 | 
|---|
| 2902 |       end;
 | 
|---|
| 2903 |       if Done then break;
 | 
|---|
| 2904 |     end;
 | 
|---|
| 2905 |   finally
 | 
|---|
| 2906 |     FUpdating := FALSE;
 | 
|---|
| 2907 |   end;
 | 
|---|
| 2908 | end;
 | 
|---|
| 2909 | 
 | 
|---|
| 2910 | procedure TTemplateDialogEntry.SetFieldValues(const Value: string);
 | 
|---|
| 2911 | var
 | 
|---|
| 2912 |   i: integer;
 | 
|---|
| 2913 |   TmpSL: TStringList;
 | 
|---|
| 2914 | 
 | 
|---|
| 2915 | begin
 | 
|---|
| 2916 |   FFieldValues := Value;
 | 
|---|
| 2917 |   TmpSL := TStringList.Create;
 | 
|---|
| 2918 |   try
 | 
|---|
| 2919 |     TmpSL.CommaText := Value;
 | 
|---|
| 2920 |     for i := 0 to TmpSL.Count-1 do
 | 
|---|
| 2921 |       SetControlText(StrToIntDef(Piece(TmpSL[i], U, 1), 0), Piece(TmpSL[i], U, 2));
 | 
|---|
| 2922 |   finally
 | 
|---|
| 2923 |     TmpSL.Free;
 | 
|---|
| 2924 |   end;
 | 
|---|
| 2925 | end;
 | 
|---|
| 2926 | 
 | 
|---|
| 2927 | procedure TTemplateDialogEntry.UpDownChange(Sender: TObject);
 | 
|---|
| 2928 | begin
 | 
|---|
| 2929 |   EnsureText(TEdit(Sender), TUpDown(TEdit(Sender).Tag));
 | 
|---|
| 2930 |   DoChange(Sender);
 | 
|---|
| 2931 | end;
 | 
|---|
| 2932 | 
 | 
|---|
| 2933 | { TFieldPanel }
 | 
|---|
| 2934 | 
 | 
|---|
| 2935 | destructor TFieldPanel.Destroy;
 | 
|---|
| 2936 | begin
 | 
|---|
| 2937 |   if(assigned(FOnDestroy)) then
 | 
|---|
| 2938 |     FOnDestroy(Self);
 | 
|---|
| 2939 |   inherited;
 | 
|---|
| 2940 | end;
 | 
|---|
| 2941 | 
 | 
|---|
| 2942 | {intercept the paint event to draw the focus rect if FFocused is true}
 | 
|---|
| 2943 | function TFieldPanel.GetFocus: boolean;
 | 
|---|
| 2944 | begin
 | 
|---|
| 2945 |   result := Focused;
 | 
|---|
| 2946 | end;
 | 
|---|
| 2947 | 
 | 
|---|
| 2948 | procedure TFieldPanel.Paint;
 | 
|---|
| 2949 | var
 | 
|---|
| 2950 |   DC: HDC;
 | 
|---|
| 2951 |   R: TRect;
 | 
|---|
| 2952 | 
 | 
|---|
| 2953 | begin
 | 
|---|
| 2954 |   inherited;
 | 
|---|
| 2955 |   if(Focused) then
 | 
|---|
| 2956 |   begin
 | 
|---|
| 2957 |     if(not assigned(FCanvas)) then
 | 
|---|
| 2958 |       FCanvas := TControlCanvas.Create;
 | 
|---|
| 2959 |     DC := GetWindowDC(Handle);
 | 
|---|
| 2960 |     try
 | 
|---|
| 2961 |       FCanvas.Handle := DC;
 | 
|---|
| 2962 |       R := ClientRect;
 | 
|---|
| 2963 |       InflateRect(R, -1, -1);
 | 
|---|
| 2964 |       FCanvas.DrawFocusRect(R);
 | 
|---|
| 2965 |     finally
 | 
|---|
| 2966 |       ReleaseDC(Handle, DC);
 | 
|---|
| 2967 |     end;
 | 
|---|
| 2968 |   end;
 | 
|---|
| 2969 | end;
 | 
|---|
| 2970 | 
 | 
|---|
| 2971 | procedure TFieldPanel.SetTheFocus(const Value: boolean);
 | 
|---|
| 2972 | begin
 | 
|---|
| 2973 |   if Value then
 | 
|---|
| 2974 |     SetFocus;
 | 
|---|
| 2975 | end;
 | 
|---|
| 2976 | 
 | 
|---|
| 2977 | { TWebLabel }
 | 
|---|
| 2978 | 
 | 
|---|
| 2979 | procedure TWebLabel.Clicked(Sender: TObject);
 | 
|---|
| 2980 | begin
 | 
|---|
| 2981 |   GotoWebPage(FAddr);
 | 
|---|
| 2982 | end;
 | 
|---|
| 2983 | 
 | 
|---|
| 2984 | procedure TWebLabel.Init(Addr: string);
 | 
|---|
| 2985 | begin
 | 
|---|
| 2986 |   FAddr := Addr;
 | 
|---|
| 2987 |   OnClick := Clicked;
 | 
|---|
| 2988 |   Font.Assign(TORExposedControl(Parent).Font);
 | 
|---|
| 2989 |   Font.Color := clActiveCaption;
 | 
|---|
| 2990 |   Font.Style := Font.Style + [fsUnderline];
 | 
|---|
| 2991 |   AdjustBounds; // make sure we have the right width
 | 
|---|
| 2992 |   AutoSize := FALSE;
 | 
|---|
| 2993 |   Height := Height + 1; // Courier New doesn't support underline unless it's higher
 | 
|---|
| 2994 |   Cursor := crHandPoint;
 | 
|---|
| 2995 | end;
 | 
|---|
| 2996 | 
 | 
|---|
| 2997 | function StripEmbedded(iItems: string): string;
 | 
|---|
| 2998 | {7/26/01    S Monson
 | 
|---|
| 2999 |             Returns the field will all embedded fields removed}
 | 
|---|
| 3000 | var
 | 
|---|
| 3001 |   p1, p2, icur: integer;
 | 
|---|
| 3002 | Begin
 | 
|---|
| 3003 |   p1 := pos(TemplateFieldBeginSignature,iItems);
 | 
|---|
| 3004 |   icur := 0;
 | 
|---|
| 3005 |   while p1 > 0 do
 | 
|---|
| 3006 |     begin
 | 
|---|
| 3007 |       p2 := pos(TemplateFieldEndSignature,copy(iItems,icur+p1+TemplateFieldSignatureLen,maxint));
 | 
|---|
| 3008 |       if  p2 > 0 then
 | 
|---|
| 3009 |         begin
 | 
|---|
| 3010 |           delete(iItems,p1+icur,TemplateFieldSignatureLen+p2+TemplateFieldSignatureEndLen-1);
 | 
|---|
| 3011 |           icur := icur + p1 - 1;
 | 
|---|
| 3012 |           p1 := pos(TemplateFieldBeginSignature,copy(iItems,icur+1,maxint));
 | 
|---|
| 3013 |         end
 | 
|---|
| 3014 |       else
 | 
|---|
| 3015 |         p1 := 0;
 | 
|---|
| 3016 |     end;
 | 
|---|
| 3017 |   Result := iItems;
 | 
|---|
| 3018 | end;
 | 
|---|
| 3019 | 
 | 
|---|
| 3020 | function EvaluateFormula(formula : string): string;
 | 
|---|
| 3021 | begin
 | 
|---|
| 3022 | //CloseCharPos(OpenChar, CloseChar : char; var Txt : string; StartingPos : integer=1) : integer;
 | 
|---|
| 3023 | end;
 | 
|---|
| 3024 | 
 | 
|---|
| 3025 | function FormatFormula(test: string): string;
 | 
|---|
| 3026 | var
 | 
|---|
| 3027 |    test2: string;
 | 
|---|
| 3028 |    i: integer;
 | 
|---|
| 3029 | begin
 | 
|---|
| 3030 |    for i := 1 to length(test) do begin
 | 
|---|
| 3031 |       if test[i] in ['0'..'9','+','-','*','/','(',')','^'] then begin
 | 
|---|
| 3032 |          test2 := test2 + test[i];
 | 
|---|
| 3033 |       end;
 | 
|---|
| 3034 |    end;
 | 
|---|
| 3035 |    Result := test2;
 | 
|---|
| 3036 | end;
 | 
|---|
| 3037 | 
 | 
|---|
| 3038 | initialization
 | 
|---|
| 3039 | 
 | 
|---|
| 3040 | finalization
 | 
|---|
| 3041 |   KillObj(@uTmplFlds, TRUE);
 | 
|---|
| 3042 |   KillObj(@uEntries, TRUE);
 | 
|---|
| 3043 | 
 | 
|---|
| 3044 | end.
 | 
|---|