source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/uLogic.pas@ 800

Last change on this file since 800 was 800, checked in by Kevin Toppenberg, 14 years ago

Fixing uploads of PDF files
File size: 51.1 KB
Line 
1unit uLogic;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, Buttons, ExtCtrls, ORNet, ORFn,ComCtrls,Trpcb, ORCtrls;
8
9
10const
11 INT_COMPONENT_SPACING = 4;
12 INT_CBO_CONDITIONLEFT = 3;
13 INT_CBO_CONDITIONWIDTH = 50;
14
15 INT_CBO_FILELEFT = INT_CBO_CONDITIONLEFT + INT_CBO_CONDITIONWIDTH + INT_COMPONENT_SPACING;
16 INT_CBO_FILEWIDTH = 177;
17
18 INT_CBO_FIELDLEFT = INT_CBO_FILELEFT + INT_CBO_FILEWIDTH + INT_COMPONENT_SPACING;
19 INT_CBO_FIELDWIDTH = 177;
20
21 INT_CBO_OPERATORLEFT = INT_CBO_FIELDLEFT + INT_CBO_FIELDWIDTH + INT_COMPONENT_SPACING;
22 INT_CBO_OPERATORWIDTH = 113;
23
24 INT_EDIT_VALUELEFT = INT_CBO_OPERATORLEFT + INT_CBO_OPERATORWIDTH + INT_COMPONENT_SPACING;
25 INT_EDIT_VALUEWIDTH = 169;
26
27 INT_EDIT_LOWERLEFT = INT_CBO_OPERATORLEFT + INT_CBO_OPERATORWIDTH + INT_COMPONENT_SPACING;
28 INT_EDIT_LOWERWIDTH = 100;
29
30 INT_EDIT_UPPERLEFT = INT_EDIT_LOWERLEFT + INT_EDIT_LOWERWIDTH + INT_COMPONENT_SPACING;
31 INT_EDIT_UPPERWIDTH = 100;
32
33 INT_BUTTON_LEFT = INT_EDIT_VALUELEFT + INT_EDIT_VALUEWIDTH + INT_COMPONENT_SPACING;
34 INT_BUTTON_SIZE = 23;
35
36 INT_ADD_QUERYROW_BTN_LEFT = INT_CBO_CONDITIONLEFT;
37 INT_ADD_QUERYROW_LABEL_LEFT = INT_ADD_QUERYROW_BTN_LEFT + 30;
38 INT_ADD_QUERYROW_LABEL_CAPTION = 'Add another term to query';
39
40 TAG_FILE_BOX = 0;
41 TAG_FIELD_BOX = 1;
42 TAG_RECORD_BOX = 2;
43
44 LABEL_LEFT_OFFSET = 2;
45 FIELDS_TOP_OFFSET = 30;
46 INDENT_OFFSET = 30;
47 OPEN_BOX_HEIGHT = 120;
48 OPERATOR_BOX_HEIGHT = 150;
49 CLOSE_BOX_HEIGHT = 21;
50 ROW_HEIGHT = 30;
51 ADD_QUERY_OFFSET = OPEN_BOX_HEIGHT + INT_COMPONENT_SPACING;
52
53 CL_LT_RED = $6C6CBA;
54 Colors : Array[false..true] of TColor = (clWindow, CL_LT_RED);
55 SearchCaption : Array[false..true,false..true] of String[30] = (
56 ('Search Value', 'Enter Lower ... Upper Value'), //Advanced Mode
57 ('Enter Value to Search For', 'Enter Lower && Upper Values') //Simple Mode
58 );
59
60 COMB_EQUALS = '=^= EQUALS';
61 COMB_NOT_EQUAL = '''=^<>, DOES NOT EQUAL';
62 COMB_LESS_THAN = '<^<, LESS THAN';
63 COMB_LESS_THAN_OR_EQUALS = '<=^<=, LESS THAN OR EQUAL TO';
64 COMB_GREATER_THAN = '>^>, GREATER THAN';
65 COMB_GREATER_THAN_OR_EQUALS = '>=^>=, GREATER OR EQUAL TO';
66 COMB_IN_RANGE = '{^IN RANGE';
67 COMB_NOT_IN_RANGE = '''{^NOT IN RANGE';
68 COMB_CONTAINS = '[^CONTAINS';
69 COMB_NOT_CONTAINS = '''[^DOES NOT CONTAIN';
70
71
72type
73 TValueMode = (vmUnknown,vmString,vmDate,vmNumeric,vmRange,vmSet,vmPointer);
74 TFieldDataType = (fdtUnknown,fdtText,fdtSet,fdtDate,fdtWP,fdtPointer);
75
76 TLogicSet = class; //a forward
77 TLogicRow = class(TObject)
78 private
79 { Private declarations }
80 FIndentLevel : integer;
81 FSearchValueMode : TValueMode;
82 FSearchFileNumber : string;
83 FSearchFileName : string;
84 FParentSet : TLogicSet;
85 FRowNum : integer; //starts numbering at 0
86 FCurFieldDef : string;
87 FInfoPiece3 : string;
88 FVisible : boolean;
89 FTop : integer;
90 FSimpleMode : boolean;
91 FNewGroupStarter : boolean;
92 ValueEdit: TEdit; //Will double as Lower value if entering a range.
93 UpperValueEdit: TEdit;
94 DatePicker : TDateTimePicker;
95 UpperDatePicker : TDateTimePicker;
96 SetPicker : TComboBox;
97 RecordPickerBox : TORComboBox;
98 DelButton : TSpeedButton;
99 FRowOpen : boolean;
100 procedure SetIndentLevel(Value : integer);
101 procedure LoadOperator(CmbBox: TORComboBox);
102 procedure LoadCondition(CmbBox: TORComboBox);
103 procedure ConditionChange(Sender: TObject);
104 procedure DelButtonClick(Sender : TObject);
105 procedure ORBoxNeedData(Sender: TObject; const StartFrom: String;
106 Direction, InsertAt: Integer);
107 procedure FileBoxChange(Sender: TObject);
108 function SubSetOfAllowedFiles(SimpleMode : boolean;
109 FileNum: string; const StartFrom: string;
110 Direction: Integer ): TStrings;
111 function SubSetOfFile(FileNum: string; const StartFrom: string;
112 Direction: Integer ): TStrings;
113 procedure FieldBoxChange(Sender: TObject);
114 procedure RecordPickerBoxChange(Sender: TObject);
115 procedure DatePickerChange(Sender: TObject);
116 procedure OperatorBoxChange(Sender: TObject);
117 procedure EditBoxChange(Sender: TObject);
118 procedure SetPickerChange(Sender: TObject);
119 function SubSetOfFields(SimpleMode : boolean; FileNum: string;
120 const StartFrom: string; Direction: Integer): TStrings;
121 function ExtractNum (S : String; StartPos : integer) : string;
122 procedure EnsureProperValueFieldVisible;
123 function IsWPField(FileNum,FieldNum : string) : boolean;
124 procedure InitORComboBox(ORComboBox: TORComboBox; initValue : string; boxtype : string);
125 function GetSearchValue() : string;
126 procedure SetVisible(Value : Boolean);
127 procedure PrepSetPicker(setDef : string);
128 procedure SetNewGroupStarter(value : boolean);
129 procedure SetRowNum(value : integer); //This won't change position in parent LogicSet
130 procedure CheckVisibilityIsCorrect;
131 procedure SetSimpleMode(Value : boolean);
132 procedure SetRowColor(Color : TColor);
133 procedure SetSearchLabelCaption;
134 procedure SelectOperator(OperatorLine : string);
135 public
136 { Public declarations }
137 ConditionBox: TORComboBox;
138 FileBox: TORComboBox;
139 FieldBox: TORComboBox;
140 OperatorBox: TORComboBox;
141 OnSearchStringChange : TNotifyEvent;
142 OnRangeModeChange : TNotifyEvent;
143 constructor Create(SearchFileNumber,SearchFileName : string;
144 SimpleMode : Boolean;
145 AParent : TWinControl; AParentSet : TLogicSet; Row : integer);
146 Destructor Destroy;
147 procedure CloseRow;
148 procedure OpenRow;
149 function GetFieldDataType : TFieldDataType;
150 function GetFileNum : string;
151 function GetFieldNum : string;
152 function IsValid : boolean;
153 function GetSearchString(var LastFileNum : string) : string;
154 procedure IndentMore;
155 procedure IndentLess;
156 procedure Clear;
157 procedure SetFile(FileNumber,FileName : string);
158 property IndentLevel : integer read FIndentLevel write SetIndentLevel;
159 property SearchValueMode : TValueMode read FSearchValueMode;
160 property SearchValue : string read GetSearchValue;
161 property Visible : boolean read FVisible write SetVisible;
162 property NewGroupStarter : boolean read FNewGroupStarter write SetNewGroupStarter;
163 property Top : integer read FTop;
164 property RowNum : integer read FRowNum write SetRowNum;
165 Property SimpleMode : boolean read FSimpleMode write SetSimpleMode;
166 property RowOpen : boolean read FRowOpen;
167 end;
168
169 TLogicSet = class (TObject)
170 private
171 { Private declarations }
172 Rows : TList;
173 FSearchFileNumber : string;
174 FSearchFileName : string;
175 FSearchString : string;
176 FParent : TWinControl;
177 FOwner : TComponent;
178 FSimpleMode : boolean;
179 FFileNumsStack : TStringList; //Will act as stack of filenumbers, based on indent level
180 lblAddAnother: TLabel;
181 btnIndentLess: TButton;
182 btnIndentMore: TButton;
183 function GetRow(Index : integer): TLogicRow;
184 procedure Handle1RowChange(Sender : TObject);
185 function GetSearchString : string;
186 function GetRowCount : integer;
187 procedure HandleIndentMore(Sender : TObject);
188 procedure HandleIndentLess(Sender : TObject);
189 procedure HandleAddQuery(Sender : TObject);
190 procedure UpdateButtonPlacement;
191 procedure SetSimpleMode(Value : boolean);
192 public
193 { Public declarations }
194 OnSearchStringChange : TNotifyEvent;
195 SearchStringEdit : TEdit; //not owned by this object;
196 lblFile : TLabel; //not owned by this object;
197 lblField : TLabel; //not owned by this object;
198 lblOperator : TLabel; //not owned by this object;
199 lblValue : TLabel; //not owned by this object;
200 DelBitmap : TBitmap; //IS owned by this object;
201 btnAddSrchField : TBitBtn;
202 constructor Create(SearchFileNumber,SearchFileName : string;
203 AParent : TWinControl; AOwner : TComponent);
204 Destructor Destroy;
205 function RowBefore (ARow : TLogicRow) : TLogicRow;
206 function PriorRow : TLogicRow; //Next to last row.
207 function LastRow : TLogicRow;
208 procedure IndentMore;
209 procedure IndentLess;
210 function AddRow : TLogicRow;
211 function IndexOf(ARow : TLogicRow) : integer;
212 procedure DeleteRow(Index : integer); overload;
213 procedure DeleteRow(ARow : TLogicRow); overload;
214 procedure SetFile(FileNumber,FileName : string);
215 procedure Clear;
216 property Row[Index : integer] : TLogicRow read GetRow;
217 property SearchString : string read FSearchString;
218 Property RowCount : integer read GetRowCount;
219 Property SimpleMode : boolean read FSimpleMode write SetSimpleMode;
220 end;
221
222
223implementation
224
225 uses FMErrorU;
226//-----------------------------------------------------------------------
227//TLogicRow
228//-----------------------------------------------------------------------
229
230 constructor TLogicRow.Create(SearchFileNumber,SearchFileName : string;
231 SimpleMode : Boolean;
232 AParent : TWinControl;
233 AParentSet : TLogicSet; Row : integer);
234 procedure InitBox(Box : TORComboBox; Row : integer; DropDown : boolean);
235 begin
236 with Box do begin
237 Visible := false;
238 Parent := AParent;
239 Top := FTop;
240 Delimiter := '^';
241 Pieces := '2';
242 if DropDown then begin
243 Style := orcsDropDown; //orcsSimple;
244 end else begin
245 Style := orcsSimple;
246 end;
247 Height := OPEN_BOX_HEIGHT;
248 AutoSelect := False;
249 CheckEntireLine := True;
250 LongList := True;
251 LookupPiece := 2;
252 end;
253 end;
254
255 begin {constructor}
256 Inherited Create;
257 FRowNum := Row;
258 FSearchFileNumber := SearchFileNumber;
259 FSearchFileName := SearchFileName;
260 FParentSet := AParentSet;
261 FVisible := false;
262 FSimpleMode := SimpleMode;
263 FRowOpen := true;
264 FTop := FIELDS_TOP_OFFSET + ROW_HEIGHT * Row;
265 FNewGroupStarter := false;
266 OnSearchStringChange := nil;
267 OnRangeModeChange := nil;
268 ConditionBox := TORComboBox.Create(AParent); //Create condition box (e.g. AND, OR, NOT)
269 InitBox(ConditionBox,Row,true);
270 with ConditionBox do begin
271 Left := INT_CBO_CONDITIONLEFT;
272 Width := INT_CBO_CONDITIONWIDTH;
273 OnChange := ConditionChange;
274 end;
275 LoadCondition(ConditionBox);
276
277 FileBox := TORComboBox.Create(AParent); //create the file box
278 InitBox(FileBox,Row,true);
279 with FileBox do begin
280 Left := INT_CBO_FILELEFT;
281 Width := INT_CBO_FILEWIDTH;
282 OnNeedData := ORBoxNeedData;
283 OnClick := FileBoxChange;
284 OnChange := FileBoxChange;
285 Tag := TAG_FILE_BOX;
286 end;
287
288 FieldBox := TORComboBox.Create(AParent); //create the field box
289 InitBox(FieldBox,Row,false);
290 with FieldBox do begin
291 Left := INT_CBO_FIELDLEFT;
292 Width := INT_CBO_FIELDWIDTH;
293 OnNeedData := ORBoxNeedData;
294 OnChange := FieldBoxChange;
295 Tag := TAG_FIELD_BOX;
296 end;
297
298 OperatorBox := TORComboBox.Create(AParent); //create the operator box (e.g. >, <, =, [ etc)
299 InitBox(OperatorBox,Row,true);
300 with OperatorBox do begin
301 Left := INT_CBO_OPERATORLEFT;
302 Width := INT_CBO_OPERATORWIDTH;
303 Height := OPERATOR_BOX_HEIGHT;
304 OnClick := OperatorBoxChange;
305 OnChange := OperatorBoxChange;
306 end;
307 LoadOperator(OperatorBox);
308
309 ValueEdit := TEdit.Create(AParent); //create the Value edit box (also Lower limit box)
310 with ValueEdit do begin
311 Visible := false;
312 Parent := AParent;
313 Left := INT_EDIT_VALUELEFT;
314 Width := INT_EDIT_VALUEWIDTH;
315 Top := FTop;
316 OnChange := EditBoxChange;
317 end;
318
319 UpperValueEdit := TEdit.Create(AParent); //create the lower limit box
320 with UpperValueEdit do begin
321 Visible := false;
322 Parent := AParent;
323 Left := INT_EDIT_LOWERLEFT;
324 Width := INT_EDIT_UPPERWIDTH;
325 Top := FTop;
326 OnChange := EditBoxChange;
327 end;
328
329 DatePicker := TDateTimePicker.Create(AParent);
330 with DatePicker do begin
331 Visible := False;
332 Parent := AParent;
333 DateTime := Now;
334 Format := 'MM/dd/yyyy';
335 Width := INT_EDIT_VALUEWIDTH;
336 Top := FTop;
337 OnChange := DatePickerChange;
338 end;
339
340 UpperDatePicker := TDateTimePicker.Create(AParent);
341 with UpperDatePicker do begin
342 Visible := False;
343 Parent := AParent;
344 DateTime := Now;
345 Format := 'MM/dd/yyyy';
346 Width := INT_EDIT_UPPERWIDTH;
347 Top := FTop;
348 OnChange := DatePickerChange;
349 end;
350
351 RecordPickerBox := TORComboBox.Create(AParent);
352 InitBox(RecordPickerBox,Row,true);
353 with RecordPickerBox do begin
354 Width := INT_EDIT_VALUEWIDTH;
355 OnNeedData := ORBoxNeedData;
356 OnChange := RecordPickerBoxChange;
357 Tag := TAG_RECORD_BOX;
358 end;
359
360 SetPicker := TComboBox.Create(AParent);
361 With SetPicker do begin
362 Visible := false;
363 Parent := AParent;
364 Width := INT_EDIT_VALUEWIDTH;
365 Top := FTop;
366 OnChange := SetPickerChange;
367 end;
368
369 DelButton := TSpeedButton.Create(AParent);
370 with DelButton do begin
371 Visible := false;
372 Parent := AParent;
373 Height := INT_BUTTON_SIZE;
374 Width := INT_BUTTON_SIZE;
375 //Caption := '(x)'; //Will be assigned a bitmap by parentset
376 Top := FTop;
377 OnClick := DelButtonClick;
378 Hint := 'Delete row';
379 ShowHint := true;
380 ParentShowHint := False;
381 Visible := true;
382 end;
383
384 SetIndentLevel(0);
385 InitORComboBox(FileBox,FSearchFileName,'file');
386 FileBoxChange(FileBox);
387 FieldBoxChange(FieldBox);
388 SetVisible(true);
389 SetSimpleMode(FSimpleMode);
390 end; {constructor}
391
392 Destructor TLogicRow.Destroy;
393 begin
394 ConditionBox.Free;
395 FileBox.Free;
396 FieldBox.Free;
397 OperatorBox.Free;
398 ValueEdit.Free;
399 UpperValueEdit.Free;
400 DatePicker.Free;
401 UpperDatePicker.Free;
402 RecordPickerBox.Free;
403 SetPicker.Free;
404 DelButton.Free;
405 Inherited Destroy;
406 end;
407
408 procedure TLogicRow.SetIndentLevel(Value : integer);
409 begin
410 FIndentLevel := Value;
411 ConditionBox.Left := INT_CBO_CONDITIONLEFT + INDENT_OFFSET * Value;
412 FileBox.Left := INT_CBO_FILELEFT + INDENT_OFFSET * Value;
413 FieldBox.Left := INT_CBO_FIELDLEFT + INDENT_OFFSET * Value;
414 OperatorBox.Left := INT_CBO_OPERATORLEFT + INDENT_OFFSET * Value;
415 ValueEdit.Left := INT_EDIT_VALUELEFT + INDENT_OFFSET * Value;
416 UpperValueEdit.Left := INT_EDIT_UPPERLEFT + INDENT_OFFSET * Value;
417 DatePicker.Left := INT_EDIT_VALUELEFT + INDENT_OFFSET * Value;
418 UpperDatePicker.Left:= INT_EDIT_UPPERLEFT + INDENT_OFFSET * Value;
419 RecordPickerBox.Left:= INT_EDIT_VALUELEFT + INDENT_OFFSET * Value;
420 SetPicker.Left := INT_EDIT_VALUELEFT + INDENT_OFFSET * Value;
421 DelButton.Left := INT_BUTTON_LEFT + INDENT_OFFSET * Value;
422 if FParentSet<> nil then begin
423 If FParentSet.lblFile <> nil then FParentSet.lblFile.Left := INT_CBO_FILELEFT
424 + LABEL_LEFT_OFFSET + INDENT_OFFSET * Value;
425 If FParentSet.lblField <> nil then FParentSet.lblField.Left := INT_CBO_FIELDLEFT
426 + LABEL_LEFT_OFFSET + INDENT_OFFSET * Value;
427 If FParentSet.lblOperator <> nil then FParentSet.lblOperator.Left := INT_CBO_OPERATORLEFT
428 + LABEL_LEFT_OFFSET + INDENT_OFFSET * Value;
429 If FParentSet.lblValue <> nil then FParentSet.lblValue.Left := INT_EDIT_VALUELEFT
430 + LABEL_LEFT_OFFSET + INDENT_OFFSET * Value;
431 end;
432 end;
433
434 procedure TLogicRow.Clear;
435 //This just resets the row for use. It doesn't delete it.
436 begin
437 SetIndentLevel(0);
438 FileBox.ItemIndex := 0;
439 FileBox.Text := piece(FileBox.Items[0],'^',2);
440 FileBoxChange(FileBox);
441 FieldBox.ItemIndex := 0;
442 FieldBox.Text := piece(FieldBox.Items[0],'^',2);
443 FieldBoxChange(FieldBox);
444 ValueEdit.Text := '';
445 UpperValueEdit.Text := '';
446 DatePicker.DateTime := Now;
447 UpperDatePicker.DateTime := Now;
448 RecordPickerBox.Text := '';
449 RecordPickerBox.ItemIndex := 0;
450 SetPicker.Text := '';
451 ConditionBox.ItemIndex := 0;
452 ConditionBox.Text := piece(ConditionBox.Items[0],'^',2);
453 end;
454
455 procedure TLogicRow.SetFile(FileNumber,FileName : string);
456 begin
457 if (FSearchFileNumber=FileNumber) and (FSearchFileName=FileName) then exit;
458 FSearchFileNumber := FileNumber;
459 FSearchFileName := FileName;
460 InitORComboBox(FileBox,FSearchFileName,'file');
461 FileBoxChange(FileBox);
462 FieldBoxChange(FieldBox);
463 end;
464
465 procedure TLogicRow.SetRowColor(Color : TColor);
466 begin
467 ConditionBox.Color := Color;
468 FileBox.Color := Color;
469 FieldBox.Color := Color;
470 OperatorBox.Color := Color;
471 ValueEdit.Color := Color;
472 UpperValueEdit.Color := Color;
473 DatePicker.Color := Color;
474 UpperDatePicker.Color := Color;
475 SetPicker.Color := Color;
476 RecordPickerBox.Color := Color;
477 end;
478
479 procedure TLogicRow.CloseRow;
480 procedure CloseORBox(Box : TORComboBox);
481 begin
482 Box.Style := orcsDropDown;
483 Box.Height := CLOSE_BOX_HEIGHT;
484 //Box.Color := clInactiveBorder;
485 end;
486
487 begin
488 FRowOpen := false;
489 if FNewGroupStarter and (FVisible=false) then exit;
490 CloseORBox(ConditionBox);
491 CloseORBox(FileBox);
492 CloseORBox(FieldBox);
493 CloseORBox(RecordPickerBox);
494 SetRowColor(clInactiveBorder);
495 SetVisible(true);
496 end;
497
498 procedure TLogicRow.OpenRow;
499 begin
500 FRowOpen := true;
501 SetRowColor(Colors[FSimpleMode]);
502 SetVisible(true);
503 end;
504
505 procedure TLogicRow.SetRowNum(value : integer);
506 //This won't change position in parent LogicSet
507 var Top : integer;
508 begin
509 if value <> FRowNum then begin
510 FRowNum := Value;
511 Top := FIELDS_TOP_OFFSET + ROW_HEIGHT * FRowNum;
512 ConditionBox.Top := Top;
513 FileBox.Top := Top;
514 FieldBox.Top := Top;
515 OperatorBox.Top := Top;
516 ValueEdit.Top := Top;
517 UpperValueEdit.Top := Top;
518 DatePicker.Top := Top;
519 UpperDatePicker.Top := Top;
520 RecordPickerBox.Top := Top;
521 SetPicker.Top := Top;
522 DelButton.Top := Top;
523 end;
524 end;
525
526 procedure TLogicRow.SetSearchLabelCaption;
527 begin
528 If FParentSet.lblValue <> nil then begin
529 FParentSet.lblValue.Caption := SearchCaption[FSimpleMode,(FSearchValueMode = vmRange)];
530 end;
531 end;
532
533 procedure TLogicRow.SetSimpleMode(Value : boolean);
534 begin
535 if Value <> FSimpleMode then begin
536 SetRowColor(Colors[FSimpleMode]);
537 FSimpleMode := Value;
538 if FSimpleMode=true then begin
539 InitORComboBox(FileBox,'A','file'); //Populate File box
540 if FileBox.Items.Count > 0 then begin
541 FileBox.ItemIndex := 0;
542 FileBox.Text := piece(FileBox.Items[FileBox.ItemIndex],'^',2)
543 end;
544 end else begin
545 InitORComboBox(FileBox,FSearchFileName,'file'); //Populate File box
546 end;
547 SetSearchLabelCaption;
548 InitORComboBox(FieldBox,'A','field'); //Populate Field box
549 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
550 end;
551 end;
552
553
554 procedure TLogicRow.SetNewGroupStarter(Value : boolean);
555 begin
556 if Value = FNewGroupStarter then exit;
557 FNewGroupStarter := Value;
558 SetVisible(not FNewGroupStarter);
559 ConditionBox.Color := clWindow;
560 ConditionBox.Visible := true;
561 end;
562
563
564 procedure TLogicRow.SelectOperator(OperatorLine : string);
565 var index,i : integer;
566 begin
567 if OperatorBox.Items.Count = 0 then exit;
568 //not working, why? --> index := OperatorBox.Items.IndexOf(OperatorLine);
569 index := -1;
570 for i:= 0 to OperatorBox.Items.Count-1 do begin
571 if OperatorBox.Items[i] = OperatorLine then begin
572 index := i; break;
573 end;
574 end;
575 //if index = OperatorBox.ItemIndex then exit; //no change.
576 if index < 0 then index := 0;
577 OperatorBox.Text := piece(OperatorBox.Items[index],'^',2);
578 OperatorBox.ItemIndex := index;
579 OperatorBoxChange(Self);
580 end;
581
582
583 procedure TLogicRow.LoadOperator(CmbBox: TORComboBox);
584 //Load the operators, with the first piece being the mumps operator and
585 //the second piece the text in the operator box
586 begin
587 CmbBox.Items.Add(COMB_EQUALS);
588 CmbBox.Items.Add(COMB_NOT_EQUAL);
589 CmbBox.Items.Add(COMB_LESS_THAN);
590 CmbBox.Items.Add(COMB_LESS_THAN_OR_EQUALS);
591 CmbBox.Items.Add(COMB_GREATER_THAN);
592 CmbBox.Items.Add(COMB_GREATER_THAN_OR_EQUALS);
593 CmbBox.Items.Add(COMB_IN_RANGE);
594 CmbBox.Items.Add(COMB_NOT_IN_RANGE);
595 CmbBox.Items.Add(COMB_CONTAINS);
596 CmbBox.Items.Add(COMB_NOT_CONTAINS);
597 CmbBox.ItemIndex := 0;
598 CmbBox.Text := piece(CmbBox.Items[0],'^',2);
599 end;
600
601 procedure TLogicRow.LoadCondition(CmbBox: TORComboBox);
602 //Load the conditions, with the first piece being the mumps conditional and
603 //the second piece the text in the conditions box
604 begin
605 CmbBox.Items.Add('&^AND');
606 CmbBox.Items.Add('!^OR');
607 CmbBox.Items.Add('NOT^NOT');
608 CmbBox.ItemIndex := 0;
609 CmbBox.Text := 'AND';
610 end;
611
612 procedure TLogicRow.ORBoxNeedData(Sender: TObject; const StartFrom: String;
613 Direction, InsertAt: Integer);
614 var Result : TStrings;
615 FileNum : string;
616 ORComboBox : TORComboBox;
617 begin
618 ORComboBox := TORComboBox(Sender);
619 Case ORComboBox.Tag of
620 TAG_FILE_BOX : begin
621 FileNum := FSearchFileNumber;
622 Result := SubSetOfAllowedFiles(FSimpleMode,FileNum,
623 StartFrom, Direction);
624 end;
625 TAG_FIELD_BOX : begin
626 if FileBox.Items.count = 0 then exit;
627 if FileBox.ItemIndex = -1 then FileBox.ItemIndex := 0;
628 FileNum := piece(FileBox.Items[FileBox.ItemIndex],'^',1);
629 Result := SubSetOfFields(FSimpleMode, FileNum, StartFrom, Direction);
630 end;
631 TAG_RECORD_BOX: begin
632 FileNum := ExtractNum (FCurFieldDef,Pos('P',FCurFieldDef)+1);
633 Result := SubSetOfFile(FileNum, StartFrom, Direction);
634 end;
635 else Exit;
636 end; {case}
637 ORComboBox.ForDataUse(Result);
638 end;
639
640 procedure TLogicRow.FileBoxChange(Sender: TObject);
641 begin
642 InitORComboBox(FieldBox,'A','field'); //Populate Field box
643 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
644 end;
645
646 procedure TLogicRow.PrepSetPicker(setDef : string);
647 var oneOption : string;
648 begin
649 SetPicker.Items.Clear;
650 SetPicker.Text := '';
651 oneOption := 'x';
652 while (setDef <> '') and (oneOption <> '') do begin
653 oneOption := piece(setDef,';',1);
654 setDef := pieces(setDef,';',2,32);
655 oneOption := piece(oneOption,':',2);
656 if oneOption <> '' then begin
657 SetPicker.Items.Add(oneOption);
658 end;
659 end;
660 if SetPicker.Items.Count > 0 then begin
661 SetPicker.SelText := SetPicker.Items[0];
662 end else begin
663 SetPicker.Text := '(none defined)';
664 end;
665 end;
666
667
668 procedure TLogicRow.EnsureProperValueFieldVisible;
669 var
670 NewSearchValueMode : TValueMode;
671 CurDataType : TFieldDataType;
672 Operator : string;
673
674 procedure ShowOnly(Control : TWinControl);
675 begin
676 ValueEdit.Visible := false;
677 UpperValueEdit.Visible := false;
678 DatePicker.Visible := false;
679 UpperDatePicker.visible := false;
680 RecordPickerBox.Visible := false;
681 SetPicker.Visible := false;
682 Control.Visible := true;
683 end;
684
685 begin
686 CurDataType := GetFieldDataType;
687 Operator := OperatorBox.Text;
688 if Pos('IN RANGE',Operator) > 0 then begin
689 NewSearchValueMode := vmRange;
690 if CurDataType in [fdtPointer,fdtSet] then begin
691 MessageDlg('A RANGE can''t be used with this type of field.',mtError,[MBOK],0);
692 OperatorBox.Text := piece(OperatorBox.Items[0],'^',2); //should be EQUALS
693 OperatorBox.ItemIndex := 0;
694 exit;
695 end;
696 end else begin
697 Case CurDataType of
698 fdtUnknown : NewSearchValueMode := vmString;
699 fdtText : NewSearchValueMode := vmString;
700 fdtSet : NewSearchValueMode := vmSet;
701 fdtDate : NewSearchValueMode := vmDate;
702 fdtWP : NewSearchValueMode := vmString;
703 fdtPointer : NewSearchValueMode := vmPointer;
704 else NewSearchValueMode := vmString;
705 end; {case}
706 end;
707 if (NewSearchValueMode = FSearchValueMode)
708 and not (NewSearchValueMode in [vmPointer,vmSet]) then exit; //nothing to be done.
709 if (FSearchValueMode = vmRange) or (NewSearchValueMode = vmRange) then begin
710 if Assigned(OnRangeModeChange) then OnRangeModeChange(Self); //can be used to change labels.
711 end;
712 FSearchValueMode := NewSearchValueMode;
713 Case NewSearchValueMode of
714 vmRange: begin
715 if curDataType = fdtDate then begin
716 DatePicker.Width := INT_EDIT_LOWERWIDTH;
717 ShowOnly(DatePicker);
718 UpperDatePicker.Visible := true;
719 end else begin
720 ValueEdit.Width := INT_EDIT_LOWERWIDTH;
721 ShowOnly(ValueEdit);
722 UpperValueEdit.Visible := true;
723 end;
724 end;
725 vmString: Begin
726 ValueEdit.Width := INT_EDIT_VALUEWIDTH;
727 ShowOnly(ValueEdit);
728 end;
729 vmSet: begin
730 PrepSetPicker(FInfoPiece3);
731 ShowOnly(SetPicker);
732 end;
733 vmDate: begin
734 DatePicker.Width := INT_EDIT_VALUEWIDTH;
735 ShowOnly(DatePicker);
736 end;
737 vmPointer: begin
738 ShowOnly(RecordPickerBox);
739 InitORComboBox(RecordPickerBox,'A','record'); //Populate Field box
740 end;
741 end; {case}
742 SetSearchLabelCaption;
743 end;
744
745 procedure TLogicRow.CheckVisibilityIsCorrect;
746 var RowPrior : TLogicRow;
747 begin
748 ConditionBox.Visible := (FRowNum>0);
749 RowPrior :=FParentSet.RowBefore(Self);
750 if (RowPrior <> nil) then if RowPrior.NewGroupStarter=true then begin
751 ConditionBox.Visible := false;
752 end;
753 DelButton.Visible := (FParentSet.RowCount>1);
754 end;
755
756 procedure TLogicRow.SetVisible(Value : Boolean);
757 begin
758 FVisible := Value;
759 FileBox.Visible := Value;
760 FieldBox.Visible := Value;
761 OperatorBox.Visible := Value;
762 if Value = true then begin
763 EnsureProperValueFieldVisible;
764 CheckVisibilityIsCorrect;
765 end else begin
766 ConditionBox.Visible := False;
767 ValueEdit.Visible := false;
768 UpperValueEdit.Visible := false;
769 DatePicker.Visible := false;
770 UpperDatePicker.visible := false;
771 RecordPickerBox.Visible := false;
772 SetPicker.Visible := false;
773 end;
774 end;
775
776
777 function TLogicRow.GetSearchValue() : string;
778 var
779 CurDataType : TFieldDataType;
780
781 begin
782 CurDataType := GetFieldDataType;
783 case FSearchValueMode of
784 vmRange: begin
785 if curDataType = fdtDate then begin
786 Result := DateToStr(DatePicker.DateTime) + '..' +
787 DateToStr(UpperDatePicker.DateTime);
788 end else begin
789 Result := ValueEdit.Text + '..' + UpperValueEdit.Text;
790 end;
791 end;
792 vmString: Begin
793 Result := ValueEdit.Text;
794 end;
795 vmSet: begin
796 Result := SetPicker.Text;
797 end;
798 vmDate: begin
799 Result := DateToStr(DatePicker.DateTime);
800 end;
801 vmPointer: begin
802 Result := RecordPickerBox.Text;
803 end;
804 else Result := '';
805 end; {case}
806 end;
807
808 function TLogicRow.GetSearchString(var LastFileNum : string) : string;
809 var ThisFileNum : string;
810 NewFileNum : boolean;
811 Fld : string;
812 begin
813 Result := '';
814 NewFileNum := true; //default
815 if (IsValid=false)and(FNewGroupStarter=false) then exit;
816 ThisFileNum := piece(FileBox.Items[FileBox.ItemIndex],'^',1);
817 if LastFileNum <> ThisFileNum then begin
818 NewFileNum := true;
819 LastFileNum := ThisFileNum;
820 end;
821 if ConditionBox.Visible then begin
822 if (NewFileNum=false) and (ConditionBox.ItemIndex>-1) then begin
823 Result := Result + Piece(ConditionBox.Items[ConditionBox.ItemIndex],'^',1);
824 end else begin
825 Result := Result + ' ' + ConditionBox.Text + ' ';
826 end;
827 end;
828 if FNewGroupStarter then begin
829 Result := Result + '(';
830 end else begin
831 if FileBox.Items.Count = 0 then exit;
832 if FileBox.ItemIndex < 0 then FileBox.ItemIndex := 0;
833 if NewFileNum then Result := Result + ThisFileNum + ':';
834 if FSimpleMode then begin
835 if FieldBox.ItemIndex < 0 then exit;
836 Fld := FieldBox.Items[FieldBox.ItemIndex];
837 Result := Result + '(' + Piece(Fld,'^',1);
838 end else begin
839 Result := Result + '("' + FieldBox.Text + '"';
840 end;
841 Result := Result + Piece(OperatorBox.Items[OperatorBox.ItemIndex],'^',1);
842 Result := Result + '"' + GetSearchValue + '")';
843 end;
844 end;
845
846
847 procedure TLogicRow.OperatorBoxChange(Sender: TObject);
848 begin
849 EnsureProperValueFieldVisible; //If RANGE picked, then this will change edit fields.
850 if (OperatorBox.ItemIndex < 0) and (OperatorBox.Items.Count>0) then begin
851 OperatorBox.ItemIndex := 0;
852 OperatorBox.Text := piece(OperatorBox.Items[0],'^',2);
853 end;
854// ParentSet.
855 end;
856
857 function TLogicRow.GetFileNum : string;
858 begin
859 Result := IntToStr(FileBox.ItemIEN);
860 end;
861
862 function TLogicRow.GetFieldNum : string;
863 begin
864 Result := IntToStr(FieldBox.ItemIEN);
865 end;
866
867 function TLogicRow.GetFieldDataType : TFieldDataType;
868 var SubFileNum : string;
869 FileNum,FieldNum : string;
870 function IsSubFile(FieldDef: string) : boolean;
871 begin
872 SubFileNum := ExtractNum(FieldDef,1);
873 result := (SubFileNum <> '');
874 end;
875 begin
876 Result := fdtUnknown;
877 if Pos('F',FCurFieldDef)>0 then begin //Free text
878 Result := fdtText;
879 end else if Pos('D',FCurFieldDef)>0 then begin //date field
880 Result := fdtDate;
881 end else if Pos('S',FCurFieldDef)>0 then begin //Set of Codes
882 Result := fdtSet;
883 end else if Pos('P',FCurFieldDef)>0 then begin //Pointer to file.
884 Result := fdtPointer;
885 end else if IsSubFile(FCurFieldDef) then begin //Subfiles.
886 FileNum := GetFileNum; FieldNum := GetFieldNum;
887 if (FileNum <> '') and (FieldNum <> '') then begin
888 if IsWPField(FileNum,FieldNum) then Result := fdtWP;
889 end;
890 end;
891 end;
892
893 procedure TLogicRow.FieldBoxChange(Sender: TObject);
894 var Info : string;
895 CurDataType : TFieldDataType;
896 begin
897 if FieldBox.ItemIndex >=0 then begin
898 Info := FieldBox.Items[FieldBox.ItemIndex];
899 end else Info := '';
900 FCurFieldDef := piece(Info,'^',3);
901 FInfoPiece3 := piece(Info,'^',4);
902 EnsureProperValueFieldVisible;
903 CurDataType := GetFieldDataType;
904 Case CurDataType of
905 fdtUnknown,
906 fdtPointer,
907 fdtSet : SelectOperator(COMB_EQUALS);
908 fdtText,
909 fdtWP : SelectOperator(COMB_CONTAINS);
910 fdtDate : SelectOperator(COMB_IN_RANGE);
911 end;
912 //OperatorBoxChange(Self);
913 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
914 end;
915
916 procedure TLogicRow.EditBoxChange(Sender: TObject);
917 begin
918 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
919 end;
920
921 procedure TLogicRow.SetPickerChange(Sender: TObject);
922 begin
923 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
924 end;
925
926 procedure TLogicRow.ConditionChange(Sender: TObject);
927 begin
928 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
929 end;
930
931 procedure TLogicRow.RecordPickerBoxChange(Sender: TObject);
932 begin
933 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
934 end;
935
936 procedure TLogicRow.DatePickerChange(Sender: TObject);
937 begin
938 if Assigned(OnSearchStringChange) then OnSearchStringChange(self);
939 end;
940
941 function TLogicRow.ExtractNum (S : String; StartPos : integer) : string;
942 var i : integer;
943 ch : char;
944 begin
945 result := '';
946 if (S = '') or (StartPos < 0) then exit;
947 i := StartPos;
948 repeat
949 ch := S[i];
950 i := i + 1;
951 if ch in ['0'..'9','.'] then begin
952 Result := Result + ch;
953 end;
954 until (i > length(S)) or not (ch in ['0'..'9','.'])
955 end;
956
957
958 function TLogicRow.SubSetOfFields(SimpleMode : Boolean; FileNum: string;
959 const StartFrom: string; Direction: Integer): TStrings;
960
961 { returns a pointer to a list of file entries (for use in a long list box) -
962 The return value is a pointer to RPCBrokerV.Results, so the data must
963 be used BEFORE the next broker call! }
964 var
965 cmd,RPCResult,GetSimple : string;
966 begin
967 Result := nil; //default
968 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
969 RPCBrokerV.Param[0].Value := '.X'; // not used
970 RPCBrokerV.param[0].ptype := list;
971 cmd := 'FIELD LIST SUBSET';
972 if SimpleMode then GetSimple :='1' else GetSimple :='0';
973 cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction) + '^^' + GetSimple;
974 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
975 RPCBrokerV.Call;
976 if RPCBrokerV.Results.Count > 0 then begin
977 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
978 if piece(RPCResult,'^',1)='-1' then begin
979 // handle error...
980 end else begin
981 RPCBrokerV.Results.Delete(0);
982 if RPCBrokerV.Results.Count=0 then begin
983 //RPCBrokerV.Results.Add('0^<NO DATA>');
984 end;
985 end;
986 Result := RPCBrokerV.Results;
987 end;
988 end;
989
990 procedure TLogicRow.DelButtonClick(Sender : TObject);
991 begin
992 FParentSet.DeleteRow(Self);
993 end;
994
995 function TLogicRow.IsWPField(FileNum,FieldNum : string) : boolean;
996 var RPCResult : string;
997 SrchStr : string;
998 //Idx: integer;
999 begin
1000 SrchStr := FileNum + '^' + FieldNum + '^';
1001 //Idx := CachedWPField.IndexOf(SrchStr + 'YES');
1002 //if Idx > -1 then begin Result := true; exit; end;
1003 //Idx := CachedWPField.IndexOf(SrchStr + 'NO');
1004 //if Idx > -1 then begin Result := false; exit; end;
1005
1006 result := false;
1007 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1008 RPCBrokerV.param[0].ptype := list;
1009 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'IS WP FIELD^' + FileNum + '^' + FieldNum;
1010 RPCBrokerV.Call;
1011 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1012 if piece(RPCResult,'^',1)='-1' then begin
1013 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1014 FMErrorForm.PrepMessage;
1015 FMErrorForm.ShowModal;
1016 end else begin
1017 RPCResult := piece(RPCResult,'^',3);
1018 result := (RPCResult = 'YES');
1019 //CachedWPField.Add(SrchStr + RPCResult);
1020 end;
1021 end;
1022
1023 function TLogicRow.IsValid() : boolean;
1024 var
1025 CurDataType : TFieldDataType;
1026
1027 begin
1028 Result := false; //default to failure
1029 if (FRowNum>0) and (ConditionBox.Text = '') then exit;
1030 if FileBox.Text = '' then exit;
1031 if FieldBox.Text = '' then exit;
1032 if OperatorBox.Text = '' then exit;
1033 Case FSearchValueMode of
1034 vmUnknown : exit;
1035 vmRange : begin
1036 CurDataType := GetFieldDataType;
1037 if CurDataType <> fdtDate then begin
1038 if (ValueEdit.Text = '') or (UpperValueEdit.Text = '') then exit;
1039 end;
1040 end;
1041 vmString,vmNumeric : begin
1042 if (ValueEdit.Text = '') then exit;
1043 end;
1044 vmDate : begin
1045 //Date is always present...
1046 //if (DatePickerBox.Text = '') then exit;
1047 end;
1048 vmSet : begin
1049 if (SetPicker.Text = '') then exit;
1050 end;
1051 vmPointer : begin
1052 if (RecordPickerBox.Text = '') then exit;
1053 end;
1054 end; {case}
1055 Result := true;
1056 end;
1057
1058
1059 function TLogicRow.SubSetOfAllowedFiles(SimpleMode : boolean; FileNum: string;
1060 const StartFrom: string;
1061 Direction: Integer ): TStrings;
1062
1063 { returns a pointer to a list of file entries (for use in a long list box) -
1064 The return value is a pointer to RPCBrokerV.Results, so the data must
1065 be used BEFORE the next broker call! }
1066 var
1067 cmd,RPCResult,GetSimple : string;
1068
1069 begin
1070 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
1071 RPCBrokerV.Param[0].Value := '.X'; // not used
1072 RPCBrokerV.param[0].ptype := list;
1073 cmd := 'ALLOWED FILES ENTRY SUBSET';
1074 if SimpleMode then GetSimple :='1' else GetSimple :='0';
1075 cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction) + '^^' + GetSimple;
1076 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1077 RPCBrokerV.Call;
1078 if RPCBrokerV.Results.Count > 0 then begin
1079 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1080 if piece(RPCResult,'^',1)='-1' then begin
1081 // handle error...
1082 end else begin
1083 RPCBrokerV.Results.Delete(0);
1084 if RPCBrokerV.Results.Count=0 then begin
1085 //RPCBrokerV.Results.Add('0^<NO DATA>');
1086 end;
1087 end;
1088 end;
1089 Result := RPCBrokerV.Results;
1090 end;
1091
1092 function TLogicRow.SubSetOfFile(FileNum: string;
1093 const StartFrom: string;
1094 Direction: Integer ): TStrings;
1095
1096 { returns a pointer to a list of file entries (for use in a long list box) -
1097 The return value is a pointer to RPCBrokerV.Results, so the data must
1098 be used BEFORE the next broker call! }
1099 var
1100 cmd,RPCResult : string;
1101 begin
1102 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1103 RPCBrokerV.Param[0].Value := '.X'; // not used
1104 RPCBrokerV.param[0].ptype := list;
1105 cmd := 'FILE ENTRY SUBSET';
1106 cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction);
1107 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1108 RPCBrokerV.Call;
1109 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1110 if piece(RPCResult,'^',1)='-1' then begin
1111 // handle error...
1112 end else begin
1113 RPCBrokerV.Results.Delete(0);
1114 if RPCBrokerV.Results.Count=0 then begin
1115 //RPCBrokerV.Results.Add('0^<NO DATA>');
1116 end;
1117 end;
1118 Result := RPCBrokerV.Results;
1119 end;
1120
1121
1122 procedure TLogicRow.InitORComboBox(ORComboBox: TORComboBox; initValue : string; boxtype : string);
1123 begin
1124 ORComboBox.Items.Clear;
1125 ORComboBox.Text := ''; //initValue;
1126 ORComboBox.InitLongList(initValue);
1127 if ORComboBox.Items.Count > 0 then begin
1128 ORComboBox.ItemIndex := 0;
1129 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
1130 end else begin
1131 ORComboBox.Text := '<Begin by selecting ' + boxtype + '>';
1132 end;
1133 end;
1134
1135 procedure TLogicRow.IndentMore;
1136 begin
1137 SetIndentLevel(FIndentLevel+1);
1138 end;
1139
1140 procedure TLogicRow.IndentLess;
1141 begin
1142 if FIndentLevel>0 then SetIndentLevel(FIndentLevel-1);
1143 CheckVisibilityIsCorrect;
1144 end;
1145
1146//-----------------------------------------------------------------------
1147// TLogicSet
1148//-----------------------------------------------------------------------
1149
1150 constructor TLogicSet.Create(SearchFileNumber,SearchFileName : string;
1151 AParent : TWinControl; AOwner : TComponent);
1152 begin
1153 Inherited Create;
1154 OnSearchStringChange := nil;
1155 SearchStringEdit := nil;
1156 DelBitmap := nil;
1157 Rows := TList.Create;
1158 FSimpleMode := True;
1159 FSearchFileNumber := SearchFileNumber;
1160 FSearchFileName := SearchFileName;
1161 FParent := AParent;
1162 FOwner := AOwner;
1163 FFileNumsStack := TStringList.Create;
1164 DelBitmap := TBitmap.Create;
1165
1166 btnAddSrchField := TBitBtn.Create(AOwner);
1167 with btnAddSrchField do begin
1168 Visible := false;
1169 Parent := AParent;
1170 Height := 25;
1171 Width := 25;
1172 OnClick := HandleAddQuery;
1173 end;
1174
1175 lblAddAnother := TLabel.Create(AOwner);
1176 with lblAddAnother do begin
1177 Visible := false;
1178 Parent := AParent;
1179 Caption := INT_ADD_QUERYROW_LABEL_CAPTION;
1180 Height := 15;
1181 Hint := 'Add More Search Terms';
1182 ShowHint := true;
1183 ParentShowHint := False;
1184 end;
1185
1186 btnIndentMore := TButton.Create(AOwner);
1187 with btnIndentMore do begin
1188 Visible := false;
1189 Parent := AParent;
1190 Caption := '(';
1191 Height := 15;
1192 Width := 15;
1193 OnClick := HandleIndentMore;
1194 Hint := 'Start New Grouping';
1195 ShowHint := true;
1196 ParentShowHint := False;
1197 end;
1198
1199 btnIndentLess := TButton.Create(AOwner);
1200 with btnIndentLess do begin
1201 Visible := false;
1202 Parent := AParent;
1203 Caption := ')';
1204 Height := 15;
1205 Width := 15;
1206 OnClick := HandleIndentLess;
1207 Hint := 'Close Grouping';
1208 ShowHint := true;
1209 ParentShowHint := False;
1210 end;
1211 //UpdateButtonPlacement; //Done in SetSimpleMode
1212 SetSimpleMode(FSimpleMode);
1213 end;
1214
1215 Destructor TLogicSet.Destroy;
1216 var i : integer;
1217 ARow : TLogicRow;
1218 begin
1219 for i := 0 to Rows.Count-1 do begin
1220 ARow := GetRow(i); if ARow= nil then continue;
1221 ARow.Destroy;
1222 end;
1223 Rows.Free;
1224 FFileNumsStack.Free;
1225 btnAddSrchField.Free;
1226 lblAddAnother.Free;
1227 btnIndentMore.Free;
1228 btnIndentLess.Free;
1229 DelBitmap.Free;
1230 Inherited Destroy;
1231 end;
1232
1233 function TLogicSet.GetRow(Index : integer): TLogicRow;
1234 begin
1235 if (Index > -1) and (Index < Rows.Count) then begin
1236 Result := TLogicRow(Rows.Items[Index]);
1237 end else Result := nil;
1238 end;
1239
1240 function TLogicSet.GetRowCount : integer;
1241 begin
1242 Result := Rows.Count;
1243 end;
1244
1245 function TLogicSet.IndexOf(ARow : TLogicRow) : integer;
1246 begin
1247 Result := Rows.IndexOf(ARow);
1248 end;
1249
1250 function TLogicSet.AddRow : TLogicRow;
1251 var ALogicRow : TLogicRow;
1252 begin
1253 ALogicRow := TLogicRow.Create(FSearchFileNumber,FSearchFileName,FSimpleMode,
1254 FParent,Self,Rows.Count);
1255 ALogicRow.OnSearchStringChange := Handle1RowChange;
1256 if DelBitmap <> nil then ALogicRow.DelButton.Glyph.Assign(DelBitmap);
1257 Rows.Add(ALogicRow);
1258 Result := ALogicRow;
1259 if PriorRow <> nil then begin
1260 ALogicRow.IndentLevel := PriorRow.IndentLevel;
1261 PriorRow.CloseRow;
1262 end;
1263 UpdateButtonPlacement;
1264 end;
1265
1266 procedure TLogicSet.DeleteRow(Index : integer);
1267 var ALogicRow, NextLogicRow : TLogicRow;
1268 i : integer;
1269 IndentLevel : integer;
1270 DeletingLastRow : boolean;
1271 GroupEmpty : boolean;
1272
1273 begin
1274 If Rows.Count=1 then exit; //always leave at least one row present.
1275 if (Index < 0) or (Index > Rows.Count-1) then exit;
1276 DeletingLastRow := (Index = Rows.Count-1);
1277 ALogicRow := GetRow(Index);
1278 if ALogicRow <> nil then begin
1279 IndentLevel := ALogicRow.IndentLevel;
1280 ALogicRow.Destroy;
1281 end else begin
1282 IndentLevel := 0;
1283 end;
1284 Rows.Delete(Index);
1285 for i := 0 to Rows.Count-1 do begin
1286 ALogicRow := GetRow(i);
1287 if ALogicRow = nil then continue;
1288 ALogicRow.SetRowNum(i);
1289 ALogicRow.CheckVisibilityIsCorrect;
1290 end;
1291
1292 //FIX!!! If row is a group starter, then all dependant rows should be
1293 // shifted leftward.
1294
1295 //Check if row prior to that deleted was a group opener
1296 GroupEmpty := false; //default
1297 ALogicRow := GetRow(Index-1);
1298 NextLogicRow := GetRow(Index); //Next in list, that has pulled up into Index's position
1299 if (ALogicRow <> nil) and ALogicRow.NewGroupStarter then begin
1300 //Now see if group is now empty.
1301 if NextLogicRow=nil then begin
1302 GroupEmpty := true;
1303 end else if NextLogicRow.IndentLevel < IndentLevel then begin
1304 GroupEmpty := true;
1305 end;
1306 end;
1307 if GroupEmpty then begin
1308 if Rows.Count > 1 then begin
1309 DeleteRow(ALogicRow);
1310 end else begin
1311 ALogicRow.NewGroupStarter := false;
1312 end;
1313 end;
1314
1315 if DeletingLastRow then begin
1316 ALogicRow := LastRow;
1317 if ALogicRow <> nil then begin
1318 ALogicRow.OpenRow;
1319 ALogicRow.CheckVisibilityIsCorrect;
1320 end;
1321 end;
1322 Handle1RowChange(self);
1323 UpdateButtonPlacement;
1324 end;
1325
1326 procedure TLogicSet.DeleteRow(ARow : TLogicRow);
1327 //NOTE: Don't put details here. Put in OTHER DeleteRow above.
1328 var index : integer;
1329 begin
1330 index := IndexOf(ARow);
1331 DeleteRow(index);
1332 end;
1333
1334 function TLogicSet.PriorRow : TLogicRow;
1335 begin
1336 if Rows.Count>1 then begin
1337 Result := TLogicRow(Rows.Items[Rows.Count-2]);
1338 end else Result := nil;
1339 end;
1340
1341 function TLogicSet.LastRow : TLogicRow;
1342 begin
1343 if Rows.Count>0 then begin
1344 Result := TLogicRow(Rows.Items[Rows.Count-1]);
1345 end else Result := nil;
1346 end;
1347
1348 function TLogicSet.RowBefore (ARow : TLogicRow) : TLogicRow;
1349 var index : integer;
1350 begin
1351 Result := nil;
1352 index := Rows.IndexOf(ARow);
1353 if index > 0 then Result := GetRow(Index-1);
1354 end;
1355
1356 procedure TLogicSet.UpdateButtonPlacement;
1357 var ARow : TLogicRow;
1358 Left, Top : integer;
1359 begin
1360 ARow := LastRow;
1361 if ARow = nil then Top := 50 else Top := ARow.Top;
1362 If LastRow <> nil then Left := LastRow.FileBox.Left else Left := INT_ADD_QUERYROW_BTN_LEFT;
1363 btnAddSrchField.Top := Top + ADD_QUERY_OFFSET;
1364 btnAddSrchField.Left := Left;
1365 btnAddSrchField.Visible := true;
1366
1367 lblAddAnother.Top := Top + ADD_QUERY_OFFSET + INT_COMPONENT_SPACING;
1368 lblAddAnother.Left := btnAddSrchField.Left + btnAddSrchField.Width + INT_COMPONENT_SPACING;
1369 lblAddAnother.Visible := true;
1370
1371 btnIndentMore.Top := btnAddSrchField.Top + btnAddSrchField.Height + INT_COMPONENT_SPACING;
1372 btnIndentMore.Left := lblAddAnother.Left;
1373 btnIndentMore.Visible := not FSimpleMode;
1374
1375 btnIndentLess.Top := btnIndentMore.Top;
1376 btnIndentLess.Left := btnIndentMore.Left + btnIndentMore.Width + + INT_COMPONENT_SPACING;
1377 btnIndentLess.Visible := not FSimpleMode;
1378 end;
1379
1380
1381 procedure TLogicSet.Handle1RowChange(Sender : TObject);
1382 begin
1383 FSearchString := GetSearchString;
1384 if Assigned(OnSearchStringChange) then OnSearchStringChange(Sender);
1385 if Assigned(SearchStringEdit) then SearchStringEdit.Text := FSearchString;
1386 end;
1387
1388 procedure TLogicSet.HandleIndentMore(Sender : TObject);
1389 begin
1390 IndentMore;
1391 end;
1392
1393 procedure TLogicSet.HandleIndentLess(Sender : TObject);
1394 begin
1395 IndentLess;
1396 end;
1397
1398 procedure TLogicSet.HandleAddQuery(Sender : TObject);
1399 var ARow : TLogicRow;
1400 begin
1401 if RowCount > 0 then begin
1402 ARow := LastRow;
1403 if (ARow <> nil) and (ARow.IsValid=false) then begin
1404 MessageDlg('Please complete current row before adding a new one.',mtInformation,[mbOK],0);
1405 exit;
1406 end;
1407 end;
1408 AddRow;
1409 LastRow.Visible := true;
1410 UpdateButtonPlacement;
1411 end;
1412
1413 procedure TLogicSet.IndentMore;
1414 var NewRow : TLogicRow;
1415 begin
1416 if LastRow.IsValid then begin
1417 NewRow := AddRow;
1418 end;
1419 LastRow.NewGroupStarter := true;
1420 NewRow := AddRow;
1421 NewRow.IndentMore;
1422 NewRow.Visible := true;
1423 end;
1424
1425 procedure TLogicSet.IndentLess;
1426 var PriorRow, ARow : TLogicRow;
1427 begin
1428 ARow := LastRow;
1429 if ARow.IndentLevel = 0 then exit;
1430 if ARow.IsValid = true then begin
1431 ARow := AddRow;
1432 end;
1433 ARow.IndentLess;
1434 ARow.Visible := true;
1435 PriorRow := RowBefore(ARow);
1436 if PriorRow = nil then exit;
1437 if PriorRow.NewGroupStarter then begin
1438 DeleteRow(PriorRow);
1439 end;
1440 end;
1441
1442 function TLogicSet.GetSearchString : string;
1443 var
1444 CurFile : string;
1445 ARow : TLogicRow;
1446 CurIndentLevel : integer;
1447 i : integer;
1448 begin
1449 FFileNumsStack.Clear;
1450 FFileNumsStack.Add('');
1451 Result := '';
1452 CurFile := '';
1453 CurIndentLevel := 0;
1454 for i := 0 to Rows.Count-1 do begin
1455 ARow := GetRow(i); if ARow = nil then continue;
1456 if ARow.IndentLevel > CurIndentLevel then begin
1457 Inc(CurIndentLevel);
1458 CurFile := '';
1459 FFileNumsStack.Add('');
1460 end else while (ARow.IndentLevel < CurIndentLevel) do begin
1461 Dec(CurIndentLevel);
1462 FFileNumsStack.Delete(FFileNumsStack.Count-1);
1463 CurFile := FFileNumsStack.Strings[FFileNumsStack.Count-1];
1464 Result := Result + ')';
1465 end;
1466 Result := Result + ARow.GetSearchString(CurFile);
1467 FFileNumsStack.Strings[FFileNumsStack.Count-1] := CurFile;
1468 end;
1469 while CurIndentLevel > 0 do begin
1470 Result := Result + ')';
1471 Dec(CurIndentLevel);
1472 end;
1473 end;
1474
1475 procedure TLogicSet.SetSimpleMode(Value : boolean);
1476 begin
1477 FSimpleMode := Value;
1478 if Value = true then begin
1479 if Assigned(lblFile) then lblFile.Caption := 'Category';
1480 if Assigned(lblField) then lblField.Caption := 'Detail';
1481 if Assigned(lblOperator) then lblOperator.Visible := false;
1482 //if Assigned(lblValue) then lblValue.Caption := 'Value to Search For:';
1483 end else begin
1484 if Assigned(lblFile) then lblFile.Caption := 'Associated File';
1485 if Assigned(lblField) then lblField.Caption := 'Field';
1486 if Assigned(lblOperator) then lblOperator.Visible := True;
1487 //if Assigned(lblValue) then lblValue.Caption := 'Search Value';
1488 end;
1489 if Assigned(SearchStringEdit) then begin
1490 //SearchStringEdit.Visible := not Value;
1491 SearchStringEdit.ReadOnly := Value;
1492 SearchStringEdit.Enabled := not Value;
1493 SearchStringEdit.Color := Colors[not FSimpleMode];
1494 end;
1495 UpdateButtonPlacement;
1496 if LastRow <> nil then LastRow.SimpleMode := Value;
1497 end;
1498
1499 procedure TLogicSet.SetFile(FileNumber,FileName : string);
1500 var i : integer;
1501 begin
1502 if (FSearchFileNumber=FileNumber) and (FSearchFileName=FileName) then exit;
1503 FSearchFileNumber := FileNumber;
1504 FSearchFileName := FileName;
1505 for i := 0 to Rows.Count - 1 do begin
1506 Self.Row[i].SetFile(FileNumber,FileName);
1507 end;
1508 end;
1509
1510 procedure TLogicSet.Clear;
1511 begin
1512 while RowCount > 1 do begin
1513 DeleteRow(LastRow);
1514 end;
1515 if LastRow <> nil then LastRow.Clear;
1516 if Assigned(SearchStringEdit) then SearchStringEdit.Text := FSearchString;
1517 end;
1518
1519
1520end.
1521
Note: See TracBrowser for help on using the repository browser.