ANTICHAT — форум по информационной безопасности, OSINT и технологиям

var
 CS:TRTLCriticalSection; // глобальная переменная
.......
при старте проги делаешь:
 InitializeCriticalSection(CS);
.....
в потоках делаешь:
 EnterCriticalSection(CS);
 тут идут нужные действия.
 LeaveCriticalSection(CS);

uses crt;

type
     PtrStr = ^Str;
     Str = array [1..1] of integer;

     PtrMatr = ^Matr;
     Matr = array [1..1] of PtrStr;

var
     matrica: PtrMatr;
     razmer, i, j: integer;

procedure CreateMatr;
begin
    write ('razmernost matricy: ');
    readln(razmer);

    getmem(matrica, razmer*SizeOf(PtrStr));

    for i:=1 to razmer do
    getmem(matrica^[i], razmer*SizeOf(integer));

    writeln('vvodim elementy:');
    for i:=1 to razmer do
        for j:=1 to razmer do
            readln(matrica^[i]^[j]);

end;    

    procedure destroymatrix;
    begin

    for i:=1 to razmer do
    freemem(matrica^[i], razmer*SizeOf(integer));

    freemem(matrica, razmer*SizeOf(PtrStr));


    end;

    procedure otobrajenie;
    begin
     for i:=1 to razmer do
      begin
        writeln;
        for j:=1 to razmer do
           write(matrica^[i]^[j]:5);
      end;
      writeln;
     end;


 procedure sortirovka;
    var buffer1, buffer2, buffer3: integer;
    begin
    buffer3:=1;
      for i:=1 to razmer do
      begin
       buffer1:= matrica^[i]^[1];
       buffer2:= matrica^[i]^[i];
       for j:=0 to razmer-1 do
          begin
          if matrica^[i]^[j+1] <= buffer1  then
            begin
            buffer3:=j+1;
            buffer1:=matrica^[i]^[j+1];
            end;
            matrica^[i]^[buffer3]:=buffer2;
            matrica^[i]^[i]:=buffer1;
          end;
       end;
    end;


begin
 clrscr;
 CreateMatr;
 otobrajenie;
 sortirovka;
 otobrajenie;
 destroymatrix;
 readln;
end.

procedure CreateMatr;
var
  F : text;
begin
  write ('razmernost matricy: ');
  readln(razmer);

 assign(F,'README');
 reset(F);
 читаешь пока не eof(F) и записываешь в элемент матрицы
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
if Length(Edit1.Text) = 0 then
begin
ShowMessage('Надо ввести состояние нового предмета');
exit;
end;
kachestvo1:=StrToInt(Edit1.Text);
if Length(Edit2.Text) = 0 then
begin
ShowMessage('Надо ввести состояние предмета по факту');
exit;
end;
kachestvo2:=StrToInt(Edit2.Text);
if Length(Edit3.Text) = 0 then
begin
ShowMessage('Надо ввести цену нового изделия');
exit;
end;
cenanovogo:=StrToInt(Edit3.Text);
if Length(Edit4.Text) = 0 then
begin
ShowMessage('Надо ввести размер комисcии');
exit;
end;
komissija:=StrToInt(Edit4.Text);
cenapokupki:=kachestvo1 / kachestvo2 * cenanovogo * (1-komissija/100);
Label6.Caption:=FloatToStr(cenapokupki);
cenaprodagi:=kachestvo1 / kachestvo2 * cenanovogo;
Label8.Caption:=FloatToStr(cenaprodagi);
end;

if Length(Edit1.Text) = 0 then
begin
ShowMessage(Надо ввести состояние нового предмета');
exit;
nd;

try
if strtoint(Edit1.Text)<=0 then
begin
ShowMessage('Надо ввести число больше 0');
Exit;
end;
except
ShowMessage('Надо ввести целое число!');
Exit;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 if (Key<'0') or (Key>'9') then Key:=chr(0);
end;