jcledi.pas

East make Tray Icon in delphi

  Result := Item;
  // Set current item
  if Item.NextItem <> nil then
    FCurrentItem := Item.NextItem
  else
    FCurrentItem := Item.PriorItem;
  // Extract the item and relink existing items.
  if Item.NextItem <> nil then
    Item.NextItem.PriorItem := Item.PriorItem;
  if Item.PriorItem <> nil then
    Item.PriorItem.NextItem := Item.NextItem;
  if Item = FFirstItem then
    FFirstItem := Item.NextItem;
  if Item = FLastItem then
    FLastItem := Item.PriorItem;
  // Update the count
  Dec(FCount);
end;

procedure TEDIObjectList.Add(Item: TEDIObjectListItem; Name: string);
begin
  Item.Parent := Self;
  Item.Name := Name;
  Item.NextItem := nil;
  Item.PriorItem := nil;
  if FLastItem <> nil then
  begin
    Item.PriorItem := FLastItem;
    FLastItem.NextItem := Item;
  end;
  if FFirstItem = nil then
    FFirstItem := Item;
  FLastItem := Item;
  FCurrentItem := Item;
  Inc(FCount);
end;

function TEDIObjectList.FindEDIObject(EDIObject: TEDIObject): TEDIObject;
var
  ListItem: TEDIObjectListItem;
begin
  Result := nil;
  ListItem := FFirstItem;
  while ListItem <> nil do
  begin
    if ListItem.EDIObject = EDIObject then
    begin
      FCurrentItem := ListItem;
      Result := ListItem.EDIObject;
      Break;
    end;
    ListItem := ListItem.NextItem;
  end;
end;

function TEDIObjectList.Find(Item: TEDIObjectListItem): TEDIObjectListItem;
var
  ListItem: TEDIObjectListItem;
begin
  Result := nil;
  ListItem := FFirstItem;
  while ListItem <> nil do
  begin
    if ListItem = Item then
    begin
      FCurrentItem := ListItem;
      Result := ListItem;
      Break;
    end;
    ListItem := ListItem.NextItem;
  end;
end;

function TEDIObjectList.Find(EDIObject: TEDIObject): TEDIObjectListItem;
var
  ListItem: TEDIObjectListItem;
begin
  Result := nil;
  ListItem := FFirstItem;
  while ListItem <> nil do
  begin
    if ListItem.EDIObject = EDIObject then
    begin
      FCurrentItem := ListItem;
      Result := ListItem;
      Break;
    end;
    ListItem := ListItem.NextItem;
  end;
end;

function TEDIObjectList.IndexIsValid(Index: Integer): Boolean;
begin
  Result := False;
  if (FCount > 0) and (Index >= 0) and (Index <= FCount - 1) then
    Result := True;
end;

function TEDIObjectList.Insert(Item, BeforeItem: TEDIObjectListItem): TEDIObjectListItem;
begin
  Result := Item;
  if Result = nil then
    Result := CreateListItem(BeforeItem, nil);
  Result.Parent := Self;
  Result.PriorItem := nil;
  Result.NextItem := nil;
  if BeforeItem <> nil then // Insert item
  begin
    Result.PriorItem := BeforeItem.PriorItem;
    BeforeItem.PriorItem := Result;
    if Result.PriorItem <> nil then
      Result.PriorItem.NextItem := Result;
    Result.NextItem := BeforeItem;
  end
  else
  if FFirstItem <> nil then  // Insert as first item
  begin
    FFirstItem.PriorItem := Result;
    Result.NextItem := FFirstItem;
    FFirstItem := Result;
  end
  else
    Add(Result); // Add as first item
  FCurrentItem := Result;
  Inc(FCount);
end;

function TEDIObjectList.Insert(EDIObject, BeforeEDIObject: TEDIObject): TEDIObjectListItem;
var
  BeforeItem: TEDIObjectListItem;
begin
  BeforeItem := Find(BeforeEDIObject);
  Result := CreateListItem(BeforeItem, EDIObject);
  Insert(Result, BeforeItem);
end;

