List out of bounds (0)

[Alex Cones]

То есть нельзя добавлять что-либо к несуществующей строке???
С-П-А-С-И-Б-О!!!! Работает))

[Stilet]

То есть нельзя добавлять что-либо к несуществующей строке???

Естесственно!!!
Ты же не можешь сьесть арбуз которого у тя нет?
Ну разве что мысленно

[BOBAH13]

Сообщение от Alex Cones

Не пашет, та же самая ошибка, буду записывать построчно, через AssignFile

Видимо это будет продолжать еще очень долго

function Packing(Bit: TBitmap; Path: String): Boolean;
var
  f: TextFile;
  y, x, n: Integer;
  fc, cc: TColor;
  s, sr, sg, sb: String;
begin
  Result := False;
  if (Bit.Width = 0) or (Bit.Height = 0) then
    Exit;

  {$I-}
  AssignFile(f, Path);
  ReWrite(f);

  n := 0;
  cc := Bit.Canvas.Pixels[0, 0];

  for y := 0 to Bit.Height - 1 do
  begin
    for x := 0 to Bit.Width - 1 do
    begin
      fc := Bit.Canvas.Pixels[x, y];

      if (fc = cc) then
      begin
        inc(n);
      end else
      begin
        s := IntToHex(cc, 6);
        sr := Copy(s, 5, 2);
        sg := Copy(s, 3, 2);
        sb := Copy(s, 1, 2);
        Write(f,
          Chr(N+32)+ {N - количество}
          Chr(Round(StrToInt('$'+SB)/4+32))+  {B - канал}
          Chr(Round(StrToInt('$'+SG)/4+32))+  {G - канал}
          Chr(Round(StrToInt('$'+SR)/4+32)));  {R - канал}
        n := 1;
        cc := fc;
      end;
    end;
  end;

  CloseFile(f);
  {$I+}

  Result := True;
end;

[Alex Cones]

Немного изменил код,

Procedure Packing(Bit:TBitMap; Path:String);
 Var
  CC,FC:TColor;
  X,Y,N:Integer;
  List:TStringList;
  SR,SG,SB,SColor:String;
 Begin
  List:=TStringList.Create;
  N:=1;
  CC:=Bit.Canvas.Pixels[0,0];
  For Y:=0 to Bit.Height-1 do
   Begin
    List.add('');
    For X:=0 to Bit.Width do
     Begin
      FC:=Bit.Canvas.Pixels[X,Y];
      If FC = CC Then
       Begin
        Inc(N);
       End
      Else
       Begin
        SColor:=IntToHex(CC,6);
        SR:=Copy(SColor,5,2);
        SG:=Copy(SColor,3,2);
        SB:=Copy(SColor,1,2);
        List.Strings[list.count-1]:=List.Strings[list.count-1]+
         Chr(N+32)+                          {N - количество}
         Chr(Round(StrToInt('$'+SB)/4+32))+  {B - канал}
         Chr(Round(StrToInt('$'+SG)/4+32))+  {G - канал}
         Chr(Round(StrToInt('$'+SR)/4+32));  {R - канал}
         N:=1;
         CC:=FC;
       End;
     End;
    CC:=Bit.Canvas.Pixels[0,Y];
   End;
  List.SaveToFile(Path);
  List.Free;
 End;

Все прекрасно и замечательно работает, так, как надо. Но во все файлы в конце записывается лишний #13. Где-то на форуме я читал, что так всегда, когда записывается в файл Стринглист. Но теперь даже не знаю на какое слово пропечатать поиск. Может подскажете, как убрать его?

[BOBAH13]

Флуд А чем решение в посте #13 не устраивает ?

p.s.

Все прекрасно и замечательно работает

а вот это уж я даже удивлен т.к.

For X:=0 to Bit.Width do

[Stilet]

а вот это уж я даже удивлен т.к.

Почему еси не секрет?

[Alex Cones]

А чем решение в посте #13 не устраивает

У меня 79 файлов, в каждом - по 100 строк. TStringList делает это за 4 секунды (все) а построчно около 2-х минут. Разница есть. Попробовал на пустом файле - все равно записывается лишний #13 в конце. Я могу не обращать на него внимания, но тогда придется ставить ограничение на количество строк, к тому же он мешает вести мне точный подсчет.

[Stilet]

к тому же он мешает вести мне точный подсчет.

Что мешает удалять последнюю строку если она пуста?

if list[list.count-1]='' then list.delete(list.count-1);

[Alex Cones]

If List.Strings[List.Count-1] = '' Then
   Begin
    Windows.Beep(600,600);
    List.Delete(List.Count-1);
   End;

Она даже ни разу не просигналила. Думаю здесь имеет место не содержание, а то, что по-другому она не записывает. Ведь пустой стринглист тоже записывает один #13. Наверное придется потом проходиться по всем файлам и удалять последнюю строку (#13).

[Stilet]

Думаю здесь имеет место не содержание, а то, что по-другому она не записывает

Ошибаешся. Именно содержимое. Просто нужно посмотреть как ты туда пихаешь и пошагово пройтись.