jvglogics.pas

East make Tray Icon in delphi

procedure TJvgLogicElement.SetNextElement(const Value: TJvgLogicElement);
begin
  if Value = nil then
    FNextElementID := -1
  else
    FNextElementID := Value.ID;
end;

procedure TJvgLogicElement.SetNextFalseElement(const Value: TJvgLogicElement);
begin
  if Value = nil then
    FNextFalseElementID := -1
  else
    FNextFalseElementID := Value.ID;
end;

procedure TJvgLogicElement.SetRule(const Value: TLogicRule);
begin
  FRule := Value;
end;

procedure TJvgLogicElement.SetTrueResult(const Value: string);
begin
  FTrueResult := Value;
end;

procedure TJvgLogicElement.SetValue(const Value: string);
begin
  FValue := Value;
end;

//=== { TJvgLogics } =========================================================

constructor TJvgLogics.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
begin
  inherited Create(AOwner, ItemClass);
  FDictionary := TStringList.Create;
end;

destructor TJvgLogics.Destroy;
begin
  FDictionary.Free;
  inherited Destroy;
end;

procedure TJvgLogics.Loaded;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].Loaded;
end;

function TJvgLogics.GetItem(Index: Integer): TJvgLogicElement;
begin
  Result := TJvgLogicElement(inherited Items[Index]);
end;

procedure TJvgLogics.SetItem(Index: Integer; Value: TJvgLogicElement);
begin
  Items[Index].Assign(Value);
end;

function TJvgLogics.Add: TJvgLogicElement;
begin
  Result := TJvgLogicElement(inherited Add);
end;

function TJvgLogics.Insert(Index: Integer): TJvgLogicElement;
begin
  Result := TJvgLogicElement(inherited Insert(Index));
end;

procedure TJvgLogics.StartAnalyze;
begin
  if Count > 0 then
    TraceItem := Items[0]
  else
    TraceItem := nil;
end;

procedure TJvgLogics.AnalyzeStep;
var
  LogicVariant: TJvgLogicVariant;
begin
  LogicVariant := nil;
  if Assigned(TraceItem) then
  begin
    TraceItem.IsTrue := True;
    if GetItemResult(TraceItem, LogicVariant) then
    begin
      Result := Result + ParseExpression(LogicVariant.TrueResult);
      TraceItem := TraceItem.NextElement;
    end
    else
    begin
      Result := Result + ParseExpression(LogicVariant.FalseResult);
      TraceItem := TraceItem.NextFalseElement;
    end;
  end;
end;

procedure TJvgLogics.Analyze;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].IsTrue := False;

  Result := '';
  I := 0;
  TraceItem := Items[0];
  while Assigned(TraceItem) and (I < 1000) do
  begin
    AnalyzeStep;
    Inc(I);
  end;
end;

function TJvgLogics.GetItemResult(Item: TJvgLogicElement;
  var LogicVariant: TJvgLogicVariant): Boolean;
var
  Expr, Value: string;
  I: Integer;
begin
  Result := False;
  Expr := ParseExpression(Item.Expression);
  if IgnoreSpaces then
    Expr := Trim(Expr);

  for I := 0 to Item.LogicVariants.Count - 1 do
  begin
    Value := ParseExpression(Item.LogicVariants[I].Value);

    case Item.Rule of
      lrEqual:
        Result := Expr = Value;
      lrBeginWith:
        Result := Pos(Value, Expr) = 1;
      lrEndWith:
        Result := Copy(Expr, Length(Expr) - Length(Value) + 1, Length(Value)) = Value;
      lrContains:
        Result := Pos(Expr, Value) <> 1;
      lrContainsIn:
        Result := Pos(Value, Expr) <> 1;
      ltNotEmpty:
        Result := Length(Expr) > 0;
    end;

    LogicVariant := Item.LogicVariants[I];
    if Result and (Item.LogicVariants[I].TrueResult > '') then
      Break;
    if not Result and (Item.LogicVariants[I].FalseResult > '') then
      Break;
  end;

  if Assigned(FOnTraceMessage) then
    FOnTraceMessage(Self, Result,
      IIF(Result, Item.TrueResult, Item.FalseResult),
      ParseExpression(IIF(Result, Item.TrueResult, Item.FalseResult)),
      Item.Caption + '  :  ' + IIF(Result, 'TRUE', 'FALSE') +
      '  :  ' + IIF(Result, Item.TrueResult, Item.FalseResult));
