untmain.pas

此程序实现对汉明码的编码与译码算法。汉明码是一种多重（复式）奇偶检错系统。它将信息用逻辑形式编码

unit untMain;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  untUtils,
  StdCtrls,
  StrUtils,
  Math,
  XPMan,
  Mask;

type
  TfrmMain = class(TForm)
    edtReceiveOutput: TEdit;
    mmoHamOutput: TMemo;
    btnMakeHam: TButton;
    btnCompute: TButton;
    xpMain: TXPManifest;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    edtInputR: TMaskEdit;
    edtInputQ: TMaskEdit;
    edtReceive: TMaskEdit;
    procedure btnMakeHamClick(Sender: TObject);
    procedure btnComputeClick(Sender: TObject);
    procedure pInputValueChange(Sender: TObject);
    procedure pInputEnter(Sender: TObject);
    procedure pReceiveEnter(Sender: TObject);
  private
    m_nHamW, m_nHamR, m_nHamQ: Integer;
    m_anHamElement: array of array of Integer;
    function pIsMutuality(var anHamLine: array of Integer;
      const nScanW: Integer;
      var nMultiple: Integer): Boolean;
    function pFindLineInMatrix(var anSx: array of Integer): Integer;
    function pComputeHam(const sReceive: string): Boolean;
    function pDrawMatrix(const nHamR: Integer; const nHamQ: Integer): Boolean;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ TfrmMain }

function TfrmMain.pDrawMatrix(const nHamR, nHamQ: Integer): Boolean;
var
  anHamLine: array of Integer;
  sLastMatrixLine, sMatrixLine, sMatrixOutput: string;
  dHamW: Double;
  nMultiple, nCurrentW, nW, nR: Integer;
  bIsMutuality: Boolean;
begin
  (* 生成汉明码矩阵 *)

  Result := False;

  if (nHamR < 2) or (nHamQ < 2) then
    Exit;

  dHamW := (Power(nHamQ, nHamR) - 1) / (nHamQ - 1);
  m_nHamW := Round(dHamW);
  if dHamW <> m_nHamW then
    Exit;

  edtReceive.EditMask := '!' + DupeString('9', m_nHamW) + ';1;_';

  m_nHamR := nHamR;
  m_nHamQ := nHamQ;
  bIsMutuality := False;

  SetLength(m_anHamElement, m_nHamW, nHamR);
  SetLength(anHamLine, nHamR);

  nCurrentW := 1;
  m_anHamElement[0][nHamR - 1] := 1;

  while nCurrentW <= m_nHamW - 1 do
  begin
    sLastMatrixLine := EmptyStr;
    for nR := 0 to nHamR - 1 do
      sLastMatrixLine := sLastMatrixLine +
        IntToStr(m_anHamElement[nCurrentW - 1][nR]);
    sMatrixLine := sLastMatrixLine;

    repeat
      sMatrixLine := Format('%.' + IntToStr(nHamR) + 'd',
        [StrToInt(pAnyBaseAdd(sMatrixLine, nHamQ {, 1}))]);

      for nR := 0 to nHamR - 1 do
        m_anHamElement[nCurrentW][nR] := StrToInt(sMatrixLine[nR + 1]);
      for nW := 0 to nCurrentW - 1 do
      begin
        for nR := 0 to nHamR - 1 do
          anHamLine[nR] := m_anHamElement[nCurrentW][nR];

        bIsMutuality := pIsMutuality(anHamLine, nW, nMultiple);
      end;
    until (not bIsMutuality);

    Inc(nCurrentW, 1);
  end;

  sMatrixOutput := EmptyStr;
  for nR := 0 to nHamR - 1 do
  begin
    sMatrixOutput := sMatrixOutput + '| ';
    for nW := 0 to m_nHamW - 1 do
      sMatrixOutput := sMatrixOutput + IntToStr(m_anHamElement[nW][nR]);
    sMatrixOutput := sMatrixOutput + ' |' + #13 + #10;
  end;
  mmoHamOutput.Text := sMatrixOutput;

  Result := True;
end;

procedure TfrmMain.btnMakeHamClick(Sender: TObject);
begin
  (* 生成汉明码 *)

  pDrawMatrix(StrToInt(edtInputR.Text), StrToInt(edtInputQ.Text));
  btnCompute.Enabled := True;
  edtReceive.Enabled := True;
  edtReceive.Text := EmptyStr;
  edtReceiveOutput.Text := EmptyStr;
  edtReceive.MaxLength := m_nHamW;
  edtReceiveOutput.MaxLength := m_nHamW;
  edtReceive.SetFocus;
  btnCompute.Default := True;

