jcledi.pas

East make Tray Icon in delphi

      begin
        Offset := Offset + SearchPatternLength;
        if not (rfReplaceAll in Flags) then
          Break;
      end;
    end;

    if Offset <= Length(Result) then
      Result[I] := S[Offset]
    else
    begin
      Result[I] := #0;
      SetLength(Result, I-1);
      Break;
    end;

    if not (rfReplaceAll in Flags) then
      Break;

    Inc(I);
    Inc(Offset);
  end;
end;

function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
  SearchString, SearchPattern: string;
  I, SearchIndex, ReplaceIndex: Integer;
  SearchPatternLength, ReplacePatternLength: Integer;
  SearchResult, ReplaceCount: Integer;
begin
  Result := '';
  // Handle Case Sensitivity
  if rfIgnoreCase in Flags then
  begin
    SearchString := AnsiUpperCase(S);
    SearchPattern := AnsiUpperCase(OldPattern);
  end
  else
  begin
    SearchString := S;
    SearchPattern := OldPattern;
  end;
  SearchPatternLength := Length(OldPattern);
  ReplacePatternLength := Length(NewPattern);
  // Calculate length of result string
  ReplaceCount := 0;
  SearchResult := StrSearch(SearchPattern, SearchString, 1);
  if rfReplaceAll in Flags then
    while SearchResult <> 0 do
    begin
      Inc(SearchResult);
      Inc(ReplaceCount);
      SearchResult := StrSearch(SearchPattern, SearchString, SearchResult);
    end
  else
    if SearchResult <> 0 then
      Inc(ReplaceCount);
  SetLength(Result, Length(S) + ((ReplacePatternLength - SearchPatternLength) * ReplaceCount));
  // Copy the characters by looping through the result and source at the same time
  ReplaceCount := 0;
  ReplaceIndex := 1;
  SearchIndex := 1;
  // Loop while the indexes are still in range
  while (ReplaceIndex <= Length(Result)) and (SearchIndex <= Length(SearchString)) do
  begin
    // Enter algorithm if replacing a pattern or there have been no replacements yet
    if (rfReplaceAll in Flags) or ((not (rfReplaceAll in Flags)) and (ReplaceCount = 0)) then
      // Replace the pattern (including repeating patterns)
      while Copy(SearchString, SearchIndex, SearchPatternLength) = SearchPattern do
      begin
        // Move forward in the search string
        SearchIndex := SearchIndex + Length(SearchPattern);
        // Replace an old pattern by writing the new pattern to the result
        I := 1;
        while (ReplaceIndex <= Length(Result)) and (I <= ReplacePatternLength) do
        begin
          Result[ReplaceIndex] := NewPattern[I];
          Inc(I);
          Inc(ReplaceIndex);
        end;
        //
        Inc(ReplaceCount);
        // If only making one replacement then break
        if not (rfReplaceAll in Flags) then
          Break;
      end;

    // Copy character
    if (ReplaceIndex <= Length(Result)) and (SearchIndex <= Length(SearchString)) then
      Result[ReplaceIndex] := S[SearchIndex];

    // Set indexes for next copy
    Inc(SearchIndex);
    Inc(ReplaceIndex);
  end;
end;

//=== { TEDIDelimiters } =====================================================

constructor TEDIDelimiters.Create;
begin
  Create('~', '*', '>');
end;

constructor TEDIDelimiters.Create(const SD, ED, SS: string);
begin
  inherited Create;
  SetSD(SD);
  SetED(ED);
  SetSS(SS);
end;

procedure TEDIDelimiters.SetED(const Delimiter: string);
begin
  FElementDelimiter := Delimiter;
  FElementDelimiterLength := Length(FElementDelimiter);
end;

procedure TEDIDelimiters.SetSD(const Delimiter: string);
begin
  FSegmentDelimiter := Delimiter;
  FSegmentDelimiterLength := Length(FSegmentDelimiter);
end;

procedure TEDIDelimiters.SetSS(const Delimiter: string);
begin
  FSubelementSeperator := Delimiter;
  FSubelementSeperatorLength := Length(FSubElementSeperator);
end;

//=== { TEDIDataObject } =====================================================

constructor TEDIDataObject.Create(Parent: TEDIDataObject);
begin
  inherited Create;
  FState := ediCreated;
  FEDIDOT := ediUnknown;
  FData := '';
  FLength := 0;
  FParent := Parent;
  FDelimiters := nil;
  FSpecPointer := nil;
  FCustomData1 := nil;
  FCustomData2 := nil;
  {$IFDEF ENABLE_EDI_DEBUGGING}
  Inc(Debug_EDIDataObjectsCreated);
  {$ENDIF ENABLE_EDI_DEBUGGING}
