执行线程后，为什么界面会像死掉一样

Question

主程序运行后，我点击一个按钮后执行一个线程或者定时启动一个线程，线程执行的时候整个界面都不能点了，为什么，谢谢！！

Answer 1

我执行的线程是自己继承TThread实现的一个类，调用后处理大量数据，界面就不能响应了

Answer 2

你是在Execute里执行这些操作？

Answer 3

是的大量操作都是在Execute里面

Answer 4

Execute里就这样调了一个方法，然后大量操作就在这个方法里执行了procedure TComplDriverRunInfo.Execute;
begin
  FreeOnTerminate := True;
  while not Terminated do
  begin
    Synchronize(ComplDRI);
    Terminate;
  end;
end;

Answer 5

用Synchronize调用的函数必须执行时间短，因为他就是在主线程里执行。

Answer 6

主要是ComplDRI太长了，改成多个小函数。

Answer 7

我ComplDRI的方法内容如下procedure TComplDriverRunInfo.ComplDRI;
var
  i: Integer;
  LineDev: TLineDevs;
  ATimeFrom, ATimeTo: TDateTime;
  TableNotExistsList: TStringList;
  QueryHisRetValue: Integer;
begin
  if FormatDateTime('yyyy-MM-dd', FStartTime) <> FormatDateTime('yyyy-MM-dd', Now) then
  begin
    Bs.QueryOldPlanRunTime(FormatDateTime('yyyy-MM-dd', FStartTime), FormatDateTime('yyyy-MM-dd', FStartTime));
  end;
  Bs.QueryLineDevs;  Bs.QueryLogInOrOff(FormatDateTime('yyyy-MM-dd hh:mm:ss', FStartTime - 1), FormatDateTime('yyyy-MM-dd hh:mm:ss', FEndTime));
  ATimeFrom := FStartTime;
  ATimeTo := FEndTime;
  DevIDList := TStringList.Create;
  DevIDList.Sorted := True;
  TableNotExistsList := TStringList.Create;
  TableNotExistsList.Sorted := True;  for i := 0 to LineDevsManage.Count - 1 do
  begin
    FXMGpsDataList.Clear;
    LineDev := LineDevsManage.Items[i];
    if TableNotExistsList.IndexOf(LineDev.DevID) = -1 then
    begin
      if DevIDList.IndexOf(LineDev.DevID) = -1 then
      begin
        if Bs.IsTableExists('GPSDATA' + Trim(LineDev.DevID)) > 0 then
        begin
          QueryHisDatas(LineDev.LineID, LineDev.DevID, ATimeFrom, ATimeTo);
        end
        else
        begin
          TableNotExistsList.Add(LineDev.DevID);
        end;
      end;
    end;
  end;
  TableNotExistsList.Free;
  DevIDList.Free;
  Frm_BusScheduing.tmr2.Enabled := True;
  Frm_BusScheduing.btnComplDRI.Enabled := True;
end;

Answer 8

Synchronize（）不用。这个得执行完才回到主进程。

Answer 9

这样用Synchronize就等于没用多线程。

Answer 10

也就是说得把Synchronize给去了就可以了，试试。。

Answer 11

这玩大了，我把synchronize给去了，方法里执行到查数据的时候直接报错，加上就正常

Answer 12

加了Application.processmessages有效的缓解了。。

Answer 13

对线程的理解严重有问题，你用Synchronize(ComplDRI);表示用主线程来执行，挂起新创建的线程，就是你这个线程白创建了。
另外出错把错误信息贴出来，利于找到问题根源，还有你线程的函数怎么procedure TComplDriverRunInfo.ComplDRI;
var
  i: Integer;
  LineDev: TLineDevs;
  ATimeFrom, ATimeTo: TDateTime;
  TableNotExistsList: TStringList;
  QueryHisRetValue: Integer;
begin
  if FormatDateTime('yyyy-MM-dd', FStartTime) <> FormatDateTime('yyyy-MM-dd', Now) then
  begin
    Bs.QueryOldPlanRunTime(FormatDateTime('yyyy-MM-dd', FStartTime), FormatDateTime('yyyy-MM-dd', FStartTime));
  end;
  Bs.QueryLineDevs;  Bs.QueryLogInOrOff(FormatDateTime('yyyy-MM-dd hh:mm:ss', FStartTime - 1), FormatDateTime('yyyy-MM-dd hh:mm:ss', FEndTime));
  ATimeFrom := FStartTime;
  ATimeTo := FEndTime;
  DevIDList := TStringList.Create;
  DevIDList.Sorted := True;
  TableNotExistsList := TStringList.Create;
  TableNotExistsList.Sorted := True;  for i := 0 to LineDevsManage.Count - 1 do
  begin
    FXMGpsDataList.Clear;
    LineDev := LineDevsManage.Items[i];
    if TableNotExistsList.IndexOf(LineDev.DevID) = -1 then
    begin
      if DevIDList.IndexOf(LineDev.DevID) = -1 then
      begin
        if Bs.IsTableExists('GPSDATA' + Trim(LineDev.DevID)) > 0 then
        begin
          QueryHisDatas(LineDev.LineID, LineDev.DevID, ATimeFrom, ATimeTo);
        end
        else
        begin
          TableNotExistsList.Add(LineDev.DevID);
        end;
      end;
    end;
  end;
  TableNotExistsList.Free;
  DevIDList.Free;
  Frm_BusScheduing.tmr2.Enabled := True;
  Frm_BusScheduing.btnComplDRI.Enabled := True;