end;

function TJvgLogics.ParseExpression(const Value: string): string;
var
  I: Integer;
begin
  Result := Value;
  Result := StringReplace(Result, '[RESULT]', Self.Result,
    [rfReplaceAll, rfIgnoreCase]);
  for I := 0 to Dictionary.Count - 1 do
    Result := StringReplace(Result, '[' + Dictionary.Names[I] + ']',
      Dictionary.Values[Dictionary.Names[I]], [rfReplaceAll, rfIgnoreCase]);

  I := 1;
  while I <= Length(Result) do
  begin
    if Result[I] = '[' then
    begin
      repeat
        Result[I] := '[';
        Inc(I);
      until (I > Length(Result)) or (Result[I] = ']');
      if (I <= Length(Result)) and (Result[I] = ']') then
        Result[I] := '[';
    end;
    Inc(I);
  end;
  Result := StringReplace(Result, '[', '', [rfReplaceAll]);
end;

function TJvgLogics.GetDictionary: TStrings;
begin
  Result := FDictionary;
end;

procedure TJvgLogics.SetDictionary(const Value: TStrings);
begin
  FDictionary.Assign(Value);
end;

//=== { TJvgLogicProducer } ==================================================

constructor TJvgLogicProducer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLogics := TJvgLogics.Create(Self, TJvgLogicElement);
  FCommentAreas := TJvgCommentAreas.Create(Self, TJvgCommentArea);
end;

destructor TJvgLogicProducer.Destroy;
begin
  FLogics.Free;
  inherited Destroy;
end;

procedure TJvgLogicProducer.Loaded;
begin
  inherited Loaded;
  Logics.Loaded;
end;

function TJvgLogicProducer.GetDictionary: TStrings;
begin
  Result := Logics.Dictionary;
end;

procedure TJvgLogicProducer.SetCommentAreas(const Value: TJvgCommentAreas);
begin
  FCommentAreas.Assign(Value);
end;

procedure TJvgLogicProducer.SetDictionary(const Value: TStrings);
begin
  Logics.Dictionary.Assign(Value);
end;

procedure TJvgLogicProducer.SetIgnoreSpaces(const Value: Boolean);
begin
  Logics.IgnoreSpaces := Value;
end;

function TJvgLogicProducer.GetIgnoreSpaces: Boolean;
begin
  Result := Logics.IgnoreSpaces;
end;

procedure TJvgLogicProducer.SetLogics(const Value: TJvgLogics);
begin
  FLogics := Value;
end;

procedure TJvgLogicProducer.SetOnTraceMessage(const Value: TOnTraceMessage);
begin
  Logics.OnTraceMessage := Value;
end;

function TJvgLogicProducer.GetOnTraceMessage: TOnTraceMessage;
begin
  Result := Logics.OnTraceMessage;
end;

//=== { TJvgCommentAreas } ===================================================

function TJvgCommentAreas.Add: TJvgCommentArea;
begin
  Result := TJvgCommentArea(inherited Add);
  Result.Text := RsComments;
end;

function TJvgCommentAreas.GetItem(Index: Integer): TJvgCommentArea;
begin
  Result := TJvgCommentArea(inherited Items[Index]);
end;

function TJvgCommentAreas.Insert(Index: Integer): TJvgCommentArea;
begin
  Result := TJvgCommentArea(inherited Insert(Index));
end;

procedure TJvgCommentAreas.SetItem(Index: Integer; Value: TJvgCommentArea);
begin
  Items[Index].Assign(Value);
end;

//=== { TJvgLogicVariants } ==================================================

function TJvgLogicVariants.Add: TJvgLogicVariant;
begin
  Result := TJvgLogicVariant(inherited Add);
end;

function TJvgLogicVariants.GetItem(Index: Integer): TJvgLogicVariant;
begin
  Result := TJvgLogicVariant(inherited Items[Index]);
end;

function TJvgLogicVariants.Insert(Index: Integer): TJvgLogicVariant;
begin
  Result := TJvgLogicVariant(inherited Insert(Index));
end;

procedure TJvgLogicVariants.SetItem(Index: Integer; Value: TJvgLogicVariant);
begin
  Items[Index].Assign(Value);
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.