end;

destructor TEDIDataObject.Destroy;
begin
  {$IFDEF ENABLE_EDI_DEBUGGING}
  Inc(Debug_EDIDataObjectsDestroyed);
  {$ENDIF ENABLE_EDI_DEBUGGING}
  if not Assigned(FParent) then
    FDelimiters.Free;
  FDelimiters := nil;
  FSpecPointer := nil;
  FCustomData1 := nil;
  FCustomData2 := nil;
  inherited Destroy;
end;

function TEDIDataObject.GetData: string;
begin
  Result := FData;
end;

procedure TEDIDataObject.SetData(const Data: string);
begin
  FData := Data;
  FLength := Length(FData);
end;

procedure TEDIDataObject.SetDelimiters(const Delimiters: TEDIDelimiters);
begin
  if not Assigned(FParent) then
    FreeAndNil(FDelimiters);
  FDelimiters := Delimiters;
end;

//=== { TEDIDataObjectGroup } ================================================

constructor TEDIDataObjectGroup.Create(Parent: TEDIDataObject; EDIDataObjectCount: Integer);
begin
  inherited Create(Parent);
  FCreateObjectType := ediUnknown;
  FGroupIsParent := True;
  FEDIDataObjects := TEDIDataObjectList.Create;
  if EDIDataObjectCount > 0 then
    AddEDIDataObjects(EDIDataObjectCount);
end;

function TEDIDataObjectGroup.AddEDIDataObjects(Count: Integer): Integer;
var
  I: Integer;
begin
  Result := FEDIDataObjects.Count; // Return position of 1st
  for I := 1 to Count do
    FEDIDataObjects.Add(InternalCreateEDIDataObject);
end;

function TEDIDataObjectGroup.AddEDIDataObject: Integer;
begin
  Result := FEDIDataObjects.Count; // Return position
  FEDIDataObjects.Add(InternalCreateEDIDataObject);
end;

function TEDIDataObjectGroup.AppendEDIDataObject(EDIDataObject: TEDIDataObject): Integer;
begin
  Result := FEDIDataObjects.Count; // Return position
  FEDIDataObjects.Add(EDIDataObject);
  if FGroupIsParent then
    EDIDataObject.Parent := Self;
end;

function TEDIDataObjectGroup.AppendEDIDataObjects(EDIDataObjectArray: TEDIDataObjectArray): Integer;
var
  I: Integer;
begin
  Result := FEDIDataObjects.Count; // Return position of 1st
  for I := Low(EDIDataObjectArray) to High(EDIDataObjectArray) do
  begin
    FEDIDataObjects.Add(EDIDataObjectArray[I]);
    if FGroupIsParent then
      EDIDataObjectArray[I].Parent := Self;
  end;
end;

procedure TEDIDataObjectGroup.DeleteEDIDataObject(EDIDataObject: TEDIDataObject);
begin
  if loAutoUpdateIndexes in FEDIDataObjects.Options then
    FEDIDataObjects.Delete(EDIDataObject)
  else
    FEDIDataObjects.Remove(EDIDataObject);
end;

procedure TEDIDataObjectGroup.DeleteEDIDataObject(Index: Integer);
begin
  if IndexIsValid(Index) then
    FEDIDataObjects.Delete(Index)
  else
    raise EJclEDIError.CreateResFmt(@RsEDIError010, [Self.ClassName, IntToStr(Index)]);
end;

procedure TEDIDataObjectGroup.DeleteEDIDataObjects;
begin
  FEDIDataObjects.Clear;
end;

procedure TEDIDataObjectGroup.DeleteEDIDataObjects(Index, Count: Integer);
var
  I: Integer;
begin
  if IndexIsValid(Index) then
  begin
    FEDIDataObjects.Options := FEDIDataObjects.Options - [loAutoUpdateIndexes];
    try
      for I := 1 to Count do
        DeleteEDIDataObject(Index);
    finally
      FEDIDataObjects.Options := FEDIDataObjects.Options + [loAutoUpdateIndexes];
    end;
  end
  else
    raise EJclEDIError.CreateResFmt(@RsEDIError011, [IntToStr(Index)]);
end;

destructor TEDIDataObjectGroup.Destroy;
begin
  DeleteEDIDataObjects;
  FreeAndNil(FEDIDataObjects);
  inherited Destroy;
end;