end;

procedure TfrmMain.btnComputeClick(Sender: TObject);
begin
  pComputeHam(edtReceive.Text);
end;

function TfrmMain.pComputeHam(const sReceive: string): Boolean;
var
  anReceiveOutput, anSx: array of Integer;
  sReceiveOutput: string;
  nR, nW, nP, nB, nCount, nMultiple: Integer;
begin
  (* 计算译码 *)

  Result := False;
  nCount := 0;

  try
    SetLength(anReceiveOutput, m_nHamW);
    SetLength(anSx, m_nHamR);

    for nW := 0 to m_nHamW - 1 do
      anReceiveOutput[nW] := StrToInt(sReceive[nW + 1]);

    for nR := 0 to m_nHamR - 1 do
    begin
      for nW := 0 to m_nHamW - 1 do
        anSx[nR] := anSx[nR] + StrToInt(sReceive[nW]) *
          m_anHamElement[nW][nR];
      if anSx[nR] >= m_nHamQ then
        anSx[nR] := anSx[nR] mod m_nHamQ;
      Inc(nCount, anSx[nR]);
    end;

    if nCount = 0 then
      edtReceiveOutput.Text := sReceive
    else
    begin
      nP := pFindLineInMatrix(anSx);
      nB := 1;

      if nP = -1 then
        for nW := 0 to m_nHamW - 1 do
          if pIsMutuality(anSx, nW, nMultiple) then
          begin
            nB := nMultiple;
            nP := nW;
            Break;
          end;

      Dec(anReceiveOutput[nP], nB);
      if anReceiveOutput[nP] < 0 then
        Inc(anReceiveOutput[nP], m_nHamQ);
    end;

    for nW := 0 to m_nHamW - 1 do
      sReceiveOutput := sReceiveOutput + IntToStr(anReceiveOutput[nW]);
    edtReceiveOutput.Text := sReceiveOutput;

    Result := True;
  except

  end;
end;

function TfrmMain.pFindLineInMatrix(var anSx: array of Integer): Integer;
var
  nR, nW: Integer;
  bIsSame: Boolean;
begin
  (* 在矩阵中找某一列 *)

  Result := -1;
  for nW := 0 to m_nHamW - 1 do
  begin
    bIsSame := True;
    for nR := 0 to m_nHamR - 1 do
      if anSx[nR] <> m_anHamElement[nW][nR] then
      begin
        bIsSame := False;
        Break;
      end;

    if bIsSame then
    begin
      Result := nW;
      Break;
    end;
  end;
end;

procedure TfrmMain.pInputEnter(Sender: TObject);
begin
  (* 得到焦点 *)

  TMaskEdit(Sender).SelectAll;

  btnMakeHam.Default := True;
  btnCompute.Default := False;
end;

procedure TfrmMain.pInputValueChange(Sender: TObject);
begin
  (* 输入值改变 *)

  with btnMakeHam do
  begin

    Caption := '生成 Ham(' + edtInputR.Text + ',' + edtInputQ.Text + ')';
    Enabled := (edtInputR.Text <> '') and (edtInputQ.Text <> '') and
      (edtInputR.Text <> ' ') and (edtInputQ.Text <> ' ');
  end;
end;

function TfrmMain.pIsMutuality(var anHamLine: array of Integer;
  const nScanW: Integer; var nMultiple: Integer): Boolean;
var
  nR: Integer;
begin
  (* 判断是否线性相关 *)

  Result := False;
  nMultiple := 1;
  for nR := 0 to m_nHamR - 1 do
    if (m_anHamElement[nScanW][nR] <> anHamLine[nR]) and
      (m_anHamElement[nScanW][nR] <> 0) then
    begin
      nMultiple := Round(anHamLine[nR] / m_anHamElement[nScanW][nR]);
      Break;
    end;

  if nMultiple <> 1 then
  begin
    Result := True;
    for nR := 0 to m_nHamR - 1 do
      if anHamLine[nR] <> m_anHamElement[nScanW][nR] * nMultiple mod m_nHamQ
        then
      begin
        Result := False;
        Break;
      end;

    if Result then
      Exit;
  end;
end;

procedure TfrmMain.pReceiveEnter(Sender: TObject);
begin
  (* *)

  TMaskEdit(Sender).SelectAll;

  if btnCompute.Enabled then
  begin
    btnMakeHam.Default := False;
    btnCompute.Default := True;
  end;
end;

end.