ecc200.~pas

delphi实现的二 维 码 生成 控制代 码

    for s := ecc200_8x18 to ecc200_16x48 do
    begin
      if ECC200SymbolParams[s].DataLength = CurPos then
      begin
        Result := True;
        Break;
      end;
      if ECC200SymbolParams[s].DataLength > CurPos then Break;
    end;
  end;
end;

function NearestSize(Shape : TEcc200Shape; CurPos: Integer): Integer;
var
  s : TECC200Size;
  outlen: Integer;
begin
    if Shape = ecc200_Square then
    begin
      for s := ecc200_10x10 to ecc200_144x144 do
      begin
        outlen := ECC200SymbolParams[s].DataLength;
        if outlen > CurPos then
        begin
          Result := outlen;
          break;
        end;
      end;
    end
    else
    begin
      for s := ecc200_8x18 to ecc200_16x48 do
      begin
        outlen := ECC200SymbolParams[s].DataLength;
        if outlen > CurPos then
        begin
          Result := outlen;
          break;
        end;
      end;
    end;
    if outlen < CurPos then raise Exception.Create('数据超出二维码容量！');
end;

procedure TriByteEncode(InByte1, InByte2, InByte3: Byte; var OutByte1, OutByte2: Byte);
var
  w: Word;
begin
  w := 1600 * InByte1 + 40 * InByte2 + InByte3 + 1;
  OutByte1 := w div 256;
  OutByte2 := w mod 256;
end;

function C40Value(ASCII: Byte) : Byte;
begin
  case ASCII of
    32:       Result := 3;
    48..57:   Result := ASCII - 48 + 4;
    65..90:   Result := ASCII - 65 + 14;
    00..31:   Result := ASCII;
    33..47:   Result := ASCII - 33;
    58..64:   Result := ASCII - 58 + 15;
    91..95:   Result := ASCII - 91 + 22;
    96..127:  Result := ASCII - 96;
    else raise Exception.Create('C40编码算法错误，请通知开发人员！ 错误信息：ASCII码大于127');
  end;
end;

function NextAreTwoDigit(var Source: TByteArray; SourceIndex: Integer): Boolean;
begin
  Result := False;
  if SourceIndex >= Length(Source) - 1 then Exit;
  Result := (Source[SourceIndex] in [48..57])
            and (Source[SourceIndex + 1] in [48..57]);
end;

procedure ASCII_EncodeDoubleDigit(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer);
begin
  Buffer[BufferIndex] :=
    ((Source[SourceIndex] - 48) * 10 + Source[SourceIndex + 1] - 48) + 130;
  Inc(SourceIndex, 2);
  Inc(BufferIndex);
end;

procedure SwitchModeTo(
  var Buffer: TByteArray;
  var BufferIndex: Integer;
  ToMode: TEncodeMode);
begin
  case ToMode of
    emC40:
    begin
      Buffer[BufferIndex] := 230; Inc(BufferIndex);
    end;

    emText:
    begin
      Buffer[BufferIndex] := 239; Inc(BufferIndex);
    end;

    emX12:
    begin
      Buffer[BufferIndex] := 238; Inc(BufferIndex);
    end;

    emEDIFACT:
    begin
      Buffer[BufferIndex] := 240; Inc(BufferIndex);
    end;

    emBase256:
    begin
      Buffer[BufferIndex] := 231; Inc(BufferIndex);
    end;
  end;
end;

procedure SwitchTriByteBack(var Buffer: TByteArray; var BufferIndex: Integer);
begin
  Buffer[BufferIndex] := 254; Inc(BufferIndex);
end;

procedure SwitchMode(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer;
  FromMode, ToMode: TEncodeMode);
begin
  case FromMode of
    emASCII:
    begin
      SwitchModeTo(Buffer, BufferIndex, ToMode);
    end;

    emC40:
    begin
      SwitchTriByteBack(Buffer, BufferIndex);
      SwitchModeTo(Buffer, BufferIndex, ToMode);
    end;

    emText:
    begin
      SwitchTriByteBack(Buffer, BufferIndex);
      SwitchModeTo(Buffer, BufferIndex, ToMode);
    end;

    emX12:
    begin
      SwitchTriByteBack(Buffer, BufferIndex);
      SwitchModeTo(Buffer, BufferIndex, ToMode);
    end;
  end;
end;

function NextIsExtendASCII(var Source: TByteArray; SourceIndex: Integer): Boolean;
begin
  Result := (Source[SourceIndex] > 127);
end;

procedure ASCII_EncodeExtendData(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer);
begin
  Buffer[BufferIndex] := 235;
  Inc(BufferIndex);
  Buffer[BufferIndex] := Source[SourceIndex] - 128 + 1;
  Inc(BufferIndex);
  Inc(sourceIndex);
end;

procedure ASCII_EncodeData(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer);
begin
  Buffer[BufferIndex] := Source[SourceIndex] + 1;
  Inc(BufferIndex);
  Inc(SourceIndex);
end;

function ASCII_Encode(
  Shape: TECC200Shape; 
  EncodeMode: TEncodeMode;
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer): TEncodeMode;
begin
  Result := EncodeMode;
  while SourceIndex < Length(Source) do
  begin
    if NextAreTwoDigit(Source, SourceIndex) then
    begin
      ASCII_EncodeDoubleDigit(Source, SourceIndex, Buffer, BufferIndex);
      Continue;
    end;
    Result := LookAhead(Source, SourceIndex, EncodeMode);
//
    if Result <> emBase256 then Result := emASCII;
