multithreadingdelphitthread

Threaded Excel File Processing in Delphi


I created a TThread to handle some critical issues in an Excel file, however, I'm currently experiencing some challenges as the thread doesn't seem to be working in parallel with my application. Despite my best efforts to identify the root cause of the issue, I have been unsuccessful thus far. In an attempt to resolve the problem, I have experimented with defining a TThread Type with an overridden Execute method and also attempted to switch from Synchronize to Queue methods, but neither approach has yielded positive results so far.

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;

My question is how to make my Proc procedure works in parallel with my app .


Solution

  • You can't use the Excel COM object across thread boundaries. Your whole thread design is wrong. You need to create the COM object in the worker thread, not in the main thread. Then sync with the main thread only to get the filename (or ask for it before starting the thread), and then load and process the file entirely in the worker thread, not in the main thread. Sync with the main thread only when accessing the UI as needed.

    In other words, all of your COM object processing should be only in the worker thread, not in the main thread. You are syncing way too much work, defeating the whole point of using a thread.

    Try something more like this:

    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;