Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.06.2009, 19:48   #1
DeadVirus
 
Регистрация: 23.06.2009
Сообщений: 3
По умолчанию Delphi Код грея

Народ выручайте есть несколько прог нужен полный комментарий по строчно.
ЗЫ Завтра сдаваться(((

Код:
var
  i: integer;
  str, res: string;
begin
  str := LabeledEdit1.Text;
  res := '';
  for i := 1 to length(str) do if not (str[i] in ['0', '1']) then
    begin
      Label1.Caption := 'Íåêîððåêòíûå ñèìâîëû â ñòðîêå';
      exit;
    end;
  for i := length(str) downto 2 do
    insert(IntToStr((StrToInt(str[i])+StrToInt(str[i-1])) mod 2), res, 1);
  insert(str[1], res, 1);
  Edit1.Text := res;
  LabeledEdit2.Text := Edit1.Text;
  Label1.Caption := 'Âûïîëíåíî';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  str, res: string;
  i: integer;
  even: boolean;
begin
  str := LabeledEdit2.Text;
  res := '';
  for i := 1 to length(str) do if not (str[i] in ['0', '1']) then
    begin
      Label1.Caption := 'Íåêîððåêòíûå ñèìâîëû â ñòðîêå';
      exit;
    end;
  even := true;
  for i := 1 to length(str) do
   begin
     if even then res := res + str[i]
     else if str[i] = '1' then res := res + '0'
          else res := res + '1';
     if str[i] = '1' then even := not even;
   end;
  Edit2.Text := res;
  Label2.Caption := 'Âûïîëíåíî';
end;

end.

Последний раз редактировалось MaTBeu; 24.06.2009 в 18:57.
DeadVirus вне форума Ответить с цитированием
Старый 23.06.2009, 20:03   #2
NSvirus
пропагандирую жизЪ
Форумчанин
 
Аватар для NSvirus
 
Регистрация: 19.03.2007
Сообщений: 950
По умолчанию

Код:
var
i: integer;
str, res: string;
begin
str := LabeledEdit1.Text;
res := '';
for i := 1 to length(str) do  //перебор элементов от 1 до конца строки, 
if not (str[i] in ['0', '1']) then //если в строке нет нуля и еденицы,
begin
Label1.Caption := 'Íåêîððåêòíûå ñèìâîëû â ñòðîêå';
exit;
end;
for i := length(str) downto 2 do //перебор элементов с конца до 2 символа
insert(IntToStr(((StrToInt(str[i])+StrToInt(str[i-1])) mod 2), res, 1);
//Строковой символ: str[i] и str[i-1] переводится в числа, после складываются, Делим это число на 2, получаем остаток. Переводим остаток в символьный тип, вставляем результат в переменную res, начиная с символа 1.

insert(str[1], res, 1); //вставляем символ str[1] в строку res, начиная с 1.
Edit1.Text := res; //поместить в Едит1.текст результат
LabeledEdit2.Text := Edit1.Text;
Label1.Caption := 'Âûïîëíåíî';
end;
Посторонним В.

Последний раз редактировалось MaTBeu; 24.06.2009 в 18:57.
NSvirus вне форума Ответить с цитированием
Старый 24.06.2009, 18:15   #3
DeadVirus
 
Регистрация: 23.06.2009
Сообщений: 3
По умолчанию

Код Двоичного калькулятора вроде рабочий если каму не трудно попрошу также всё прокомментировать.. Спасибо


Код:
var
  Form1: TForm1;
  numb,code,perenos:Integer;
  bin1,bin2:String;
implementation

{$R *.dfm}

function ToBin(dec: Integer): String;                                    { ÄÂÎÈ×ÍÓÞ}
var str: String;
begin
 str := '';
 while dec > 0 do
   begin
    str := inttostr(dec mod 2) + str;
    dec := dec div 2;
   end;
 while length(str) < 8 do insert('0', str, 1);
 Result := str;
end;

function FromBin(const bin: String): String;                              { ÄÅÑßÒÈ×ÍÓÞ}
var i, dec: Integer;
begin
 dec := 0;
 for i := 1 to length(bin) do dec := 2 * dec + strtoint(bin[i]);
 Result := inttostr(dec);
end;

function Sum(const bin1,bin2: String): String;                             {ÑÓÌÌÀ}
var str: String; i: Integer;
begin
 str := '';
 perenos := 0;
 for i:=8 downto 1 do
 begin
  str := inttostr((strtoint(bin1[i]) + strtoint(bin2[i]) + perenos) mod 2) + str;
  perenos := (strtoint(Bin1[i]) + strtoint(Bin2[i]) + perenos) div 2;
 end;
 Result := str;
end;

function Inv(const Bin: string): String;                                   {ÈÍÂÅÐÒÈÐÎÂÀÒÜ}
var i: integer; str: string;
begin
 str := '';
 for i := 1 to 8 do
 if bin[i] = '1' then
 begin
  str := str + '0'
 end
 else str := str + '1';
 Result := str;
end;

procedure TForm1.Edit1Change(Sender: TObject);                             {ÂÂÎÄ 1}
begin
 val(Edit1.Text, numb, code);
 if (code > 0) or (numb>127) or (numb<-128) then
 begin
  Label3.Caption := 'Îøèáêà!';
  Edit3.Text := '00000000';
  Edit1.Font.Color := clRed;
 end
 else
  begin
   Edit1.Font.Color := clGreen;
   Label3.Caption := '';
   if numb >= 0 then Edit3.Text := ToBin(strtoint(Edit1.Text))
   else Edit3.Text := Sum(Inv(ToBin(abs(numb))),'00000001');
  BitBtn1.Enabled := true;
  BitBtn2.Enabled := true;
  end;
 if Edit1.Text = '' then
 begin
  Label3.Caption := 'Ââåäèòå äàííûå!';
  BitBtn1.Enabled := false;
  BitBtn2.Enabled := false;
 end;
end;

procedure TForm1.Edit2Change(Sender: TObject);                                {ÂÂÎÄ 2}
begin
  val(Edit2.Text, numb, code);
 if (code > 0) or (numb>127) or (numb<-128) then
 begin
  Label3.Caption := 'Îøèáêà!';
  Edit4.Text := '00000000';
  Edit2.Font.Color := clRed;
 end
 else
  begin
   Edit2.Font.Color := clGreen;
   Label3.Caption := '';
   if numb >= 0 then Edit4.Text := ToBin(strtoint(Edit2.Text))
   else Edit4.Text := Sum(Inv(ToBin(abs(numb))),'00000001');
   BitBtn1.Enabled := true;
   BitBtn2.Enabled := true;
  end;
 if Edit2.Text = '' then
 begin
  Label3.Caption := 'Ââåäèòå äàííûå!';
  BitBtn1.Enabled := false;
  BitBtn2.Enabled := false;
 end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);                                     {ÑËÎÆÅÍÈÅ}
begin
 Label3.Caption := '';
 Edit5.Text := Sum(Edit3.Text, Edit4.Text);
 if perenos > 0 then CHeckBox1.Checked:=true else CHeckBox1.Checked := false;

 if (perenos = 1) and (Edit5.Text[1] = '0') and (strtoint(Edit1.Text)*strtoint(Edit2.Text) > 0)
  then Label3.Caption := 'Îòðèöàòåëüíîå ïåðåïîëíåíèå';

 if (perenos = 0) and (Edit5.Text[1] = '1') and (strtoint(Edit1.Text)*strtoint(Edit2.Text) > 0)
  then Label3.Caption := 'Ïîëîæèòåëüíîå ïåðåïîëíåíèå';

 if (Edit5.Text[1] = '1') then
  Edit6.Text := '-' + FromBin(Sum(Inv(Edit5.Text),'00000001'));
 if (Edit5.Text[1] = '0') then
 Edit6.Text := FromBin(Edit5.Text);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);                                     {ÂÛ×ÈÒÀÍÈÅ}
begin
 Label3.Caption := '';
 Edit5.Text := Sum(Edit3.Text, Sum(Inv(Edit4.Text),'00000001'));
 if perenos > 0 then CHeckBox1.Checked:=true else CHeckBox1.Checked := false;

 if (perenos = 1) and (Edit5.Text[1] = '0') and (strtoint(Edit1.Text)*strtoint(Edit2.Text) < 0)
  then Label3.Caption := 'Îòðèöàòåëüíîå ïåðåïîëíåíèå';

 if (perenos = 0) and (Edit5.Text[1] = '1') and (strtoint(Edit1.Text)*strtoint(Edit2.Text) < 0)
  then Label3.Caption := 'Ïîëîæèòåëüíîå ïåðåïîëíåíèå';

 if (Edit5.Text[1] = '1') then
  Edit6.Text := '-' + FromBin(Sum(Inv(Edit5.Text),'00000001'));
 if (Edit5.Text[1] = '0') then
 Edit6.Text := FromBin(Edit5.Text);
end;

end.

Последний раз редактировалось MaTBeu; 24.06.2009 в 18:57.
DeadVirus вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Генерация кода Грея Merkator Помощь студентам 6 08.01.2012 01:19
Перевести код с Delphi на С++ Vladya Помощь студентам 10 30.03.2009 20:31
Код Грея(С++) Cdevelop Помощь студентам 1 16.03.2009 22:41
Код Грея Cdevelop Общие вопросы C/C++ 2 16.03.2009 19:29
Please!!! Проверьте код по Delphi!!! Dmitriy-e-nest Помощь студентам 2 16.01.2009 15:41