//
    if Result <> emASCII then
    begin
      SwitchMode(Source, SourceIndex, Buffer, BufferIndex, EncodeMode, Result);
      Exit;
    end;
    if NextIsExtendASCII(Source, SourceIndex) then
    begin
      ASCII_EncodeExtendData(Source, SourceIndex, Buffer, BufferIndex);
      Continue;
    end;
    ASCII_EncodeData(Source, SourceIndex, Buffer, BufferIndex);
  end;
end;






function C40_EncodeFromReady(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer;
  var Byte1, Byte2, Byte3: Byte): TTriByteState;
begin
  if Source[SourceIndex] in C40BasicSet then
  begin
    Byte1 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte1;
  end
  else if Source[SourceIndex] in C40Shift1Set then
  begin
    Byte1 := 0;
    Byte2 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte2;
  end
  else if Source[SourceIndex] in C40Shift2Set then
  begin
    Byte1 := 1;
    Byte2 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte2;
  end
  else if Source[SourceIndex] in C40Shift3Set then
  begin
    Byte1 := 2;
    Byte2 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte2;
  end
  else if Source[SourceIndex] > 127 then
  begin
    if (Source[SourceIndex] - 128) in C40BasicSet then
    begin
      Byte1 := 1;
      Byte2 := 30;
      Byte3 := C40Value(Source[SourceIndex]);
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Result := tsReady;
    end
    else if (Source[SourceIndex] - 128) in C40Shift1Set then
    begin
      Byte1 := 1;
      Byte2 := 30;
      Byte3 := 0;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := C40Value(Source[SourceIndex]);
      Result := tsByte1;
    end
    else if (Source[SourceIndex] - 128) in C40Shift2Set then
    begin
      Byte1 := 1;
      Byte2 := 30;
      Byte3 := 1;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(SourceIndex, 2);
      Byte1 := C40Value(Source[SourceIndex]);
      Result := tsByte1;
    end
    else if (Source[SourceIndex] - 128) in C40Shift3Set then
    begin
      Byte1 := 1;
      Byte2 := 30;
      Byte3 := 2;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := C40Value(Source[SourceIndex]);
      Result := tsByte1;
    end
    else raise Exception.Create('C40字符集设计有遗漏， 请通知开发人员！');
  end;
end;

function C40_EncodeFromByte1(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer;
  var Byte1, Byte2, Byte3: Byte): TTriByteState;
begin
  if Source[SourceIndex] in C40BasicSet then
  begin
    Byte2 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte2;
  end
  else if Source[SourceIndex] in C40Shift1Set then
  begin
    Byte2 := 0;
    Byte3 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
    Result := tsReady;
  end
  else if Source[SourceIndex] in C40Shift2Set then
  begin
    Byte2 := 1;
    Byte3 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2);
    Result := tsReady;
  end
  else if Source[SourceIndex] in C40Shift3Set then
  begin
    Byte2 := 2;
    Byte3 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
    Inc(BufferIndex, 2);
    Result := tsReady;
  end
  else if Source[SourceIndex] > 127 then
  begin
    if (Source[SourceIndex] - 128) in C40BasicSet then
    begin
      Byte2 := 1;
      Byte3 := 30;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := C40Value(Source[SourceIndex]);
      Result := tsByte1;
    end
    else if (Source[SourceIndex] - 128) in C40Shift1Set then
    begin
      Byte2 := 1;
      Byte3 := 30;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := 0;
      Byte2 := C40Value(Source[SourceIndex]);
      Result := tsByte2;
    end
    else if (Source[SourceIndex] - 128) in C40Shift2Set then
    begin
      Byte2 := 1;
      Byte3 := 30;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := 1;
      Byte2 := C40Value(Source[SourceIndex]);
      Result := tsByte2;
    end
    else if (Source[SourceIndex] - 128) in C40Shift3Set then
    begin
      Byte2 := 1;
      Byte3 := 30;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := 2;
      Byte2 := C40Value(Source[SourceIndex]);
      Result := tsByte2;
    end
    else raise Exception.Create('C40字符集设计有遗漏， 请通知开发人员！');
  end;
end;

function C40_EncodeFromByte2(
  var Source: TByteArray;
  var SourceIndex: Integer;
  var Buffer: TByteArray;
  var BufferIndex: Integer;
  var Byte1, Byte2, Byte3: Byte): TTriByteState;
begin
  if Source[SourceIndex] in C40BasicSet then
  begin
    Byte3 := C40Value(Source[SourceIndex]);
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
    Inc(BufferIndex, 2);
    Inc(SourceIndex);
    Result := tsReady;
  end
  else if Source[SourceIndex] in C40Shift1Set then
  begin
    Byte3 := 0;
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
    Inc(BufferIndex, 2);
    Byte1 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte1;
  end
  else if Source[SourceIndex] in C40Shift2Set then
  begin
    Byte3 := 1;
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
    Inc(BufferIndex, 2);
    Byte1 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte1;
  end
  else if Source[SourceIndex] in C40Shift3Set then
  begin
    Byte3 := 2;
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
    Inc(BufferIndex, 2);
    Byte1 := C40Value(Source[SourceIndex]);
    Inc(SourceIndex);
    Result := tsByte1;
  end
  else if Source[SourceIndex] > 127 then
  begin
    if (Source[SourceIndex] - 128) in C40BasicSet then
    begin
      Byte3 := 1;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := 30;
      Byte2 := C40Value(Source[SourceIndex]);
      Result := tsByte2;
    end
    else if (Source[SourceIndex] - 128) in C40Shift1Set then
    begin
      Byte3 := 1;
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
      Inc(BufferIndex, 2);
      Byte1 := 30;
      Byte2 := 0;