如何处理大循环

时间:2014-11-06 22:08:49

标签: delphi loops large-files tstringgrid

我想在TStringGrid中放一个大字符串,其中每个单元格都包含4个字符串   StringGrid有16列

nc:=1; nr:=1;     //nc = number of column . nr = number of raw
while fs.Length>0  do   // fs is a large string 
 begin
    if nc>16 then nr:=nr+1; nc:=1; 
 stringgrid.Cells[nc,nr]:=copy(fs,1,4);    
 delete(fs,1,4);
 nc:=nc+1;

PeekMessage(M, Handle, 0, 0, PM_NOREMOVE); // it prevents "not responding"
end;

如何让它更快:=)

5 个答案:

答案 0 :(得分:5)

减速大部分来自Delete。删除重写整个字符串。最好保存索引从哪里复制。

答案 1 :(得分:4)

你永远不会让这个能够很好地扩展到大量数据。问题是尝试获取字符串网格控件以容纳大量数据是要求它做一些不是为它设计的东西。这样做会导致数据存储效率极低。

相反,您真正需要的是虚拟数据范例。控制器不是让控件存储它显示的数据,而是让您按需查询数据。当它需要知道要显示什么时它会问你。这样可以节省您必须提前加载的信息,其中大部分信息从未使用过。

对于您的需求而言,理想的控制可能是Mike Lischke着名的虚拟树视图。作为这种范式的力量的简单演示,这是一个使用TListView的简单示例。

一些初步声明:

const
  ColCount = 16;
  CharactersPerCell = 4;
  LoremIpsum = 'Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod '+
    'tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, '+
    'quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. '+
    'Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu '+
    'fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in '+
    'culpa qui officia deserunt mollit anim id est laborum. ';

设置控件的属性,并创建一个大字符串:

var
  Data: string;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  while Length(Data)<20*1000*1000 do begin // 20 million characters
    Data := Data + LoremIpsum;
  end;

  ListView1.ViewStyle := vsReport;
  ListView1.OwnerData := True;
  ListView1.OnData := ListViewData;
  ListView1.Items.Count := 1 + (Length(Data)-1) div (ColCount*CharactersPerCell);

  ListView1.Columns.Clear;
  for i := 0 to ColCount-1 do begin
    ListView1.Columns.Add.Caption := IntToStr(i+1);
  end;
end;

您可以从文件中加载文本,而不是使用充满废话的全局变量。

按需获取数据的代码:

procedure TForm1.ListViewData(Sender: TObject; Item: TListItem);
var
  Row: string;
  ColIndex: Integer;
begin
  Row := Copy(Data, 1 + Item.Index*ColCount*CharactersPerCell, ColCount*CharactersPerCell);
  Item.Caption := Copy(Row, 1, CharactersPerCell);
  for ColIndex := 1 to ColCount-1 do begin
    Item.SubItems.Add(Copy(Row, 1 + CharactersPerCell*ColIndex, CharactersPerCell));
  end;
end;

使用虚拟控制可在显示方面提供性能。将数据加载到内存中仍然存在问题。如果您希望能够操作大文件,则需要避免将整个文件加载到内存中。而是再次按需加载文件的一部分。

答案 2 :(得分:2)

首先,我不知道这个字符串究竟有多大。但是,您的代码中还有许多其他问题导致它首先没有执行您所说的内容(它只是将最后两个字符放在第一个单元格中)。

这就是我相信你要做的......

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i, nc, nr, sp, len: Integer;
  fs: String;
begin
  StringGrid.RowCount:= 2;
  StringGrid.ColCount:= 16;
  for i := 1 to 1000 do
    fs:= fs + 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz';
  nc:= 1;
  nr:= 1;
  sp:= 1;
  len:= Length(fs);
  while sp < len  do begin
    if nc >= 16 then begin
      Inc(nr);
      nc:= 1;
      StringGrid.RowCount:= StringGrid.RowCount + 1;
    end;
    StringGrid.Cells[nc,nr]:= Copy(fs, sp, 4);
    Inc(sp, 4);
    Inc(nc);
  end;
end;

其他几点说明......

我排除了PeekMessage行,因为我不知道你从哪里获得M。但这会增加您遇到的性能问题。这迫使UI更新并重新绘制您将放置文本的每个单元格。

行计数也应预先计算并在循环开始之前设置。就个人而言,我的数学不够新鲜,无法将其添加到我的答案中。

(使用NGLN答案的信息从我原来的答案代码修改,该答案在我的后几秒发布)

答案 3 :(得分:1)

由于@NGLN已经解释了最容易让它变得更快的问题,我将展示一个替代方案,它也可以避免Delete并自动调整为任何长度的字符串输入。

