Delphi 中的线程 Excel 文件处理

问题描述 投票:0回答:1

我创建了一个 TThread 来处理 Excel 文件中的一些关键问题,但是,我目前遇到了一些挑战,因为该线程似乎无法与我的应用程序并行工作。尽管我尽了最大努力找出问题的根本原因,但到目前为止我一直没有成功。为了解决这个问题,我尝试用重写的 Execute 方法定义 TThread 类型,并尝试从 Synchronize 方法切换到 Queue 方法,但到目前为止,这两种方法都没有产生积极的结果。

procedure TForm2.Button1Click(Sender: TObject);
begin

 TThread.CreateAnonymousThread(proc).Start;

end;

procedure TForm2.Proc;
var
refSheet: Integer;
  RowCount,varGridRow:Integer;
  i, j,k: Integer;
  desc, refDesc, refRate: string;
  delta: Integer;
  OldValue:String;
  ws: Variant;
  ExcelApp: Variant;
begin
Tthread.Synchronize(nil,procedure ()begin
if OpenDialog1.Execute then
 begin
 ExcelApp := CreateOleObject('Excel.Application');
 ExcelApp.Workbooks.Open(OpenDialog1.FileName);
 end;
 end);

 Tthread.Synchronize(nil,procedure ()  begin
  refSheet :=StrToInt(InputBox('','','3'));
  if (refSheet <= 0) or (refSheet > ExcelApp.Worksheets.Count) then
  begin
    ShowMessage('Invalid sheet number');
    Exit;
  end;
 end);

 Tthread.Queue(nil,procedure ()var i,j,k:Integer; begin
 IssamProgressBar1.Max:= ExcelApp.Worksheets[refSheet].UsedRange.Rows.Count;
  RowCount:=1;
  varGridRow := 1;
  for i := 2 to ExcelApp.Worksheets[refSheet].UsedRange.Rows.Count do
   begin
    IssamProgressBar1.Progress:=i-2;
    IssamProgressBar1.Refresh;
    if (not VarIsEmpty(ExcelApp.Worksheets[refSheet].Cells[i, 2].Value))and (not VarIsEmpty(ExcelApp.Worksheets[refSheet].Cells[i, 1].Value)) then
    begin
      refDesc := ExcelApp.Worksheets[refSheet].Cells[i, 2].Text;
      refRate := ExcelApp.Worksheets[refSheet].Cells[i, 5].Text;
      Label3.Caption:=refDesc;
      Label3.Refresh;
      // Loop through other sheets

      for j := 1 to ExcelApp.ActiveWorkbook.Sheets.Count do
      begin
       ws := ExcelApp.ActiveWorkbook.Sheets[j];
        if ws.Index <> refSheet then
        begin
          // Loop through rows in current sheet
          Label1.Caption:='Checking Sheet : '+ExcelApp.Worksheets[j].name;
          Label1.Refresh;
          for k := 2 to ws.UsedRange.Rows.Count do
          begin
            // Check if description matches approximately
            desc := ws.Cells[k, 2].Value;


            if (not VarIsEmpty(desc)) and (Not VarIsEmpty(ws.Cells[k, 1].Value)) then
            begin
              Label5.Caption:=desc;
              Label5.Refresh;
              if (refDesc = desc) and (refDesc <> 'Set of spare parts;') and (refDesc <> 'Set of tools and instruments;') then
              begin
                // Update rate
                if (ws.Cells[k, 5].Value <> refRate) and VarIsNumeric(ws.Cells[k, 5].Value) then
                begin

                  ws.Cells[k, 7].Value := ws.Cells[k, 5].Value;
                  OldValue:=ws.Cells[k, 5].Value;
                  ws.Cells[k, 5].Value := refRate;
                  delta := delta + 1;
                  ws.Cells[k, 5].Font.Color := RGB(255, 0, 0);
                  with StringGrid1 do
                  begin
                  RowCount := RowCount + 1;
                  Cells[0, varGridRow] := IntToStr(varGridRow);
                  Cells[1, varGridRow] := refDesc;
                  Cells[2, varGridRow] := OldValue;
                  Cells[3, varGridRow] := refRate;
                  Cells[4, varGridRow] := ExcelApp.Worksheets[j].Name;
                  Cells[5, varGridRow] := IntToStr(j);
                  Inc(varGridRow);
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
 end;
 end);

IssamProgressBar1.Progress:=0;
Label1.Caption:='';
Label3.Caption:='';
Label5.Caption:='';
ExcelApp.ActiveWorkbook.Close(False);
ExcelApp.Quit;


end;

我的问题是如何让我的 Proc 程序与我的应用程序并行工作。

multithreading delphi tthread
1个回答
0
投票

不能跨线程边界使用 Excel COM 对象。你的整个线程设计是错误的。您需要在辅助线程中创建 COM 对象,而不是在主线程中。然后仅与主线程同步以获取文件名(或在启动线程之前询问它),然后完全在工作线程中加载和处理文件,而不是在主线程中。仅在需要访问 UI 时才与主线程同步。

换句话说,你所有的COM对象处理都应该只在工作线程中进行,而不是在主线程中进行。你正在同步太多的工作,破坏了使用线程的全部意义。

尝试更像这样的东西:

procedure TForm2.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    ProcessFileInThread(OpenDialog1.FileName);
end;

