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

Last change on this file since 1806 was 801, checked in by Kevin Toppenberg, 15 years ago

Bug fixes. Improved Adding Image
File size: 51.2 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 CallBroker;
977 if RPCBrokerV.Results.Count > 0 then begin
978 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
979 if piece(RPCResult,'^',1)='-1' then begin
980 // handle error...
981 end else begin
982 RPCBrokerV.Results.Delete(0);
983 if RPCBrokerV.Results.Count=0 then begin
984 //RPCBrokerV.Results.Add('0^<NO DATA>');
985 end;
986 end;
987 Result := RPCBrokerV.Results;
988 end;
989 end;
990
991 procedure TLogicRow.DelButtonClick(Sender : TObject);
992 begin
993 FParentSet.DeleteRow(Self);
994 end;
995
996 function TLogicRow.IsWPField(FileNum,FieldNum : string) : boolean;
997 var RPCResult : string;
998 SrchStr : string;
999 //Idx: integer;
1000 begin
1001 SrchStr := FileNum + '^' + FieldNum + '^';
1002 //Idx := CachedWPField.IndexOf(SrchStr + 'YES');
1003 //if Idx > -1 then begin Result := true; exit; end;
1004 //Idx := CachedWPField.IndexOf(SrchStr + 'NO');
1005 //if Idx > -1 then begin Result := false; exit; end;
1006
1007 result := false;
1008 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1009 RPCBrokerV.param[0].ptype := list;
1010 RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'IS WP FIELD^' + FileNum + '^' + FieldNum;
1011 //RPCBrokerV.Call;
1012 CallBroker;
1013 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1014 if piece(RPCResult,'^',1)='-1' then begin
1015 FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
1016 FMErrorForm.PrepMessage;
1017 FMErrorForm.ShowModal;
1018 end else begin
1019 RPCResult := piece(RPCResult,'^',3);
1020 result := (RPCResult = 'YES');
1021 //CachedWPField.Add(SrchStr + RPCResult);
1022 end;
1023 end;
1024
1025 function TLogicRow.IsValid() : boolean;
1026 var
1027 CurDataType : TFieldDataType;
1028
1029 begin
1030 Result := false; //default to failure
1031 if (FRowNum>0) and (ConditionBox.Text = '') then exit;
1032 if FileBox.Text = '' then exit;
1033 if FieldBox.Text = '' then exit;
1034 if OperatorBox.Text = '' then exit;
1035 Case FSearchValueMode of
1036 vmUnknown : exit;
1037 vmRange : begin
1038 CurDataType := GetFieldDataType;
1039 if CurDataType <> fdtDate then begin
1040 if (ValueEdit.Text = '') or (UpperValueEdit.Text = '') then exit;
1041 end;
1042 end;
1043 vmString,vmNumeric : begin
1044 if (ValueEdit.Text = '') then exit;
1045 end;
1046 vmDate : begin
1047 //Date is always present...
1048 //if (DatePickerBox.Text = '') then exit;
1049 end;
1050 vmSet : begin
1051 if (SetPicker.Text = '') then exit;
1052 end;
1053 vmPointer : begin
1054 if (RecordPickerBox.Text = '') then exit;
1055 end;
1056 end; {case}
1057 Result := true;
1058 end;
1059
1060
1061 function TLogicRow.SubSetOfAllowedFiles(SimpleMode : boolean; FileNum: string;
1062 const StartFrom: string;
1063 Direction: Integer ): TStrings;
1064
1065 { returns a pointer to a list of file entries (for use in a long list box) -
1066 The return value is a pointer to RPCBrokerV.Results, so the data must
1067 be used BEFORE the next broker call! }
1068 var
1069 cmd,RPCResult,GetSimple : string;
1070
1071 begin
1072 RPCBrokerV.remoteprocedure := 'TMG SEARCH CHANNEL';
1073 RPCBrokerV.Param[0].Value := '.X'; // not used
1074 RPCBrokerV.param[0].ptype := list;
1075 cmd := 'ALLOWED FILES ENTRY SUBSET';
1076 if SimpleMode then GetSimple :='1' else GetSimple :='0';
1077 cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction) + '^^' + GetSimple;
1078 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1079 //RPCBrokerV.Call;
1080 CallBroker;
1081 if RPCBrokerV.Results.Count > 0 then begin
1082 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1083 if piece(RPCResult,'^',1)='-1' then begin
1084 // handle error...
1085 end else begin
1086 RPCBrokerV.Results.Delete(0);
1087 if RPCBrokerV.Results.Count=0 then begin
1088 //RPCBrokerV.Results.Add('0^<NO DATA>');
1089 end;
1090 end;
1091 end;
1092 Result := RPCBrokerV.Results;
1093 end;
1094
1095 function TLogicRow.SubSetOfFile(FileNum: string;
1096 const StartFrom: string;
1097 Direction: Integer ): TStrings;
1098
1099 { returns a pointer to a list of file entries (for use in a long list box) -
1100 The return value is a pointer to RPCBrokerV.Results, so the data must
1101 be used BEFORE the next broker call! }
1102 var
1103 cmd,RPCResult : string;
1104 begin
1105 RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
1106 RPCBrokerV.Param[0].Value := '.X'; // not used
1107 RPCBrokerV.param[0].ptype := list;
1108 cmd := 'FILE ENTRY SUBSET';
1109 cmd := cmd + '^' + FileNum + '^' + StartFrom + '^' + IntToStr(Direction);
1110 RPCBrokerV.Param[0].Mult['"REQUEST"'] := cmd;
1111 //RPCBrokerV.Call;
1112 CallBroker;
1113 RPCResult := RPCBrokerV.Results[0]; //returns: error: -1; success=1
1114 if piece(RPCResult,'^',1)='-1' then begin
1115 // handle error...
1116 end else begin
1117 RPCBrokerV.Results.Delete(0);
1118 if RPCBrokerV.Results.Count=0 then begin
1119 //RPCBrokerV.Results.Add('0^<NO DATA>');
1120 end;
1121 end;
1122 Result := RPCBrokerV.Results;
1123 end;
1124
1125
1126 procedure TLogicRow.InitORComboBox(ORComboBox: TORComboBox; initValue : string; boxtype : string);
1127 begin
1128 ORComboBox.Items.Clear;
1129 ORComboBox.Text := ''; //initValue;
1130 ORComboBox.InitLongList(initValue);
1131 if ORComboBox.Items.Count > 0 then begin
1132 ORComboBox.ItemIndex := 0;
1133 ORComboBox.Text := Piece(ORComboBox.Items[0],'^',2);
1134 end else begin
1135 ORComboBox.Text := '<Begin by selecting ' + boxtype + '>';
1136 end;
1137 end;
1138
1139 procedure TLogicRow.IndentMore;
1140 begin
1141 SetIndentLevel(FIndentLevel+1);
1142 end;
1143
1144 procedure TLogicRow.IndentLess;
1145 begin
1146 if FIndentLevel>0 then SetIndentLevel(FIndentLevel-1);
1147 CheckVisibilityIsCorrect;
1148 end;
1149
1150//-----------------------------------------------------------------------
1151// TLogicSet
1152//-----------------------------------------------------------------------
1153
1154 constructor TLogicSet.Create(SearchFileNumber,SearchFileName : string;
1155 AParent : TWinControl; AOwner : TComponent);
1156 begin
1157 Inherited Create;
1158 OnSearchStringChange := nil;
1159 SearchStringEdit := nil;
1160 DelBitmap := nil;
1161 Rows := TList.Create;
1162 FSimpleMode := True;
1163 FSearchFileNumber := SearchFileNumber;
1164 FSearchFileName := SearchFileName;
1165 FParent := AParent;
1166 FOwner := AOwner;
1167 FFileNumsStack := TStringList.Create;
1168 DelBitmap := TBitmap.Create;
1169
1170 btnAddSrchField := TBitBtn.Create(AOwner);
1171 with btnAddSrchField do begin
1172 Visible := false;
1173 Parent := AParent;
1174 Height := 25;
1175 Width := 25;
1176 OnClick := HandleAddQuery;
1177 end;
1178
1179 lblAddAnother := TLabel.Create(AOwner);
1180 with lblAddAnother do begin
1181 Visible := false;
1182 Parent := AParent;
1183 Caption := INT_ADD_QUERYROW_LABEL_CAPTION;
1184 Height := 15;
1185 Hint := 'Add More Search Terms';
1186 ShowHint := true;
1187 ParentShowHint := False;
1188 end;
1189
1190 btnIndentMore := TButton.Create(AOwner);
1191 with btnIndentMore do begin
1192 Visible := false;
1193 Parent := AParent;
1194 Caption := '(';
1195 Height := 15;
1196 Width := 15;
1197 OnClick := HandleIndentMore;
1198 Hint := 'Start New Grouping';
1199 ShowHint := true;
1200 ParentShowHint := False;
1201 end;
1202
1203 btnIndentLess := TButton.Create(AOwner);
1204 with btnIndentLess do begin
1205 Visible := false;
1206 Parent := AParent;
1207 Caption := ')';
1208 Height := 15;
1209 Width := 15;
1210 OnClick := HandleIndentLess;
1211 Hint := 'Close Grouping';
1212 ShowHint := true;
1213 ParentShowHint := False;
1214 end;
1215 //UpdateButtonPlacement; //Done in SetSimpleMode
1216 SetSimpleMode(FSimpleMode);
1217 end;
1218
1219 Destructor TLogicSet.Destroy;
1220 var i : integer;
1221 ARow : TLogicRow;
1222 begin
1223 for i := 0 to Rows.Count-1 do begin
1224 ARow := GetRow(i); if ARow= nil then continue;
1225 ARow.Destroy;
1226 end;
1227 Rows.Free;
1228 FFileNumsStack.Free;
1229 btnAddSrchField.Free;
1230 lblAddAnother.Free;
1231 btnIndentMore.Free;
1232 btnIndentLess.Free;
1233 DelBitmap.Free;
1234 Inherited Destroy;
1235 end;
1236
1237 function TLogicSet.GetRow(Index : integer): TLogicRow;
1238 begin
1239 if (Index > -1) and (Index < Rows.Count) then begin
1240 Result := TLogicRow(Rows.Items[Index]);
1241 end else Result := nil;
1242 end;
1243
1244 function TLogicSet.GetRowCount : integer;
1245 begin
1246 Result := Rows.Count;
1247 end;
1248
1249 function TLogicSet.IndexOf(ARow : TLogicRow) : integer;
1250 begin
1251 Result := Rows.IndexOf(ARow);
1252 end;
1253
1254 function TLogicSet.AddRow : TLogicRow;
1255 var ALogicRow : TLogicRow;
1256 begin
1257 ALogicRow := TLogicRow.Create(FSearchFileNumber,FSearchFileName,FSimpleMode,
1258 FParent,Self,Rows.Count);
1259 ALogicRow.OnSearchStringChange := Handle1RowChange;
1260 if DelBitmap <> nil then ALogicRow.DelButton.Glyph.Assign(DelBitmap);
1261 Rows.Add(ALogicRow);
1262 Result := ALogicRow;
1263 if PriorRow <> nil then begin
1264 ALogicRow.IndentLevel := PriorRow.IndentLevel;
1265 PriorRow.CloseRow;
1266 end;
1267 UpdateButtonPlacement;
1268 end;
1269
1270 procedure TLogicSet.DeleteRow(Index : integer);
1271 var ALogicRow, NextLogicRow : TLogicRow;
1272 i : integer;
1273 IndentLevel : integer;
1274 DeletingLastRow : boolean;
1275 GroupEmpty : boolean;
1276
1277 begin
1278 If Rows.Count=1 then exit; //always leave at least one row present.
1279 if (Index < 0) or (Index > Rows.Count-1) then exit;
1280 DeletingLastRow := (Index = Rows.Count-1);
1281 ALogicRow := GetRow(Index);
1282 if ALogicRow <> nil then begin
1283 IndentLevel := ALogicRow.IndentLevel;
1284 ALogicRow.Destroy;
1285 end else begin
1286 IndentLevel := 0;
1287 end;
1288 Rows.Delete(Index);
1289 for i := 0 to Rows.Count-1 do begin
1290 ALogicRow := GetRow(i);
1291 if ALogicRow = nil then continue;
1292 ALogicRow.SetRowNum(i);
1293 ALogicRow.CheckVisibilityIsCorrect;
1294 end;
1295
1296 //FIX!!! If row is a group starter, then all dependant rows should be
1297 // shifted leftward.
1298
1299 //Check if row prior to that deleted was a group opener
1300 GroupEmpty := false; //default
1301 ALogicRow := GetRow(Index-1);
1302 NextLogicRow := GetRow(Index); //Next in list, that has pulled up into Index's position
1303 if (ALogicRow <> nil) and ALogicRow.NewGroupStarter then begin
1304 //Now see if group is now empty.
1305 if NextLogicRow=nil then begin
1306 GroupEmpty := true;
1307 end else if NextLogicRow.IndentLevel < IndentLevel then begin
1308 GroupEmpty := true;
1309 end;
1310 end;
1311 if GroupEmpty then begin
1312 if Rows.Count > 1 then begin
1313 DeleteRow(ALogicRow);
1314 end else begin
1315 ALogicRow.NewGroupStarter := false;
1316 end;
1317 end;
1318
1319 if DeletingLastRow then begin
1320 ALogicRow := LastRow;
1321 if ALogicRow <> nil then begin
1322 ALogicRow.OpenRow;
1323 ALogicRow.CheckVisibilityIsCorrect;
1324 end;
1325 end;
1326 Handle1RowChange(self);
1327 UpdateButtonPlacement;
1328 end;
1329
1330 procedure TLogicSet.DeleteRow(ARow : TLogicRow);
1331 //NOTE: Don't put details here. Put in OTHER DeleteRow above.
1332 var index : integer;
1333 begin
1334 index := IndexOf(ARow);
1335 DeleteRow(index);
1336 end;
1337
1338 function TLogicSet.PriorRow : TLogicRow;
1339 begin
1340 if Rows.Count>1 then begin
1341 Result := TLogicRow(Rows.Items[Rows.Count-2]);
1342 end else Result := nil;
1343 end;
1344
1345 function TLogicSet.LastRow : TLogicRow;
1346 begin
1347 if Rows.Count>0 then begin
1348 Result := TLogicRow(Rows.Items[Rows.Count-1]);
1349 end else Result := nil;
1350 end;
1351
1352 function TLogicSet.RowBefore (ARow : TLogicRow) : TLogicRow;
1353 var index : integer;
1354 begin
1355 Result := nil;
1356 index := Rows.IndexOf(ARow);
1357 if index > 0 then Result := GetRow(Index-1);
1358 end;
1359
1360 procedure TLogicSet.UpdateButtonPlacement;
1361 var ARow : TLogicRow;
1362 Left, Top : integer;
1363 begin
1364 ARow := LastRow;
1365 if ARow = nil then Top := 50 else Top := ARow.Top;
1366 If LastRow <> nil then Left := LastRow.FileBox.Left else Left := INT_ADD_QUERYROW_BTN_LEFT;
1367 btnAddSrchField.Top := Top + ADD_QUERY_OFFSET;
1368 btnAddSrchField.Left := Left;
1369 btnAddSrchField.Visible := true;
1370
1371 lblAddAnother.Top := Top + ADD_QUERY_OFFSET + INT_COMPONENT_SPACING;
1372 lblAddAnother.Left := btnAddSrchField.Left + btnAddSrchField.Width + INT_COMPONENT_SPACING;
1373 lblAddAnother.Visible := true;
1374
1375 btnIndentMore.Top := btnAddSrchField.Top + btnAddSrchField.Height + INT_COMPONENT_SPACING;
1376 btnIndentMore.Left := lblAddAnother.Left;
1377 btnIndentMore.Visible := not FSimpleMode;
1378
1379 btnIndentLess.Top := btnIndentMore.Top;
1380 btnIndentLess.Left := btnIndentMore.Left + btnIndentMore.Width + + INT_COMPONENT_SPACING;
1381 btnIndentLess.Visible := not FSimpleMode;
1382 end;
1383
1384
1385 procedure TLogicSet.Handle1RowChange(Sender : TObject);
1386 begin
1387 FSearchString := GetSearchString;
1388 if Assigned(OnSearchStringChange) then OnSearchStringChange(Sender);
1389 if Assigned(SearchStringEdit) then SearchStringEdit.Text := FSearchString;
1390 end;
1391
1392 procedure TLogicSet.HandleIndentMore(Sender : TObject);
1393 begin
1394 IndentMore;
1395 end;
1396
1397 procedure TLogicSet.HandleIndentLess(Sender : TObject);
1398 begin
1399 IndentLess;
1400 end;
1401
1402 procedure TLogicSet.HandleAddQuery(Sender : TObject);
1403 var ARow : TLogicRow;
1404 begin
1405 if RowCount > 0 then begin
1406 ARow := LastRow;
1407 if (ARow <> nil) and (ARow.IsValid=false) then begin
1408 MessageDlg('Please complete current row before adding a new one.',mtInformation,[mbOK],0);
1409 exit;
1410 end;
1411 end;
1412 AddRow;
1413 LastRow.Visible := true;
1414 UpdateButtonPlacement;
1415 end;
1416
1417 procedure TLogicSet.IndentMore;
1418 var NewRow : TLogicRow;
1419 begin
1420 if LastRow.IsValid then begin
1421 NewRow := AddRow;
1422 end;
1423 LastRow.NewGroupStarter := true;
1424 NewRow := AddRow;
1425 NewRow.IndentMore;
1426 NewRow.Visible := true;
1427 end;
1428
1429 procedure TLogicSet.IndentLess;
1430 var PriorRow, ARow : TLogicRow;
1431 begin
1432 ARow := LastRow;
1433 if ARow.IndentLevel = 0 then exit;
1434 if ARow.IsValid = true then begin
1435 ARow := AddRow;
1436 end;
1437 ARow.IndentLess;
1438 ARow.Visible := true;
1439 PriorRow := RowBefore(ARow);
1440 if PriorRow = nil then exit;
1441 if PriorRow.NewGroupStarter then begin
1442 DeleteRow(PriorRow);
1443 end;
1444 end;
1445
1446 function TLogicSet.GetSearchString : string;
1447 var
1448 CurFile : string;
1449 ARow : TLogicRow;
1450 CurIndentLevel : integer;
1451 i : integer;
1452 begin
1453 FFileNumsStack.Clear;
1454 FFileNumsStack.Add('');
1455 Result := '';
1456 CurFile := '';
1457 CurIndentLevel := 0;
1458 for i := 0 to Rows.Count-1 do begin
1459 ARow := GetRow(i); if ARow = nil then continue;
1460 if ARow.IndentLevel > CurIndentLevel then begin
1461 Inc(CurIndentLevel);
1462 CurFile := '';
1463 FFileNumsStack.Add('');
1464 end else while (ARow.IndentLevel < CurIndentLevel) do begin
1465 Dec(CurIndentLevel);
1466 FFileNumsStack.Delete(FFileNumsStack.Count-1);
1467 CurFile := FFileNumsStack.Strings[FFileNumsStack.Count-1];
1468 Result := Result + ')';
1469 end;
1470 Result := Result + ARow.GetSearchString(CurFile);
1471 FFileNumsStack.Strings[FFileNumsStack.Count-1] := CurFile;
1472 end;
1473 while CurIndentLevel > 0 do begin
1474 Result := Result + ')';
1475 Dec(CurIndentLevel);
1476 end;
1477 end;
1478
1479 procedure TLogicSet.SetSimpleMode(Value : boolean);
1480 begin
1481 FSimpleMode := Value;
1482 if Value = true then begin
1483 if Assigned(lblFile) then lblFile.Caption := 'Category';
1484 if Assigned(lblField) then lblField.Caption := 'Detail';
1485 if Assigned(lblOperator) then lblOperator.Visible := false;
1486 //if Assigned(lblValue) then lblValue.Caption := 'Value to Search For:';
1487 end else begin
1488 if Assigned(lblFile) then lblFile.Caption := 'Associated File';
1489 if Assigned(lblField) then lblField.Caption := 'Field';
1490 if Assigned(lblOperator) then lblOperator.Visible := True;
1491 //if Assigned(lblValue) then lblValue.Caption := 'Search Value';
1492 end;
1493 if Assigned(SearchStringEdit) then begin
1494 //SearchStringEdit.Visible := not Value;
1495 SearchStringEdit.ReadOnly := Value;
1496 SearchStringEdit.Enabled := not Value;
1497 SearchStringEdit.Color := Colors[not FSimpleMode];
1498 end;
1499 UpdateButtonPlacement;
1500 if LastRow <> nil then LastRow.SimpleMode := Value;
1501 end;
1502
1503 procedure TLogicSet.SetFile(FileNumber,FileName : string);
1504 var i : integer;
1505 begin
1506 if (FSearchFileNumber=FileNumber) and (FSearchFileName=FileName) then exit;
1507 FSearchFileNumber := FileNumber;
1508 FSearchFileName := FileName;
1509 for i := 0 to Rows.Count - 1 do begin
1510 Self.Row[i].SetFile(FileNumber,FileName);
1511 end;
1512 end;
1513
1514 procedure TLogicSet.Clear;
1515 begin
1516 while RowCount > 1 do begin
1517 DeleteRow(LastRow);
1518 end;
1519 if LastRow <> nil then LastRow.Clear;
1520 if Assigned(SearchStringEdit) then SearchStringEdit.Text := FSearchString;
1521 end;
1522
1523
1524end.
1525
Note: See TracBrowser for help on using the repository browser.