以下是我将如何操作,根据输入数据的长度计算所需的行数。请注意,我已经包含了一些设置代码来分配用于测试的字符串(我已经注释了这样的代码),显然不需要在您的应用程序中使用。这样可以正确处理未均匀划分为64字节行的字符串,以便在网格中显示。

procedure TForm4.FormCreate(Sender: TObject);
var
  NumRows, CurrRow, CurrCol: Integer;
  Len: Integer;
  StrToParse: string;
  i: Integer;
const
  SplitCount = 16 * 4;  // Number of columns * chars per column
const
  Letters = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
begin
  // Setup code. Only for demonstration purposes.
  // Grid columns, remove fixed column. Leaves column headers
  StringGrid1.ColCount := 16;
  StringGrid1.FixedCols := 0;
  StrToParse := Letters;
  StringGrid1.ColCount := 16;
  // Allocates 1088 character string for testing
  while StrToParse.Length < 1000 do
    StrToParse := StrToParse + Letters;

  Len := StrToParse.Length;
  NumRows := Len div SplitCount;
  // If it's not evenly divisible, add an extra row for the spillover
  if Len mod SplitCount <> 0 then
    Inc(NumRows);
  {
    Calculate the number of rows we need, allowing
    1 for the fixed header row
  }
  StringGrid1.RowCount := NumRows + 1;
  // Index into string's characters
  i := 1;
  for CurrRow := 1 to NumRows do // Skipping fixed row headers
    for CurrCol := 0 to 15 do
      if i < Len then
      begin
        StringGrid1.Cells[CurrCol, CurrRow] := Copy(StrToParse, i, 4);
        Inc(i, 4);
      end;
end;

答案 4 :(得分:0)

如果可能的话,我会将stringgrid设置为不可见,因为它的速度提高了10倍以上:

procedure TForm1.Button1Click(Sender: TObject);
(** SLOW VERSION **)
const ABC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
var s:string;
    i,l,r,c:Integer;
    dt:TDateTime;
begin
  s := '';
  for i := 0 to 10000 do begin
    s := s + ABC;
  end;
  l := s.Length;

  StringGrid1.RowCount := 1;
  StringGrid1.ColCount := 16;

  dt := Now;
  i := 1;
  r := 0;
  c := 0;
  while i < l do begin
    StringGrid1.Cells[c,r] := Copy(s,i,4);
    Inc(i,4);
    c := (c+1) mod 17;
    if c=0 then begin
      StringGrid1.RowCount := StringGrid1.RowCount + 1;
      Inc(r);
    end;
  end;
  ShowMessage(Format('Adding strings took %d msec',[MilliSecondsBetween(dt,Now)]));  // ~ 7000 msec
end;

procedure TForm1.Button2Click(Sender: TObject);
(** FASTER VERSION **)
const ABC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
var s:string;
    i,l,r,c:Integer;
    dt:TDateTime;
begin
  s := '';
  for i := 0 to 10000 do begin
    s := s + ABC;
  end;
  l := s.Length;

  StringGrid1.RowCount := 1;
  StringGrid1.ColCount := 16;

  dt := Now;
  i := 1;
  r := 0;
  c := 0;
  StringGrid1.Visible := false;
  while i < l do begin
    StringGrid1.Cells[c,r] := Copy(s,i,4);
    Inc(i,4);
    c := (c+1) mod 17;
    if c=0 then begin
      StringGrid1.RowCount := StringGrid1.RowCount + 1;
      Inc(r);
    end;
  end;
  StringGrid1.Visible := true;
  ShowMessage(Format('Adding strings took %d msec',[MilliSecondsBetween(dt,Now)])); // ~ 700 msec
end;

如果您希望应用响应,可以在循环中添加Application.ProcessMessages;

  while i < l do begin
    StringGrid1.Cells[c,r] := Copy(s,i,4);
    Inc(i,4);
    c := (c+1) mod 17;
    if c=0 then begin
      Application.ProcessMessages;
      StringGrid1.RowCount := StringGrid1.RowCount + 1;
      Inc(r);
    end;
  end;

使用Application.ProcessMessages;时,您需要注意一些事项:

  • UI正在响应用户输入
  • UI重绘
  • 计时器被解雇
  • ...
如果调用它是“安全的”,它取决于您的应用程序。也许在输入你的函数时设置一个标志就足够了:

procedure DoSomething;
begin
  if not InDoSomething then begin
    InDoSomething := true;
    while blub do begin
      // ...
      Application.ProcessMessages;
    end;
    InDoSomething := false;
  end;
end;