Добрый вечер. Необходима помощь с блок схемами.. Дело в том,  что написав 2 программы, по курсовой, оказалось не сложным, но проблемма заключается именно в схемах.. Туго у меня с ними... Вот так странно получаеца, но другова выхода я найти не могу, кроме как обратиться к вам с помощью в этом деле... Курсовую очень нада здать на этой недели... желательно завтра.  Очень надеюсь на вашу помощь...

 
  Код программы №1:

var
  K: Byte;
begin
  Count := Memo.Lines.Count;
  for K := 1 to Count do
    begin
      Arr[K] := StrToInt(Memo.Lines[K-1]);
    end;
end;

function Reverse(St: String): String; {Для того, чтобы правильно обработать результат перевода в Двоичную систему счисления, надо применить функцию Reverse (разворот)}
var
 I: Byte;
begin
  Result := '';
  for I := Length(St) downto 1 do
    Result := Result + St[I];
end;

procedure FillBinaryArray(var Arr: tArray; Count: Byte; Memo: tMemo);
var
  I:Byte;
  N: Word;
  St1, St: String;
begin
  for I := 1 to Count do
    begin
      N := Arr[I];
      St1 := '';
      while N >= 2 do
        begin
          St1 := St1+ IntToStr(N mod 2);
          N := N div 2;
        end;
      St := IntToStr(N)+ Reverse(St1);
      Memo.Lines.Add(St);
    end;
end;

procedure FindMax(Memo: tMemo; var MaxIndex: Byte; var NullArray: tArray);
var
  I: Byte;
  Max, Count: Word;
  St: String;
begin
  MaxIndex := 0;
  Max := 0;
  St := Memo.Lines[0];
  while St <> '' do
    begin
      if Pos('0', St) <> 0 then
        begin
          Inc(Max);
          Delete(St, 1, Pos('0', St));
        end;
    end;
  NullArray[1] := Max;
  
  for I := 1 to Memo.Lines.Count- 1 do
    begin
      St := Memo.Lines[I];
      Count := 0;
      while (St <> '') and (Pos('0', St) <> 0) do  {основной цикл с предусловием (while) программы,  который отыскивает 0,и если находит, передвигается на 1 шаг вперед, и так до тех пор, пока выполняется условие}
        begin
           if Pos('0', St) <> 0 then
             begin
               Inc(Count);  {передвигается на шаг вперед}
               Delete(St, 1, Pos('0', St)); {удаляет все предыдущее, которое уже найдено}
             end;
        end;
      NullArray[I+1] := Count; { подсчитывает кол-во нулей  в массиве}
      if Count > Max then
        begin
          Max := Count;
          MaxIndex := I;
        end;
    end;
end;

var
  A, Nulls: tArray;
  Count1, Index, I: Byte;
begin
  if Memo2.Lines.Count <> 0 then 
    Memo2.Clear;  {очищает поле вывода результата перевода в двоичную систему}
  tChart1.Series[0].Clear; {очищает гистограмму}
  Edit1.Text := '';
  Edit2.Text := '';
    
// заполнение массива введенными числами
  FillArray(A, Count1, Memo1);
// построение двоичных представлений чисел
  FillBinaryArray(A,Count1, Memo2);

// нахождение индекса числа с максимальным количеством нулей в //двоичном представлении
  FindMax(Memo2, Index, Nulls);
  Edit1.Text := Memo1.Lines[Index];
  Edit2.Text := IntToStr(Index+1);

// построение гистограммы
  for I := 1 to Memo1.Lines.Count do
    tChart1.Series[0].Add(Nulls[I]);
end;

end.



 

 Код программы №2

procedure TForm1.Button1Click(Sender: TObject);
type
  tArray = Array [1..50] of Byte;

procedure FillArray(var Arr: tArray; var Count: Byte; Memo: tMemo);
var
  K: Byte;
begin
  Count := Memo.Lines.Count;
  for K := 1 to Count do
    begin
      Arr[K] := StrToInt(Memo.Lines[K-1]);
    end;
end;

var
  A: tArray;
  B: tArray;
  C: tArray;
  I, J, Count1, Count2, Num: Byte;
begin
// отчистка области вывода результата
  if Memo3.Lines.Count <> 0 then
    Memo3.Clear;

// заполнение введенными данными массивов A и B
  FillArray(A, Count1, Memo1);
  FillArray(B, Count2, Memo2);

// для каждого элемента массива B[I] проверяем количество (Num), его
// вхождений в массив A
  for I := 1 to Count2 do
    begin
      Num := 0;
      for J := 1 to Count1 do
        if B[I]=A[J] then
          Inc(Num);
      C[I] := Num;
    end;

// вывод результата
  for I := 1 to Count2 do
    Memo3.Lines.Add(IntToStr(C[I]));
end;

end.

Есть специальные программы, которые по коду строят блок-схему. Если тебе нужно, пиши мыло, я перекину! Весит 700kb