如何處理大循環

Question

我想在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;

我如何使其更快：=）

Answer 1

速度下降大部分來自Delete 。 Delete重寫整個字符串。 最好將索引保存在哪里。

Answer 2

您永遠都無法使它很好地擴展到大量數據。 問題在於，試圖使字符串網格控件保存大量數據正在要求它執行原本不適合的操作。 這樣做會導致數據存儲效率極低。

相反，您真正需要的是虛擬數據范例。 與其讓控件存儲它顯示的數據，不如讓控件要求您按需提供數據。 當它需要知道顯示什么時，它會問您。 這省去了您必須預先加載信息的情況，而這些信息絕大部分都不會使用。

也許滿足您需求的理想控件將是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;

使用虛擬控制可以提高顯示方面的性能。 將數據加載到內存中仍然會遇到問題。 如果希望對大型文件進行操作，則需要避免將整個文件加載到內存中。 而是僅按需再次加載文件的一部分。

Answer 3

首先，我不知道這個字符串到底有多大。 但是，您的代碼中還有許多其他問題，導致它起初並沒有按照您說的去做（它只是將最后兩個字符放在第一個單元格中）。

這就是我相信您正在嘗試做的...

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答案中的信息）

Answer 4

正如@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;

Answer 5

如果可能的話，我會將stringgrid設置為invisible，因為它快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;時，您需要注意一些事項Application.ProcessMessages; ：

• UI對用戶輸入做出反應
• 用戶界面重新繪制
• 計時器被解雇
• ...

調用它是否“安全”取決於您的應用程序。 像這樣進入函數時，設置一個標志也許就足夠了：

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