Метод Хемминга

[КаролинаЯ]

Помогите пожалуйста с кодом! Не пойму где ошибка!

программа для кодирования символов методом Хэмминга
для проверки надо попробовать закодировать букву h
должен получиться 010011011000 (а у меня получается 010011001000)

procedure tform1.kodhem;
var
s,bina,hem:string;
a,b,i,z,b1,b2,b3,b4:integer;
begin
s:=memo1.Text;
hem:='';
z:=length(s);
a:=1;
while a<z do
begin
i:=0;
if s[a]='1' then i:=i xor 3;
if s[a+1]='1' then i:=i xor 5;
if s[a+2]='1' then i:=i xor 6;
if s[a+3]='1' then i:=i xor 7;
if s[a+4]='1' then i:=i xor 9;
if s[a+5]='1' then i:=i xor 10;
if s[a+6]='1' then i:=i xor 11;
if s[a+7]='1' then i:=i xor 12;

b:=i mod 8;
b:=b mod 4;
b4:=b div 8;
b3:=b div 4;
b2:=b div 2;
b1:=b mod 2;
bina:=inttostr(b1)+inttostr(b2)+s[a]+inttostr(b3)+s[a+1]+s[a+2]+s[a+3]+inttostr(b4)+s[a+4]+s[a+5]+s[a+6]+s[a+7];
hem:=hem+bina;
a:=a+12;
end;
memo2.Text:=hem;
memo3.Text:=hem;
end;

[Son Of Pain]

У тебя ошибка во второй части. После взятия остатка

b:=i mod 8;
b:=b mod 4;

теряются два старших бита (потому что остаток от деления на 4 не может быть больше трех). В итоге четвертый и восьмой биты всегда будут равны нулю.

[КаролинаЯ]

Подскажите как исправить!!!????? Пожалуйста!!??? Уже сил нет с этим кодом!

[Son Of Pain]

Нужно вытащить биты из результата. Например, вместо

b:=i mod 8;
b:=b mod 4;
b4:=b div 8;
b3:=b div 4;
b2:=b div 2;
b1:=b mod 2;

написать

b4:=(i shr 3);
b3:=(i shr 2) and 1;
b2:=(i shr 1) and 1;
b1:=i mod 2;

А еще непонятно, зачем ты в цикле увеличиваешь a на 12, если длина кодового слова равна 8 битам.

[КаролинаЯ]

подсказали так!

[КаролинаЯ]

исправила на а+8

[КаролинаЯ]

Son Of Pain
Если я напишу сюда весь код программы, поможешь исправить ошибки? Плиз!?

[Son Of Pain]

Ну пиши, мне еще 15 минут такси ждать все равно )

[КаролинаЯ]

Милый человек!!! Посмотри!!!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, XPMan;

type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    PC1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    Label5: TLabel;
    Memo3: TMemo;
    Label6: TLabel;
    Memo4: TMemo;
    Memo5: TMemo;
    Memo6: TMemo;
    Label7: TLabel;
    Label1: TLabel;
    Button2: TButton;
    Label8: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure kodhex;
    procedure binar;
    procedure kodhem;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hex:array[1..2,1..8000] of integer;
  dlina:integer; //dlina texta

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
kodhex;
binar;
kodhem;
end;

procedure tform1.kodhem;
vara
s,bin,hem:string;
a,b,i,z,b1,b2,b3,b4:integer;
begin
s:=memo1.Text;
hem:='';
z:=length(s);
a:=1;
while a<z do
begin
i:=0;
if s[a]='1' then i:=i xor 3;
if s[a+1]='1' then i:=i xor 5;
if s[a+2]='1' then i:=i xor 6;
if s[a+3]='1' then i:=i xor 7;
if s[a+4]='1' then i:=i xor 9;
if s[a+5]='1' then i:=i xor 10;
if s[a+6]='1' then i:=i xor 11;
if s[a+7]='1' then i:=i xor 12;

b:=i mod 8;
b:=b mod 4;
b4:=b div 2;
b3:=b div 4;
b2:=b div 2;
b1:=b mod 2;
bina:=inttostr(b1)+inttostr(b2)+s[a]+inttostr(b3)+s[a+1]+s[a+2]+s[a+3]+inttostr(b4)+s[a+4]+s[a+5]+s[a+6]+s[a+7];
hem:=hem+bina;
a:=a+8;
end;
memo2.Text:=hem;
memo3.Text:=hem;
end;

procedure tform1.binar;
var
a,b,temp,t1:integer;
bin:string;
begin
bin:='';
for a:=1 to dlina do
begin
for b:=1 to 2 do
begin
temp:=hex[b,a] div 8;
bin:=bin+inttostr(temp);
t1:=hex[b,a] mod 8;
temp:=t1 div 4;
bin:=bin+inttostr(temp);
t1:=t1 mod 4;
temp:=t1 div 2;
bin:=bin+inttostr(temp);
temp:=t1 mod 2;
bin:=bin+inttostr(temp);
end;
end;
memo1.Text:=bin;
end;

procedure tform1.kodhex;
var
s,h,h1,h2:string;
b,i:integer;
begin
s:=memo6.Text;
dlina:=length(s);
if dlina=0 then exit;
h:='';
for b:=1 to dlina do
begin
i:=ord(s[b]);
hex[1,b]:=i div 16;
h1:=inttostr(hex[1,b]);
case hex[1,b] of
10:h1:='A';
11:h1:='B';
12:h1:='C';
13:h1:='D';
14:h1:='E';
15:h1:='F';
end;
hex[2,b]:=i-(hex[1,b]*16);
h2:=inttostr(hex[2,b]);
case hex[2,b] of
10:h2:='A';
11:h2:='B';
12:h2:='C';
13:h2:='D';
14:h2:='E';
15:h2:='F';
end;
h:=h+h1+h2+',';
end;
delete(h,length(h),1);
memo5.Text:=h;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
s:string;
a,b,i,z,f,osh:integer;
begin
s:=memo3.Text;
z:=length(s);
a:=1;
osh:=0;
while a<z do
begin
i:=0;
for f:=0 to 6 do if s[a+f]='1' then i:=i xor (f+1);
i:=i mod 2;
if i<>0 then
begin
inc(osh);
if s[a+i-1]='0' then s[a+i-1]:='1' else s[a+i-1]:='0';
end;
a:=a+7;
end;
label8.Caption:='Найдено ошибок    '+inttostr(osh)+' шт.';
memo4.Text:=s;
end;

end.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!
Модератор.

[КаролинаЯ]

в декодировании тоже проблема(((( может из-за этого не правильного блока