[~ 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;

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