function TEDIObjectList.Insert(BeforeItem: TEDIObjectListItem): TEDIObjectListItem;
begin
  Result := CreateListItem(BeforeItem, nil);
  Insert(Result, BeforeItem);
end;

function TEDIObjectList.Insert(BeforeEDIObject: TEDIObject): TEDIObjectListItem;
begin
  Result := Insert(nil, BeforeEDIObject);
end;

//=== { TEDIDataObjectListItem } =============================================

function TEDIDataObjectListItem.GetEDIDataObject: TEDIDataObject;
begin
  Result := TEDIDataObject(FEDIObject);
end;

procedure TEDIDataObjectListItem.SetEDIDataObject(const Value: TEDIDataObject);
begin
  FEDIObject := Value;
end;

//=== { TEDIDataObjectList } =================================================

function TEDIDataObjectList.CreateListItem(PriorItem: TEDIObjectListItem;
  EDIObject: TEDIObject): TEDIObjectListItem;
begin
  Result := TEDIDataObjectListItem.Create(Self, PriorItem, EDIObject);
end;

function TEDIDataObjectList.GetEDIDataObject(Index: Integer): TEDIDataObject;
begin
  Result := TEDIDataObject(GetEDIObject(Index));
end;

procedure TEDIDataObjectList.SetEDIDataObject(Index: Integer; const Value: TEDIDataObject);
begin
  SetEDIObject(Index, Value);
end;

function TEDIObjectList.CreateListItem(PriorItem: TEDIObjectListItem;
  EDIObject: TEDIObject = nil): TEDIObjectListItem;
begin
  Result := TEDIObjectListItem.Create(Self, PriorItem, EDIObject);
end;

//=== { TEDILoopStack } ======================================================

constructor TEDILoopStack.Create;
begin
  inherited Create;
  SetLength(FStack, 0);
  FFlags := [];
end;

destructor TEDILoopStack.Destroy;
var
  I: Integer;
begin
  for I := Low(FStack) to High(FStack) do
    FStack[I].EDIObject := nil;
  SetLength(FStack, 0);
  inherited Destroy;
end;

function TEDILoopStack.Debug: string;
var
  I: Integer;
begin
  Result := 'Loop Stack' + AnsiLineBreak;
  for I := 0 to High(FStack) do
    Result := Result + FStack[I].SegmentId + ', ' +
      FStack[I].OwnerLoopId + ', ' +
      FStack[I].ParentLoopId + ', ' +
      IntToStr(FStack[I].SpecStartIndex) + AnsiLineBreak;
end;

procedure TEDILoopStack.DoAddLoop(StackRecord: TEDILoopStackRecord;
  SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject);
begin
  if Assigned(FOnAddLoop) then
    FOnAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
end;

function TEDILoopStack.GetSafeStackIndex(Index: Integer): Integer;
begin
  if Length(FStack) > 0 then
  begin
    if Index >= Low(FStack) then
    begin
      if Index <= High(FStack) then
        Result := Index
      else
        Result := High(FStack);
    end
    else
      Result := Low(FStack);
  end
  else
    raise EJclEDIError.CreateResFmt(@RsEDIError057, [IntToStr(Index)]);
end;

function TEDILoopStack.GetSize: Integer;
begin
  Result := Length(FStack);
end;

function TEDILoopStack.Peek: TEDILoopStackRecord;
begin
  Result := FStack[High(FStack)];
end;

function TEDILoopStack.Peek(Index: Integer): TEDILoopStackRecord;
begin
  if Length(FStack) > 0 then
    if Index >= Low(FStack) then
      if Index <= High(FStack) then
        Result := FStack[Index]
      else
        raise EJclEDIError.CreateResFmt(@RsEDIError054, [IntToStr(Index)])
    else
      raise EJclEDIError.CreateResFmt(@RsEDIError055, [IntToStr(Index)])
  else
    raise EJclEDIError.CreateResFmt(@RsEDIError056, [IntToStr(Index)]);
end;

procedure TEDILoopStack.Pop(Index: Integer);
begin
  // Resize loop stack if the index is less than the length
  if (Index >= 0) and (Index < Length(FStack)) then
  begin
    SetLength(FStack, Index);
    FFlags := FFlags + [ediStackResized];
  end;
