[~ SaM ~]

Столкнулся я с задачей, когда времени на ее решение (программного) нет! Суть такова : Есть около 20-30 процедур, которые перебирают уйму информации. На все это уходит много времени, ибо данных много(очень много)!

Возможно ли выполнять несколько процедур одновременно???

[The Shadow]

Потоки не подходят?

[~ SaM ~]

Это пример процедур, которые долго работают. Пока их только 13 и все они имеют приблизительно одинаковую структуру.

Код:

Procedure FirstVed_add_2;
Var i,j:integer;
begin
j:=j-8;
for i:=1 to 15 do begin
j:=j+8;
Setrange(1,'Q'+inttostr(125-j),'');
Setrange(1,'Q'+inttostr(126-j),'');
Setrange(1,'W'+inttostr(125-j),'');
Setrange(1,'W'+inttostr(126-j),'');
Setrange(1,'W'+inttostr(121-j),'');
Setrange(1,'W'+inttostr(122-j),'');
Setrange(1,'X'+inttostr(121-j),'');
Setrange(1,'X'+inttostr(122-j),'');
SetBorderRange(1,'S'+inttostr(125-j)+':V'+inttostr(125-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'S'+inttostr(126-j)+':V'+inttostr(126-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(125-j)+':Y'+inttostr(125-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'S'+inttostr(126-j)+':Y'+inttostr(126-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(121-j)+':Y'+inttostr(121-j),xlEdgeTop,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(121-j)+':Y'+inttostr(121-j),xlEdgeLeft,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(121-j)+':Y'+inttostr(121-j),xlEdgeRight,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(122-j)+':Y'+inttostr(122-j),xlEdgeLeft,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(122-j)+':Y'+inttostr(122-j),xlEdgeRight,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(123-j)+':Y'+inttostr(123-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(123-j)+':Y'+inttostr(123-j),xlEdgeLeft,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'X'+inttostr(123-j)+':Y'+inttostr(123-j),xlEdgeRight,xlDashDot,xlThin,0,rgb(255,255,255));
end;

j:=-8;
for i:=1 to 15 do begin
j:=j+8;
Setrange(1,'F'+inttostr(125-j),'');
Setrange(1,'F'+inttostr(126-j),'');
Setrange(1,'L'+inttostr(125-j),'');
Setrange(1,'L'+inttostr(126-j),'');
Setrange(1,'M'+inttostr(121-j),'');
Setrange(1,'M'+inttostr(122-j),'');
SetBorderRange(1,'H'+inttostr(125-j)+':K'+inttostr(125-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'H'+inttostr(126-j)+':K'+inttostr(126-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(125-j)+':N'+inttostr(125-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(126-j)+':N'+inttostr(126-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(121-j)+':N'+inttostr(121-j),xlEdgeTop,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(121-j)+':N'+inttostr(121-j),xlEdgeLeft,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(121-j)+':N'+inttostr(121-j),xlEdgeRight,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(122-j)+':N'+inttostr(122-j),xlEdgeLeft,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(122-j)+':N'+inttostr(122-j),xlEdgeRight,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(123-j)+':N'+inttostr(123-j),xlEdgeBottom,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(123-j)+':N'+inttostr(123-j),xlEdgeLeft,xlDashDot,xlThin,0,rgb(255,255,255));
SetBorderRange(1,'M'+inttostr(123-j)+':N'+inttostr(123-j),xlEdgeRight,xlDashDot,xlThin,0,rgb(255,255,255));
end;
end;

Вот процедура, которая через потоки вызывает необходимые процедуры:

Код:

Procedure FirstVed;
Var i,j:integer;
    h1:cardinal;
begin
if strtoint(vidor_vdm_form.label11.Caption)Ю0 then begin
CreateThread(nil,0,@FirstVed_add_1,nil,0,h1) ;
..................
CreateThread(nil,0,@FirstVed_add_13,nil,0,h1) ;
end;
end;

И процедура, которая все это вызывает:

Код:

if not CreateExcel then exit;
j:=0;
jj:=0;
OpenWorkBook(getcurrentdir+'\ADP_VED\template_1.xls');
for i:=1 to vidor_vdm_form.listbox1.Items.Count-1 do begin
if i mod 2=1 then begin
j:=j+8;
SetRange(1,'G'+inttostr(j),vidor_vdm_form.listbox1.Items.Strings[i]);
SetRange(1,'G'+inttostr(j+1),vidor_vdm_form.listbox2.Items.Strings[i]);
end;
if i mod 2=0 then begin
jj:=jj+8;
SetRange(1,'R'+inttostr(jj),vidor_vdm_form.listbox1.Items.Strings[i]);
SetRange(1,'R'+inttostr(jj+1),vidor_vdm_form.listbox2.Items.Strings[i]);
end;
end; 

FirstVed; //процедура, работающая с потоками

VisibleExcel(true);
PrintPreviewEx;
SaveWorkBookAs(getcurrentdir+'\VDM\'+datetostr(date)+'.vdm');
CloseWorkBook;
CloseExcel;

Результат работы выполнения во вложении:

[~ SaM ~]

При пошаговом выполнении программы, ошибка вылетает на

Код:

CreateThread(nil,0,@FirstVed_add_1,nil,0,h1) ;

P.S. Может я неправильно сделал/оформил/написал сами потоки??? Да, и при использовании процедур в процедуре FirstVed без потоков, то все работает без проблем, но очень долго.

Надеюсь на помощь!

Заранее спасибо!

[ART]

Создание потоков не увеличит скорость выполнения процедур и функций. Надо оптимизировать.

[~ SaM ~]

to ART

Да, я с тобой согласен, что процедура/функция не будет работать быстрее из-за того, что она будет выполняться в отдельном протоке! Но!!! Вопрос ведь заключается в другом... У меня таких процедур(практически с одинаковой структурой) пока только 13, а в конечном итоге должно быть от 20 до 30. И ведь если все эти процедуры будут выполняться через COM в многопоточности(Multithreaded(MTA)), то это существенно увеличит время выполнения.

Ломал я голову, лазил по инэту и нашел интересную статейку, в которой расказывается про однопоточность и многопоточность... В ней рассказывается, что при работе с COM (с потоками) необходимо инициализировать отдельный поток, т.к. COM по умолчанию(да и Delphi нас снабжает модулем ComObj.pas, который позволяет работать только в однопоточном режиме...) работает только с одним потоком информации(грубо говоря очередь выстраивается )...

Теперь если посмотреть дальше, то не трудно понять что дополнительные потоки необходимо инициализировать при помощи такого кода:

Код:

CoInitializeEx (NIL, COINIT_MULTITHREADED); //создаем дополнительный поток
//выполнение созданного потока
CoUninitialize; //Даем понять COM'у , что этот поток выполнил все что от него требуется и его можно отключать, для последующего(если требуется) повторного запуска.

Для использования CoInitializeEx и CoUninitialize необходимо подключать модуль ActiveX.

Что из этого происходит:

Инициализвация(создание) новго потока проходит без вопросов, первы поток начинает выполнение, и после того, как инициализируется втрой - COM отключается от программы и пишет "не инициализирован CoInitializeEx"

Так вот НАДЕЮСЬ, что загвоздка осталась именно в инициализации потока для MTA.

Написал код для STA. Вот что получилось:

Код:

  TSTAAutoObjectFactory = class(TAutoObjectFactory,     IClassFactory)
    function CreateInstance;
  end;

  TSTAThread = class (TThread)
    procedure Execute; override;
  end;

//
function TSTAAutoObjectFactory.CreateInstance;
begin
  Создает TSTAThread, заставляет поток STA создать затребованный объект,и ждет, пока поток STA успешно создаст объект, после чего возвращает созданный экземпляр в качестве результата этого метода
end;

Выполнение:

Код:

procedure TSTAThread.Execute;
begin
  // Вход в STA
  CoInitializeEx (NIL, COINIT_APARTMENTTHREADED);
//  Создает экземпляр, затребованный TSTAAutoObjectFactory;
//  Сигнализирует потоку TSTAAutoObjectFactory.CreateInstance, что 
//  экземпляр теперь доступен
//  Вход в цикл сообщений STA
  CoUninitialize; //  Выход из STA
end;

Работает без вопросов! Все отлично! Но это STA(однопоточность)...

Стоит сделать многопоточность - сразу вылетает ошибка, что потоки не инициализированы!

Подскажите, что я не правильно делаю!!!???