procedure TForm2.ProcessFileInThread(const AFileName: string);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      InitThreadProc(AFileName);
    end
  ).Start;
end;

procedure TForm2.InitThreadProc(const AFileName: string);
begin
  CoInitialize(nil);
  try
    ProcessFile(AFileName);
  finally
    CoUninitialize;
  end;
end;

procedure TForm2.ProcessFile(const AFileName: string);
var
  refSheet, sheetCount, usedRowCount, RowCount: Integer;
  i, j, k: Integer;
  desc, refDesc, refRate, oldValue: string;
  ExcelApp, refWorksheet, curWorksheet, tmpValue: Variant;
begin
  ExcelApp := CreateOleObject('Excel.Application');
  try
    ExcelApp.Workbooks.Open(AFileName);
    try
      sheetCount := ExcelApp.Worksheets.Count;

      TThread.Synchronize(nil,
        procedure
        begin
          refSheet := StrToIntDef(InputBox('','','3'), -1);
          if (refSheet <= 0) or (refSheet > sheetCount) then
          begin
            ShowMessage('Invalid sheet number');
            Abort;
          end;
        end
      );

      refWorksheet := ExcelApp.Worksheets[refSheet];
      usedRowCount := refWorksheet.UsedRange.Rows.Count;

      ClearGrid;
      UpdateProgress(0, usedRowCount);

      for i := 2 to usedRowCount do
      begin
        UpdateProgress(i-2);

        if VarIsEmpty(refWorksheet.Cells[i, 2].Value) or VarIsEmpty(refWorksheet.Cells[i, 1].Value) then
          Continue;

        refDesc := refWorksheet.Cells[i, 2].Text;
        refRate := refWorksheet.Cells[i, 5].Text;

        UpdateLabel(Label3, refDesc);

        // Loop through other sheets
        for j := 1 to ExcelApp.ActiveWorkbook.Sheets.Count do
        begin
          curWorksheet := ExcelApp.ActiveWorkbook.Sheets[j];
          if curWorksheet.Index = refSheet then
            Continue;

          UpdateLabel(Label1, 'Checking Sheet : ' + curWorksheet.name);

          // Loop through rows in current sheet
          for k := 2 to curWorksheet.UsedRange.Rows.Count do
          begin
            // Check if description matches approximately
            tmpValue := curWorksheet.Cells[k, 2].Value;
            if VarIsEmpty(tmpValue) or VarIsEmpty(curWorksheet.Cells[k, 1].Value) then
              Continue;

            desc := VarToStr(tmpValue);
            UpdateLabel(Label5, desc);

            if (refDesc <> desc) or
               (refDesc = 'Set of spare parts;') or
               (refDesc = 'Set of tools and instruments;') or
               (curWorksheet.Cells[k, 5].Value = refRate) or
               (not VarIsNumeric(curWorksheet.Cells[k, 5].Value)) then
              Continue;

            // Update rate
            curWorksheet.Cells[k, 7].Value := curWorksheet.Cells[k, 5].Value;
            oldValue := curWorksheet.Cells[k, 5].Value;
            curWorksheet.Cells[k, 5].Value := refRate;
            curWorksheet.Cells[k, 5].Font.Color := RGB(255, 0, 0);
            AddToGrid(refDesc, oldValue, refRate, curWorksheet.Name, j);
          end;
        end;
      end;

      ClearStatus;
    finally
       ExcelApp.ActiveWorkbook.Close(False);
    end;
  finally
    ExcelApp.Quit;
  end;
end;

procedure TForm2.UpdateProgress(AValue: Integer; AMax: Integer = -1);
begin
  TThread.Queue(nil,
    procedure
    begin
      if AMax > -1 then IssamProgressBar1.Max := AValue;
      IssamProgressBar1.Progress := AValue;
    end
  );
end;

procedure TForm2.UpdateLabel(ALabel: TLabel; const AText: string);
begin
  TThread.Queue(nil,
    procedure
    begin
      ALabel.Caption := AText;
    end
  );
end;

procedure TForm1.AddToGrid(
  const ADesc, AOldValue, ARate, ASheetName: string;
  ASheetIndex: Integer);
var
  Row: Integer;
begin
  TThread.Queue(nil,
    procedure
    begin
      Row := StringGrid1.RowCount;
      StringGrid1.RowCount := Row + 1;
      StringGrid1.Cells[0, Row] := IntToStr(Row);
      StringGrid1.Cells[1, Row] := ADesc;
      StringGrid1.Cells[2, Row] := AOldValue;
      StringGrid1.Cells[3, Row] := ARate;
      StringGrid1.Cells[4, Row] := ASheetName;
      StringGrid1.Cells[5, Row] := IntToStr(ASheetIndex);
    end
  );
end;

procedure TForm2.ClearGrid;
begin
  TThread.Queue(nil,
    procedure
    var
      i: Integer;
    begin
      StringGrid1.RowCount := 1;
      for i := 0 to StringGrid1.ColCount-1 do
        StringGrid1.Cells[i, 0] = '';
    end;
  );
end;

procedure TForm2.ClearStatus;
begin
  TThread.Queue(nil,
    procedure
    begin
      IssamProgressBar1.Progress := 0;
      Label1.Caption := '';
      Label3.Caption := '';
      Label5.Caption := '';
    end
  );
end;
© www.soinside.com 2019 - 2024. All rights reserved.