function TEDIDataObjectGroup.GetEDIDataObject(Index: Integer): TEDIDataObject;
begin
  if FEDIDataObjects.Count > 0 then
    if Index >= 0 then
      if Index <= FEDIDataObjects.Count - 1 then
      begin
        if not Assigned(FEDIDataObjects[Index]) then
          raise EJclEDIError.CreateResFmt(@RsEDIError006, [Self.ClassName, IntToStr(Index)]);
        Result := FEDIDataObjects[Index];
      end
      else
        raise EJclEDIError.CreateResFmt(@RsEDIError005, [Self.ClassName, IntToStr(Index)])
    else
      raise EJclEDIError.CreateResFmt(@RsEDIError004, [Self.ClassName, IntToStr(Index)])
  else
    raise EJclEDIError.CreateResFmt(@RsEDIError003, [Self.ClassName, IntToStr(Index)]);
end;

function TEDIDataObjectGroup.IndexIsValid(Index: Integer): Boolean;
begin
  Result := FEDIDataObjects.IndexIsValid(Index);
end;

function TEDIDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer): Integer;
begin
  Result := InsertIndex; // Return position
  if IndexIsValid(InsertIndex) then
    FEDIDataObjects.Insert(InsertIndex, InternalCreateEDIDataObject)
  else
    Result := AddEDIDataObject;
end;

function TEDIDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer;
  EDIDataObject: TEDIDataObject): Integer;
begin
  Result := InsertIndex; // Return position
  if IndexIsValid(InsertIndex) then
  begin
    FEDIDataObjects.Insert(InsertIndex, EDIDataObject);
    if FGroupIsParent then
      EDIDataObject.Parent := Self;
  end
  else
    Result := AppendEDIDataObject(EDIDataObject);
end;

function TEDIDataObjectGroup.InsertEDIDataObjects(InsertIndex: Integer;
  EDIDataObjectArray: TEDIDataObjectArray): Integer;
var
  I: Integer;
begin
  Result := InsertIndex; // Return position of 1st
  if IndexIsValid(InsertIndex) then
  begin
    for I := High(EDIDataObjectArray) downto Low(EDIDataObjectArray) do
    begin
      FEDIDataObjects.Insert(InsertIndex, EDIDataObjectArray[I]);
      if FGroupIsParent then
        EDIDataObjectArray[I].Parent := Self;
    end;
  end
  else
    Result := AppendEDIDataObjects(EDIDataObjectArray);
end;

function TEDIDataObjectGroup.InsertEDIDataObjects(InsertIndex, Count: Integer): Integer;
var
  I: Integer;
begin
  Result := InsertIndex; // Return position of 1st
  if IndexIsValid(InsertIndex) then
  begin
    for I := 1 to Count do
      FEDIDataObjects.Insert(InsertIndex, InternalCreateEDIDataObject);
  end
  else
    Result := AddEDIDataObjects(Count);
end;

procedure TEDIDataObjectGroup.SetEDIDataObject(Index: Integer; EDIDataObject: TEDIDataObject);
begin
  if FEDIDataObjects.Count > 0 then
    if Index >= 0 then
      if Index <= FEDIDataObjects.Count - 1 then
      begin
        FEDIDataObjects.Item[Index].FreeAndNilEDIDataObject;
        FEDIDataObjects[Index] := EDIDataObject;
        if FGroupIsParent then
          FEDIDataObjects[Index].Parent := Self;
      end
      else
        raise EJclEDIError.CreateResFmt(@RsEDIError009, [Self.ClassName, IntToStr(Index)])
    else
      raise EJclEDIError.CreateResFmt(@RsEDIError008, [Self.ClassName, IntToStr(Index)])
  else
    raise EJclEDIError.CreateResFmt(@RsEDIError007, [Self.ClassName, IntToStr(Index)]);
end;

function TEDIDataObjectGroup.GetIndexPositionFromParent: Integer;
var
  I: Integer;
  ParentGroup: TEDIDataObjectGroup;
begin
  Result := -1;
  if Assigned(Parent) and (Parent is TEDIDataObjectGroup) then
  begin
    ParentGroup := TEDIDataObjectGroup(Parent);
    for I := 0 to ParentGroup.EDIDataObjectCount - 1 do
      if ParentGroup.EDIDataObject[I] = Self then
      begin
        Result := I;
        Break;
      end;
  end; // if
end;

function TEDIDataObjectGroup.GetCount: Integer;
begin
  Result := FEDIDataObjects.Count;
end;

//=== { TEDIObjectListItem } =================================================

constructor TEDIObjectListItem.Create(Parent: TEDIObjectList;
  PriorItem: TEDIObjectListItem; EDIObject: TEDIObject = nil);
begin
  inherited Create;
  FName := '';
  FParent := Parent;
  FItemIndex := 0;