end;这两句，用一个函数来实现，并用Synchronize来执行。  Frm_BusScheduing.tmr2.Enabled := True;
  Frm_BusScheduing.btnComplDRI.Enabled := True;Delphi里面的VCL是不支持多线程的。

Answer 14

  for i := 0 to LineDevsManage.Count - 1 do
  begin
    Application.ProcessMessages;    FXMGpsDataList.Clear;    //...
  end;
循环里用Application.ProcessMessages可缓解界面消息阻塞.

Answer 15

同意：
这样用Synchronize就等于没用多线程。

Answer 16

没有出错信息，只是主窗体在启动线程后不能响应了，线程还是正常的在后台执行的我主窗体中的按钮负责启动这个线程procedure TFrm_BusScheduing.btnComplDRIClick(Sender: TObject);
var
  StartTime, EndTime: TDateTime;
begin
  btnComplDRI.Enabled := False;
  try
    FrmSelectHisTime := TFrmSelectHisTime.Create(Self);//这个是我用来选择时间段的窗体
    try
      FrmSelectHisTime.ShowModal;
      if FrmSelectHisTime.ModalResult = mrOK then
      begin
        StartTime := FrmSelectHisTime.Start_Date.DateTime;
        ReplaceTime(StartTime, FrmSelectHisTime.Start_Time.Time);
        EndTime := FrmSelectHisTime.End_Date.DateTime;
        ReplaceTime(EndTime, FrmSelectHisTime.End_Time.Time);
        FComplDriverRunInfo := TComplDriverRunInfo.Create(False, StartTime, EndTime);//此处启动线程
      end
      else
        btnComplDRI.Enabled := True;
    except
      btnComplDRI.Enabled := True;
    end;
  finally
    FrmSelectHisTime.Free;
  end;
end;

Answer 17

加了那个application后，响应是能响应但是过段时间后，鼠标形状在漏斗状和指针状间不停的换，一变漏斗状就不能响应了

Answer 18

把原有的函数分成几个,ComplDRI不用Synchronize了。procedure TComplDriverRunInfo.ComplDRI;
//变量都定到TComplDriverRunInfo类中
begin
  Synchronize(aaa);
  for i := 0 to LineDevsManage.Count - 1 do
  begin
    Synchronize(bbb);
  end;
  Synchronize(ccc);
end;
procedure TComplDriverRunInfo.aaa;
begin
  if FormatDateTime('yyyy-MM-dd', FStartTime) <> FormatDateTime('yyyy-MM-dd', Now) then
  begin
    Bs.QueryOldPlanRunTime(FormatDateTime('yyyy-MM-dd', FStartTime), FormatDateTime('yyyy-MM-dd', FStartTime));
  end;
  Bs.QueryLineDevs;  Bs.QueryLogInOrOff(FormatDateTime('yyyy-MM-dd hh:mm:ss', FStartTime - 1), FormatDateTime('yyyy-MM-dd hh:mm:ss', FEndTime));
  ATimeFrom := FStartTime;
  ATimeTo := FEndTime;
  DevIDList := TStringList.Create;
  DevIDList.Sorted := True;
  TableNotExistsList := TStringList.Create;
  TableNotExistsList.Sorted := True;
end;
procedure TComplDriverRunInfo.bbb;
begin
    FXMGpsDataList.Clear;
    LineDev := LineDevsManage.Items[i];
    if TableNotExistsList.IndexOf(LineDev.DevID) = -1 then
    begin
      if DevIDList.IndexOf(LineDev.DevID) = -1 then
      begin
        if Bs.IsTableExists('GPSDATA' + Trim(LineDev.DevID)) > 0 then
        begin
          QueryHisDatas(LineDev.LineID, LineDev.DevID, ATimeFrom, ATimeTo);
        end
        else
        begin
          TableNotExistsList.Add(LineDev.DevID);
        end;
      end;
    end;
end;
procedure TComplDriverRunInfo.ccc;
begin
  TableNotExistsList.Free;
  DevIDList.Free;
  Frm_BusScheduing.tmr2.Enabled := True;
  Frm_BusScheduing.btnComplDRI.Enabled := True;
end;