mandysoft.vcl.ansiclasses.pas

boomerang library 5.11 internet ed

  finally
    EndUpdate;
  end;
  Reader.ReadListEnd;
end;

procedure TAnsiStrings.SaveToFile(const FileName: AnsiString);
begin
  SaveToFile(FileName, nil);
end;

procedure TAnsiStrings.SaveToFile(const FileName: AnsiString; Encoding: System.Text.Encoding);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream, Encoding);
  finally
    Stream.Free;
  end;
end;

procedure TAnsiStrings.SaveToStream(Stream: TStream);
begin
  SaveToStream(Stream, nil);
end;

procedure TAnsiStrings.SaveToStream(Stream: TStream; Encoding: System.Text.Encoding);
var
  Buffer, Preamble: array of Byte;
begin
  if Encoding = nil then
    Encoding := System.Text.Encoding.Default;
  Buffer := Encoding.GetBytes(GetTextStr);
  Preamble := Encoding.GetPreamble;
  if Length(Preamble) > 0 then
    Stream.WriteBuffer(Preamble, Length(Preamble));
  Stream.WriteBuffer(Buffer, Length(Buffer));
end;

procedure TAnsiStrings.SetCapacity(NewCapacity: Integer);
begin
  // do nothing - descendants may optionally implement this method
end;

procedure TAnsiStrings.SetCommaText(const Value: AnsiString);
begin
  Delimiter := AnsiChar(',');
  QuoteChar := AnsiChar('"');
  SetDelimitedText(Value);
end;

function PosEx(const SubStr, S: AnsiString; Offset: Integer = 1): Integer;
begin
  if (Offset <= 0) or (S = nil) or (OffSet > Length(S)) then
    Result := 0
  else
  // CLR strings are zero relative
    Result := Pos(SubStr, Copy(S, Offset, Length(S)));
    if Result <> 0 then
      Inc(Result, Offset-1);
end;

//TODO: Review for possible optimization
procedure TAnsiStrings.SetTextStr(const Value: AnsiString);
var
  P, Start, L: Integer;
begin
  BeginUpdate;
  try
    Clear;

    Start := 1;
    L := Length(LineBreak);
    P := Pos(LineBreak, Value);
    while P > 0 do
    begin
      Add(Copy(Value, Start, P - Start));
      Start := P + L;
     P := PosEx(LineBreak, Value, Start);
    end;
    if Start <= Length(Value) then
      Add(Copy(Value, Start, Length(Value) - Start + 1));
  finally
    EndUpdate;
  end;
end;

procedure TAnsiStrings.SetUpdateState(Updating: Boolean);
begin
end;

procedure TAnsiStrings.SetValue(const Name, Value: AnsiString);
var
  I: Integer;
begin
  I := IndexOfName(Name);
  if Value <> '' then
  begin
    if I < 0 then
      I := Add('');
    Put(I, Name + NameValueSeparator + Value);
  end
  else
  begin
    if I >= 0 then
      Delete(I);
  end;
end;

