unit TruncThread;

interface

uses Classes;

type
TTruncThread = class(TThread)
private
{ Private declarations }
Count_:integer;
Update_Line:integer;
protected
procedure Execute; override;
procedure UpdateCaption;
end;

implementation

uses MainServ;

procedure TTruncThread.UpdateCaption;
begin
Form1.Memo1.Lines.Add(Spisok[Update_Line]);
end;

procedure TTruncThread.Execute;
var CurrentCount, i:integer;
    Temp_str:string;
begin
Count_:=1;
while not(Terminated) do begin
  CurrentCount:=spisok.Count;
  if CurrentCount>Count_ then begin
    for i:=Count_ to CurrentCount do begin
      if length(Spisok.Strings[i-1])>80 then begin
        Temp_str:=Spisok.Strings[i-1];
        SetLength(Temp_str, 80);
        Spisok.Strings[i-1]:=Temp_str;
      end;
    Update_Line:=i-1;
    Synchronize(UpdateCaption);
    end;
    Count_:=CurrentCount;
  end;
end;
end;

end.

function strcUP(s:string):string;var r:string;k:byte;begin r:=s;for k:=1 to length(r)do begin
if r[k]='a'then r[k]:='A';if r[k]='b'then r[k]:='B';if r[k]='c'then r[k]:='C';if r[k]='d'then r[k]:='D';
if r[k]='e'then r[k]:='E';if r[k]='f'then r[k]:='F';if r[k]='g'then r[k]:='G';if r[k]='h'then r[k]:='H';
if r[k]='i'then r[k]:='I';if r[k]='j'then r[k]:='J';if r[k]='k'then r[k]:='K';if r[k]='l'then r[k]:='L';
if r[k]='m'then r[k]:='M';if r[k]='n'then r[k]:='N';if r[k]='o'then r[k]:='O';if r[k]='p'then r[k]:='P';
if r[k]='q'then r[k]:='Q';if r[k]='r'then r[k]:='R';if r[k]='s'then r[k]:='S';if r[k]='t'then r[k]:='T';
if r[k]='u'then r[k]:='U';if r[k]='v'then r[k]:='V';if r[k]='w'then r[k]:='W';if r[k]='x'then r[k]:='X';
if r[k]='y'then r[k]:='Y';if r[k]='z'then r[k]:='Z';if r[k]='а'then r[k]:='А';if r[k]='б'then r[k]:='Б';
if r[k]='в'then r[k]:='В';if r[k]='г'then r[k]:='Г';if r[k]='д'then r[k]:='Д';if r[k]='е'then r[k]:='Е';
if r[k]='ё'then r[k]:='Ё';if r[k]='ж'then r[k]:='Ж';if r[k]='з'then r[k]:='З';if r[k]='и'then r[k]:='И';
if r[k]='й'then r[k]:='Й';if r[k]='к'then r[k]:='К';if r[k]='л'then r[k]:='Л';if r[k]='м'then r[k]:='М';
if r[k]='н'then r[k]:='Н';if r[k]='о'then r[k]:='О';if r[k]='п'then r[k]:='П';if r[k]='р'then r[k]:='Р';
if r[k]='с'then r[k]:='С';if r[k]='т'then r[k]:='Т';if r[k]='у'then r[k]:='У';if r[k]='ф'then r[k]:='Ф';
if r[k]='х'then r[k]:='Х';if r[k]='ц'then r[k]:='Ц';if r[k]='ч'then r[k]:='Ч';if r[k]='ш'then r[k]:='Ш';
if r[k]='щ'then r[k]:='Щ';if r[k]='ъ'then r[k]:='Ъ';if r[k]='ы'then r[k]:='Ы';if r[k]='ь'then r[k]:='Ь';
if r[k]='э'then r[k]:='Э';if r[k]='ю'then r[k]:='Ю';if r[k]='я'then r[k]:='Я';end;result:=r;end;

procedure TTruncThread2.Execute;
var CurrentCount, i:integer;
begin
while not(Terminated) do begin
CurrentCount:=spisok.Count;
for i:=0 to CurrentCount-1 do 
Spisok.Strings[i]:=strcUP(Spisok.Strings[i]);
end;
end;

...
procedure Memo1Add();
begin
  while true do
    Form1.Memo1.Lines.Append('a');
  ExitThread(0);
end;

procedure Memo2Add();
begin
  while true do
    Form1.Memo2.Lines.Append('b');
  ExitThread(0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CloseHandle(CreateThread(nil, 0, @Memo1Add, nil, 0, dwThreadID));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CloseHandle(CreateThread(nil, 0, @Memo2Add, nil, 0, dwThreadID));
end;

end.