end;

function TEDILoopStack.Push(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer;
  EDIObject: TEDIObject): Integer;
begin
  // Add to loop stack
  SetLength(FStack, Length(FStack) + 1);
  UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject);
  Result := High(FStack);
end;

function TEDILoopStack.SetStackPointer(OwnerLoopId,
  ParentLoopId: string): Integer;
var
  I: Integer;
begin
  FFlags := FFlags - [ediStackResized];
  FFlags := FFlags - [ediAltStackPointer];
  Result := -1; // Entry not found
  // Find the loop in the stack
  for I := High(FStack) downto 0 do
  begin
    if (OwnerLoopId = FStack[I].OwnerLoopId) and
      (ParentLoopId = FStack[I].ParentLoopId) then
    begin
      Result := I;
      // Pop entries from the stack starting at the index after the found loop
      Pop(I + 1);
      Break;
    end;
  end;
  // Check if an exact entry was found
  if Result = -1 then
  begin
    // Find the parent loop in the stack
    for I := High(FStack) downto 0 do
    begin
      if (ParentLoopId = FStack[I].ParentLoopId) and
        (FStack[I].OwnerLoopId <> NA_LoopId) then
      begin
        FFlags := FFlags + [ediAltStackPointer];
        Result := GetSafeStackIndex(I);
        // Pop entries from the stack starting at the index after the found loop
        Pop(I + 1);
        Break;
      end;
    end;
  end;
end;

procedure TEDILoopStack.UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId: string;
  StartIndex: Integer; EDIObject: TEDIObject);
begin
  FStack[High(FStack)].SegmentId := SegmentId;
  FStack[High(FStack)].OwnerLoopId := OwnerLoopId;
  FStack[High(FStack)].ParentLoopId := ParentLoopId;
  FStack[High(FStack)].SpecStartIndex := StartIndex;
  FStack[High(FStack)].EDIObject := EDIObject;
end;

procedure TEDILoopStack.UpdateStackObject(EDIObject: TEDIObject);
begin
  FStack[High(FStack)].EDIObject := EDIObject;
end;

function TEDILoopStack.ValidateLoopStack(SegmentId, OwnerLoopId, ParentLoopId: string;
  StartIndex: Integer; EDIObject: TEDIObject): TEDILoopStackRecord;
var
  I: Integer;
  StackRecord: TEDILoopStackRecord;
begin
  if Length(FStack) <= 0 then
    // Add entry to stack
    Push(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject)
  else
  begin
    I := SetStackPointer(OwnerLoopId, ParentLoopId);
    if I >= 0 then // Entry found
    begin
      if ediLoopRepeated in FFlags then
      begin
        // Get the previous stack record so the repeated loop will not be nested
        StackRecord := Peek(I-1);
        // In event handler add loop to external data structure since it repeated
        // See JclEDI_ANSIX12.TEDITransactionSetDocument class for implementation example.
        DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
        // Update stack object only
        UpdateStackObject(EDIObject);
        // Debug
        // ShowMessage('LoopRepeated');
      end
      else
      if ediAltStackPointer in FFlags then
      begin
        // Get the previous stack record because the loop
        // is not to be nested at the current stack pointer
        StackRecord := Peek(I-1);
        // In event handler add loop to external data structure since it is new
        // See JclEDI_ANSIX12.TEDITransactionSetDocument class for implementation example.
        DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
        // Update stack entry
        UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject);
        // Debug
        // ShowMessage('AltStackPointer');
      end
      else
      if ediStackResized in FFlags then
      begin
        // Debug
        // ShowMessage('Stack Size Decreased');
      end
      else
      begin
        // Segment is part of loop
      end;
    end
    else
    if I = -1 then // Entry not found.
    begin
      // In event handler add loop since it is new
      StackRecord := Peek;
      // In event handler add loop to external data structure since it is new
      DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject);
      // Add entry to stack
      Push(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject);
      // Debug
      // ShowMessage('Stack Size Increased');
    end;
  end;
  Result := Peek;
end;

end.