procedure TAnsiStrings.WriteData(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 0 to Count - 1 do Writer.WriteString(Get(I));
  Writer.WriteListEnd;
end;

procedure TAnsiStrings.SetDelimitedText(const Value: AnsiString);
  function _AnsiDequotedStr(const S: AnsiString; AQuote: AnsiChar; var P: Integer): AnsiString;
  begin
    Result := DequotedStr(S, Char(AQuote), P);
    if Result = AnsiChar(' ') then
      Result := S;
  end;
var
  P, P1, L: Integer;
  S: AnsiString;
begin
  BeginUpdate;
  try
    Clear;
    P := 1;
    L := Length(Value);
    while (P <= L) and (Value[P] in [AnsiChar(#1)..AnsiChar(' ')]) do
      Inc(P);
    while P <= L do
    begin
      if Value[P] = QuoteChar then
        S := _AnsiDequotedStr(Value, QuoteChar, P)
      else
      begin
        P1 := P;
        while (P <= L) and (Value[P] > AnsiChar(' ')) and (Value[P] <> Delimiter) do
          Inc(P);
        S := Copy(Value, P1, P - P1);
      end;
      Add(S);
      while (P <= L) and (Value[P] in [AnsiChar(#1)..AnsiChar(' ')]) do
        Inc(P);
      if (P <= L) and (Value[P] = Delimiter) then
      begin
        P1 := P;
        Inc(P1);
        if P1 > L then
          Add('');
        repeat
          Inc(P);
        until (P > L) or (not (Value[P] in [AnsiChar(#1)..AnsiChar(' ')]));
      end;
    end;
  finally
    EndUpdate;
  end;
end;

function TAnsiStrings.GetDelimiter: AnsiChar;
begin
  if not (sdDelimiter in FDefined) then
    Delimiter := AnsiChar(',');
  Result := FDelimiter;
end;

function TAnsiStrings.GetLineBreak: AnsiString;
begin
  if not (sdLineBreak in FDefined) then
    LineBreak := sLineBreak;
  Result := FLineBreak;
end;

function TAnsiStrings.GetQuoteChar: AnsiChar;
begin
  if not (sdQuoteChar in FDefined) then
    QuoteChar := AnsiChar('"');
  Result := FQuoteChar;
end;

procedure TAnsiStrings.SetDelimiter(const Value: AnsiChar);
begin
  if (FDelimiter <> Value) or not (sdDelimiter in FDefined) then
  begin
    Include(FDefined, sdDelimiter);
    FDelimiter := Value;
  end
end;

procedure TAnsiStrings.SetLineBreak(const Value: AnsiString);
begin
  if (FLineBreak <> Value) or not (sdLineBreak in FDefined) then
  begin
    Include(FDefined, sdLineBreak);
    FLineBreak := Value;
  end
end;

procedure TAnsiStrings.SetQuoteChar(const Value: AnsiChar);
begin
  if (FQuoteChar <> Value) or not (sdQuoteChar in FDefined) then
  begin
    Include(FDefined, sdQuoteChar);
    FQuoteChar := Value;
  end
end;

function TAnsiStrings.CompareStrings(const S1, S2: AnsiString): Integer;
begin
  Result := CompareText(S1, S2);
end;

function TAnsiStrings.GetNameValueSeparator: AnsiChar;
begin
  if not (sdNameValueSeparator in FDefined) then
    NameValueSeparator := AnsiChar('=');
  Result := FNameValueSeparator;
end;

procedure TAnsiStrings.SetNameValueSeparator(const Value: AnsiChar);
begin
  if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
  begin
    Include(FDefined, sdNameValueSeparator);
    FNameValueSeparator := Value;
  end
end;

function TAnsiStrings.GetValueFromIndex(Index: Integer): AnsiString;
begin
  if Index >= 0 then
    Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt)
  else
    Result := '';
end;

procedure TAnsiStrings.SetValueFromIndex(Index: Integer; const Value: AnsiString);
begin
  if Value <> '' then
  begin
    if Index < 0 then
      Index := Add('');
    Put(Index, Names[Index] + NameValueSeparator + Value);
  end
  else
    if Index >= 0 then
      Delete(Index);
end;

{ TAnsiStringList }

function TAnsiStringList.Add(const S: AnsiString): Integer;
begin
  Result := AddObject(S, nil);
end;

function TAnsiStringList.AddObject(const S: AnsiString; AObject: TObject): Integer;
begin
  if not Sorted then
    Result := FCount
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(SDuplicateString, 0);
      end;
  InsertItem(Result, S, AObject);
end;

procedure TAnsiStringList.Changed;
begin
  if (FUpdateCount = 0) and Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TAnsiStringList.Changing;
begin
  if (FUpdateCount = 0) and Assigned(FOnChanging) then
    FOnChanging(Self);
end;

procedure TAnsiStringList.Clear;
begin
  if FCount <> 0 then
  begin
    Changing;
    FCount := 0;
    SetCapacity(0);
    Changed;
  end;
end;

procedure TAnsiStringList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FCount) then
    Error(SListIndexError, Index);
  Changing;
  Dec(FCount);
  if Index < FCount then
    System.Array.Copy(System.Array(FList), Index + 1, System.Array(FList),
      Index, FCount - Index);
  Changed;
end;

procedure TAnsiStringList.Exchange(Index1, Index2: Integer);
begin
  if (Index1 < 0) or (Index1 >= FCount) then
    Error(SListIndexError, Index1);
  if (Index2 < 0) or (Index2 >= FCount) then
    Error(SListIndexError, Index2);
  Changing;
  ExchangeItems(Index1, Index2);
  Changed;
end;

procedure TAnsiStringList.ExchangeItems(Index1, Index2: Integer);
var
  Temp: TAnsiStringItem;
begin
  Temp := FList[Index1];
  FList[Index1] := FList[Index2];
  FLIst[Index2] := Temp;
end;

function TAnsiStringList.Find(const S: AnsiString; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := CompareStrings(FList[I].FString, S);
    if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if Duplicates <> dupAccept then
          L := I;
      end;
    end;
  end;
  Index := L;
end;

function TAnsiStringList.Get(Index: Integer): AnsiString;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(SListIndexError, Index);
  Result := FList[Index].FString;
end;

function TAnsiStringList.GetCapacity: Integer;
begin
  Result := Length(FList);
end;

function TAnsiStringList.GetCount: Integer;
begin
  Result := FCount;
end;

function TAnsiStringList.GetObject(Index: Integer): TObject;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(SListIndexError, Index);
  Result := FList[Index].FObject;
end;

procedure TAnsiStringList.Grow;
var
  Delta: Integer;
  C: Integer;
begin
  C := Length(FList);
  if C > 64 then
    Delta := C div 4
  else if C > 8 then
    Delta := 16
  else
    Delta := 4;
  SetCapacity(C + Delta);
end;

function TAnsiStringList.IndexOf(const S: AnsiString): Integer;
begin
  if not Sorted then
    Result := inherited IndexOf(S)
  else if not Find(S, Result) then
    Result := -1;
end;

procedure TAnsiStringList.Insert(Index: Integer; const S: AnsiString);
begin
  InsertObject(Index, S, nil);
end;

procedure TAnsiStringList.InsertObject(Index: Integer; const S: AnsiString;
  AObject: TObject);
begin
  if Sorted then
    Error(SSortedListError, 0);
  if (Index < 0) or (Index > Count) then
    Error(SListIndexError, Index);
  InsertItem(Index, S, AObject);
end;

procedure TAnsiStringList.InsertItem(Index: Integer; const S: AnsiString; AObject: TObject);
begin
  Changing;
  if FCount = Length(FList) then
    Grow;
  if Index < FCount then
    System.Array.Copy(System.Array(FList), Index, System.Array(FList),
      Index + 1, FCount - Index);
  with FList[Index] do
  begin
    FObject := AObject;
    FString := S;
  end;
  Inc(FCount);
  Changed;
end;

procedure TAnsiStringList.Put(Index: Integer; const S: AnsiString);
begin
  if Sorted then
    Error(SSortedListError, 0);
  if (Index < 0) or (Index >= FCount) then
    Error(SListIndexError, Index);
  Changing;
  FList[Index].FString := S;
  Changed;
end;

procedure TAnsiStringList.PutObject(Index: Integer; AObject: TObject);
begin
  if (Index < 0) or (Index >= FCount) then
    Error(SListIndexError, Index);
  Changing;
  FList[Index].FObject := AObject;
  Changed;
end;

procedure TAnsiStringList.QuickSort(L, R: Integer; SCompare: TAnsiStringListSortCompare);
var
  I, J, P: Integer;
begin
  repeat
    I := L;
    J := R;
    P := (L + R) shr 1;
    repeat
      while SCompare(Self, I, P) < 0 do
        Inc(I);
      while SCompare(Self, J, P) > 0 do
        Dec(J);
      if I <= J then
      begin
        ExchangeItems(I, J);
        if P = I then
          P := J
        else if P = J then
          P := I;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TAnsiStringList.SetCapacity(NewCapacity: Integer);
begin
  SetLength(FList, NewCapacity);
end;

procedure TAnsiStringList.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then
  begin
    if Value then
      Sort;
    FSorted := Value;
  end;
end;

procedure TAnsiStringList.SetUpdateState(Updating: Boolean);
begin
  if Updating then
    Changing
  else
    Changed;
end;

function StringListCompareStrings(List: TAnsiStringList; Index1,
  Index2: Integer): Integer;
begin
  Result := List.CompareStrings(List.FList[Index1].FString,
    List.FList[Index2].FString);
end;

procedure TAnsiStringList.Sort;
begin
  CustomSort(StringListCompareStrings);
end;

procedure TAnsiStringList.CustomSort(Compare: TAnsiStringListSortCompare);
begin
  if not Sorted and (FCount > 1) then
  begin
    Changing;
    QuickSort(0, FCount - 1, Compare);
    Changed;
  end;
end;

function TAnsiStringList.CompareStrings(const S1, S2: AnsiString): Integer;
begin
  if CaseSensitive then
    Result := CompareStr(S1, S2)
  else
    Result := CompareText(S1, S2);
end;

procedure TAnsiStringList.SetCaseSensitive(const Value: Boolean);
begin
  if Value <> FCaseSensitive then
  begin
    FCaseSensitive := Value;
    if Sorted then
      Sort;
  end;
end;

end.