stbarc.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

      end;
    bcInterleaved2of5 :
      begin
        {adjust odd length code}
        if FAddCheckChar then begin
          if not Odd(Length(C)) then
            C := '0' + C;
        end else begin
          if Odd(Length(C)) then
          C := '0' + C;
        end;
        bcDigitCount := GetDigits(C);
      end;
    bcCode39 :
      begin
        {add guard characters}
        if C[1] <> '*' then
          C := '*' + C;
        if C[Length(C)] <> '*' then
          C := C + '*';
        bcDigitCount := GetDigits(C);
      end;
    bcCode128 :
      begin
        {add start code}
        if not (C[1] in [#136, #137, #138]) then
          case FCode128Subset of
            csCodeA : C := #136 + C;
            csCodeB : C := #137 + C;
            csCodeC : C := #138 + C;
          end;
        bcDigitCount := GetDigits(C);
      end;
  end;

  case FBarCodeType of
    bcUPC_A :
      begin
        {get check digit}
        if Length(C) = 11 then
          GetCheckCharacters(C, CheckC, CheckK)
        else
          CheckC := bcDigits[12];

        {encode left hand guard bars}
        AddCode('101', [bkGuard, bkBar]);

        {first six characters as left hand characters}
        for I := 1 to 6 do
          AddCode(UPC_A_LeftHand[bcDigits[I]], [bkBar]);

        {center guard pattern}
        AddCode('01010', [bkGuard, bkBar]);

        {last five data characters as right hand characters}
        for I := 7 to 11 do
          AddCode(UPC_A_RightHand[bcDigits[I]], [bkBar]);

        {check character}
        AddCode(UPC_A_RightHand[CheckC], [bkBar]);

        {encode right hand guard bars}
        AddCode('101', [bkGuard, bkBar]);
      end;
    bcUPC_E :
      begin
        {encode left hand guard bars, 101}
        AddCode('101', [bkGuard, bkBar]);
        GetCheckCharacters(C, CheckC, CheckK);
        case CheckC of
          0 : AddECode('EEEOOO');
          1 : AddECode('EEOEOO');
          2 : AddECode('EEOOEO');
          3 : AddECode('EEOOOE');
          4 : AddECode('EOEEOO');
          5 : AddECode('EOOEEO');
          6 : AddECode('EOOOEE');
          7 : AddECode('EOEOEO');
          8 : AddECode('EOEOOE');
          9 : AddECode('EOOEOE');
        end;
        {encode right hand guard bars}
        AddCode('010101', [bkGuard, bkBar]);
      end;
    bcEAN_8   :
      begin
        {get check digit}
        if Length(C) = 7 then
          GetCheckCharacters(C, CheckC, CheckK)
        else
          CheckC := bcDigits[8];

        {encode left hand guard bars}
        AddCode('101', [bkGuard, bkBar]);
        {two flag two data characters, encoded as left hand A characters}
        for I := 1 to 4 do
          AddCode(EAN_LeftHandA[bcDigits[I]], [bkBar]);
        {encode center guard bars}
        AddCode('01010', [bkGuard, bkBar]);
        {last three data characters, encoded as right hand characters}
        for I := 5 to 7 do
          AddCode(UPC_A_RightHand[bcDigits[I]], [bkBar]);
        {check character}
        AddCode(UPC_A_RightHand[CheckC], [bkBar]);
        {encode right hand guard bars}
        AddCode('101', [bkGuard, bkBar]);
      end;
    bcEAN_13  :
      begin
        {get check digit}
        if Length(C) = 12 then
          GetCheckCharacters(C, CheckC, CheckK)
        else
          CheckC := bcDigits[13];

        {determine which left hand table to use based on first flag character}
        {EAN refers to this as the 13th digit - counting from the right}
        case bcDigits[1] of
                     { 12345}
          0 : CSP := 'AAAAAA';
          1 : CSP := 'AABABB';
          2 : CSP := 'AABBAB';
          3 : CSP := 'AABBBA';
          4 : CSP := 'ABAABB';
          5 : CSP := 'ABBAAB';
          6 : CSP := 'ABBBAA';
          7 : CSP := 'ABABAB';
          8 : CSP := 'ABABBA';
          9 : CSP := 'ABBABA';
        end;
        {encode left hand guard bars}
        AddCode('101', [bkGuard, bkBar]);
        {start with second flag character and next five data characters}
        for I := 2 to 7 do
          if CSP[I-1] = 'A' then
            AddCode(EAN_LeftHandA[bcDigits[I]], [bkBar])
          else
            AddCode(EAN_LeftHandB[bcDigits[I]], [bkBar]);
        {encode center guard bars}
        AddCode('01010', [bkGuard, bkBar]);
        {encode last five data characters}
        for I := 8 to 12 do
          AddCode(UPC_A_RightHand[bcDigits[I]], [bkBar]);
        {check character}
        AddCode(UPC_A_RightHand[CheckC], [bkBar]);
        {encode right hand guard bars}
        AddCode('101', [bkGuard, bkBar]);
      end;
    bcInterleaved2of5 :
      begin
        {add check character}
        if FAddCheckChar then begin
          {get check digit}
          GetCheckCharacters(C, CheckC, CheckK);
          Inc(bcDigitCount);
          bcDigits[bcDigitCount] := CheckC;
        end;

        {encode left guard pattern}
        bcBarInfo.Add(1, [bkGuard, bkBar]);
        bcBarInfo.Add(1, [bkGuard, bkSpace]);
        bcBarInfo.Add(1, [bkGuard, bkBar]);
        bcBarInfo.Add(1, [bkGuard, bkSpace]);

        I := 1;
        while I < bcDigitCount do begin
          {take two characters at a time - odd as bars, even as spaces}
          C1 := Interleaved_2of5[bcDigits[I]];
          C2 := Interleaved_2of5[bcDigits[I+1]];
          {interleave data}
          for J := 1 to 5 do begin
            if C1[J] = '1' then
              bcBarInfo.Add(FBarNarrowToWideRatio, [bkBar]) {wide bar}
            else
              bcBarInfo.Add(1, [bkBar]);   {narrow bar}
            if C2[J] = '1' then
              bcBarInfo.Add(FBarNarrowToWideRatio, [bkSpace]){wide space}
            else
              bcBarInfo.Add(1, [bkSpace]); {narrow space}
          end;
          Inc(I, 2);
        end;

        {encode right guard pattern}
        bcBarInfo.Add(FBarNarrowToWideRatio,
          [bkGuard, bkBar]); {double-width bar}
        bcBarInfo.Add(1, [bkGuard, bkSpace]);
        bcBarInfo.Add(1, [bkGuard, bkBar]);
      end;
    bcCodabar :
      begin
        for I := 1 to bcDigitCount do begin
          AddCodeWideNarrow(Codabar[bcDigits[I]]);
          if I < bcDigitCount then
            bcBarInfo.Add(1, [bkSpace]);
        end;
      end;
    bcCode11 :
      begin
        AddCodeWideNarrow(Code11[11]);  {start}
        bcBarInfo.Add(1, [bkSpace]);
        {add check characters}
        if FAddCheckChar then begin
          {get check digits}
          GetCheckCharacters(C, CheckC, CheckK);
          Inc(bcDigitCount);
          bcDigits[bcDigitCount] := CheckC;
          Inc(bcDigitCount);
          bcDigits[bcDigitCount] := CheckK;
        end;

        for I := 1 to bcDigitCount do begin
          AddCodeWideNarrow(Code11[bcDigits[I]]);
          bcBarInfo.Add(1, [bkSpace]);
        end;
        AddCodeWideNarrow(Code11[11]);  {stop}
      end;
    bcCode39 :
      begin
        for I := 1 to bcDigitCount do begin
          C1 := Code39[bcDigits[I]];
          for J := 1 to Length(C1) do begin
            case C1[J] of
              '0' : if Odd(J) then
                      bcBarInfo.Add(1, [bkBar])
                    else
                      bcBarInfo.Add(1, [bkSpace]);
              '1' : if Odd(J) then
                      bcBarInfo.Add(2, [bkBar])
                    else
                      bcBarInfo.Add(2, [bkSpace]);
            end;
          end;
          bcBarInfo.Add(1, [bkSpace]);
        end;
      end;
    bcCode93 :
      begin;
        {start character}
        AddCodeModules('111141');
        {add check characters}
        if FAddCheckChar then begin
          {get check digits}
          GetCheckCharacters(C, CheckC, CheckK);
          Inc(bcDigitCount);
          bcDigits[bcDigitCount] := CheckC;
          Inc(bcDigitCount);
          bcDigits[bcDigitCount] := CheckK;
        end;
        for I := 1 to bcDigitCount do
          AddCodeModules(Code93[bcDigits[I]]);
        {stop character}
        AddCodeModules('1111411');
      end;
    bcCode128 :
      begin
        {add check character}
        if FAddCheckChar then begin
          GetCheckCharacters(C, CheckC, CheckK);
          Inc(bcDigitCount);
          bcDigits[bcDigitCount] := CheckC;
        end;
        {add stop code}
        Inc(bcDigitCount);
        bcDigits[bcDigitCount] := 106;
        for I  := 1 to bcDigitCount do
          AddCodeModules(Code128[bcDigits[I]]);
      end;
  end;

  if FBarCodeType in [bcUPC_A, bcUPC_E, bcEAN_8, bcEAN_13] then begin
    {add supplemental encodings if requested}
    if Length(FSupplementalCode) in [2, 5] then begin
      {get digits}
      bcDigitCount := GetDigits(FSupplementalCode);
      {7 spaces after primary code - 0000000}
      AddCode('0000000', [bkThreeQuarterBar, bkBlankSpace]);
      {encode left hand guard bars, 1011}
      AddCode('1011', [bkThreeQuarterBar, bkSupplement]);

      if bcDigitCount = 2 then begin
        {two digit supplement}
        {determine parity table to use for each of the two characters}
        X := bcDigits[1] * 10 + bcDigits[2];
        case X mod 4 of
          0 : AddSupCode('OO');
          1 : AddSupCode('OE');
          2 : AddSupCode('EO');
          3 : AddSupCode('EE');
         end;
      end else begin
        {five digit supplement}
        {determine the parity pattern to use for each of the five}
        X := ((bcDigits[1] + bcDigits[3] + bcDigits[5])*3 + (bcDigits[2] + bcDigits[4])*9) mod 10;
        case X of
          0 : AddSupCode('EEOOO');
          1 : AddSupCode('EOEOO');
          2 : AddSupCode('EOOEO');
          3 : AddSupCode('EOOOE');
          4 : AddSupCode('OEEOO');
          5 : AddSupCode('OOEEO');
          6 : AddSupCode('OOOEE');
          7 : AddSupCode('OEOEO');
          8 : AddSupCode('OEOOE');
          9 : AddSupCode('OOEOE');
        end;
      end;
    end;
  end;
end;

procedure TStBarCode.CalcBarCodeWidth;
var
  I : Integer;
begin
  bcNormalWidth := 0;
  bcSpaceWidth := 0;
  bcSupplementWidth := 0;
  for I := 0 to bcBarInfo.Count-1 do begin
    if bkSpace in bcBarInfo[I].Kind then begin
      if bkBlankSpace in bcBarInfo[I].Kind then
        Inc(bcSpaceWidth, bcSpaceModWidth*bcBarInfo[I].Modules)
      else if bkSupplement in bcBarInfo[I].Kind then
        Inc(bcSupplementWidth, bcSpaceModWidth*bcBarInfo[I].Modules)
      else
        Inc(bcNormalWidth, bcSpaceModWidth*bcBarInfo[I].Modules)
    end else begin
      if bkBlankSpace in bcBarInfo[I].Kind then
        Inc(bcSpaceWidth, bcBarModWidth*bcBarInfo[I].Modules)
      else if bkSupplement in bcBarInfo[I].Kind then
        Inc(bcSupplementWidth, bcBarModWidth*bcBarInfo[I].Modules)
      else
        Inc(bcNormalWidth, bcBarModWidth*bcBarInfo[I].Modules)
    end;
  end;
end;

procedure TStBarCode.CMTextChanged(var Msg : TMessage);
begin
  CalcBarCode;
  Invalidate;
end;

procedure TStBarCode.CopyToClipboard;
var
  MetaFile       : TMetaFile;
  MetaFileCanvas : TMetaFileCanvas;
  Bitmap         : TBitmap;
begin
  Clipboard.Clear;
  Clipboard.Open;
  try
    {bitmap}
    Bitmap := TBitmap.Create;
    try
      Bitmap.Width := ClientWidth;
      Bitmap.Height := ClientHeight;
      PaintToDC(Bitmap.Canvas.Handle, ClientRect);
      Clipboard.Assign(Bitmap);

      {metafile}
      MetaFile := TMetaFile.Create;
      try
        MetaFileCanvas := TMetaFileCanvas.Create(MetaFile, 0);
        try
          MetaFile.Enhanced := True;
          MetaFile.Width := ClientWidth;
          MetaFile.Height := ClientHeight;
          MetaFileCanvas.Draw(0, 0, Bitmap);
        finally
          MetaFileCanvas.Free;
        end;
        Clipboard.Assign(MetaFile);
      finally
        MetaFile.Free;
      end;

    finally
      Bitmap.Free;
    end
  finally
    Clipboard.Close;
  end;
end;

constructor TStBarCode.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  bcBarInfo := TStBarCodeInfo.Create;

  {defaults}
  Color := clWhite;
  Width := 200;
  Height := 75;
  Text := '123456789012';

  FAddCheckChar := True;
  FBarColor := clBlack;
  FBarToSpaceRatio := 1;
  FBarNarrowToWideRatio := bcDefNarrowToWideRatio;
  FBarWidth := 12;
  FShowCode := True;
  FShowGuardChars := False;
  FTallGuardBars := False;
  FExtendedSyntax := False;
end;

destructor TStBarCode.Destroy;
begin
  bcBarInfo.Free;
  bcBarInfo := nil;

  inherited Destroy;
end;

function TStBarCode.DrawBar(XPos, YPos, AWidth, AHeight : Integer) : Integer;
begin
  Canvas.Rectangle(XPos, YPos, XPos+AWidth, YPos+AHeight);
  Result := XPos + AWidth;
end;

procedure TStBarCode.DrawBarCode(const R : TRect);
var
  I, X, Y        : Integer;
  CheckC         : Integer;
  CheckK         : Integer;
  TH, GA, TQ, BB : Integer;
  BarCodeHeight  : Integer;
  BarCodeWidth   : Integer;
  PixelsPerInchX : Integer;
  TR             : TRect;
  SmallestWidth  : Double;
  C              : string;
  Buf            : array[0..512] of Char;
begin
  Canvas.Brush.Color := FBarColor;
  Canvas.Brush.Style := bsSolid;

  PixelsPerInchX := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);

  {determine narrowest line width}
  SmallestWidth := SmallestLineWidth(PixelsPerInchX);

  {find sizes for the BarCode elements}
  bcBarModWidth := Round(FBarWidth/1000 * PixelsPerInchX);
  if bcBarModWidth < FBarToSpaceRatio then
    bcBarModWidth := Round(BarToSpaceRatio);