stbarc.pas

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

  if bcBarModWidth < SmallestWidth then
    bcBarModWidth := Round(SmallestWidth);
  bcSpaceModWidth := Round(bcBarModWidth / FBarToSpaceRatio);

  {total width of BarCode and position within rect}
  CalcBarCodeWidth;
  BarCodeWidth := bcNormalWidth + bcSpaceWidth + bcSupplementWidth;
  BarCodeHeight := RectHeight(R);
  if BarCodeWidth < RectWidth(R) then
    X := R.Left + (RectWidth(R)-BarCodeWidth) div 2
  else
    X := R.Left;
  Y := R.Top;

  {get text height}
  TH := Canvas.TextHeight('Yg0');

  {guard bar adjustment}
  GA := (BarCodeHeight*10) div 100; {10% of bar height}
  {but, not more than 1/4 of the font height}
  if FShowCode and (GA > TH div 4) then
    GA := TH div 4;

  {three quarter height bar adjustment}
  TQ := BarCodeHeight div 4;

  {draw the text}
  if FShowCode and (Code > '') then begin
    C := Code;
    {fill out invalid codes}
    case FBarCodeType of
      bcUPC_A  :
        begin
          C := Copy(C, 1, 12); {truncate}
          if Length(C) = 11 then begin
            GetCheckCharacters(C, CheckC, CheckK);
            C := C + IntToStr(CheckC);
          end;
          while Length(C) < 12 do
            C := C + '0';
        end;
      bcUPC_E  :
        begin
          C := Copy(C, 1, 6); {truncate}
          while Length(C) < 6 do
            C := C + '0';
        end;
      bcEAN_8  :
        begin
          C := Copy(C, 1, 8); {truncate}
          if Length(C) = 7 then begin
            GetCheckCharacters(C, CheckC, CheckK);
            C := C + IntToStr(CheckC);
          end;
          while Length(C) < 8 do
            C := C + '0';
        end;
      bcEAN_13 :
        begin
          C := Copy(C, 1, 13); {truncate}
          if Length(C) = 12 then begin
            GetCheckCharacters(C, CheckC, CheckK);
            C := C + IntToStr(CheckC);
          end;
          while Length(C) < 13 do
            C := C + '0';
        end;
      bcInterleaved2of5 :
        begin
          if Odd(Length(C)) then
            C := '0' + C;
        end;
      bcCodabar :
        begin
          if not FShowGuardChars then
            {strip leading and trailing characters}
            C := Copy(C, 2, Length(C)-2);
        end;
      bcCode11 :
        begin
        end;
      bcCode39 :
        begin
          {add guard characters}
          if C[1] <> '*' then
            C := '*' + C;
          if C[Length(C)] <> '*' then
            C := C + '*';
          if not FShowGuardChars then
            {strip leading and trailing characters}
            C := Copy(C, 2, Length(C)-2);
        end;
      bcCode93 :
        begin
          {remove non-printable characters}
          for I := 1 to Length(C) do
            if C[I] < ' ' then
              C[I] := ' ';
        end;
      bcCode128 :
        begin
          {remove non-printable characters}
          I := 1;
          while I <= Length (C) do begin
            if C[I] < ' ' then
              C[I] := ' ';
            if (i < Length (C)) and (ExtendedSyntax) then begin
              if (C[I] = '\') and
                 (C[I + 1] in ['A', 'B', 'C', 'a', 'b', 'c']) then begin
                C[I] := ' ';
                C[I + 1] := ' ';
                Inc (I);
              end else if (C[I] = '\') and (C[I+1] = '\') then begin
                C[I] := ' ';
                Inc (I);
              end;
            end;
            Inc (I);
          end;
        end;
    end;

    Dec(BarCodeHeight, TH + (TH div 4));
    Canvas.Brush.Style := bsClear;
    {guard bar adjustment - again}
    GA := (BarCodeHeight*10) div 100; {10% of bar height}
    {but, not more than 1/4 of the font height}
    if FShowCode and (GA > TH div 4) then
      GA := TH div 4;
    {three quarter height bar adjustment}
    TQ := BarCodeHeight div 4;

    if FBarCodeType = bcUPC_A then begin
      {print first and last character to sides of symbol}
      TR.Top := Y;
      TR.Bottom := TR.Top + BarCodeHeight;
      {left hand character}
      Buf[0] := C[1];
      TR.Right := X;
      TR.Left := X - 2 * Canvas.TextWidth(C[1]);
      DrawText(Canvas.Handle, @Buf, 1, TR, DT_BOTTOM or DT_CENTER or DT_SINGLELINE);
      {remove character from code to print}
      C := Copy(C, 2, Length(C)-1);

      {right hand character - if no supplemental code}
      if FSupplementalCode = '' then begin
        Buf[0] := C[Length(C)];
        TR.Left := X + bcNormalWidth;
        TR.Right := X + bcNormalWidth +  2 * Canvas.TextWidth(C[Length(C)]);
        DrawText(Canvas.Handle, @Buf, 1, TR, DT_BOTTOM or DT_CENTER or DT_SINGLELINE);
        {remove character from code to print}
        C := Copy(C, 1, Length(C)-1);
      end;
    end;

    if FSupplementalCode > '' then begin
      {draw supplemental code above the code}
      TR.Top := Y + TQ - TH;
      TR.Bottom := Y + BarCodeHeight;
      TR.Left := X + bcNormalWidth + bcSpaceWidth;
      TR.Right := TR.Left + bcSupplementWidth;
      StrPLCopy(Buf, FSupplementalCode, SizeOf(Buf)-1);
      DrawText(Canvas.Handle, @Buf, StrLen(Buf), TR, DT_VCENTER or DT_CENTER);
    end;

    TR := R;
    TR.Top := R.Top + BarCodeHeight + (TH div 4);
    TR.Left := X;
    TR.Right := TR.Left + bcNormalWidth;
    Canvas.Brush.Style := bsClear;
    StrPLCopy(Buf, C, SizeOf(Buf)-1);
    DrawText(Canvas.Handle, @Buf, StrLen(Buf), TR, DT_VCENTER or DT_CENTER);
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := FBarColor;
  end;

  if (FBarCodeType = bcInterleaved2of5) and FBearerBars then begin
    BB := 3 * bcBarModWidth;
    {reduce height to allow for bearer bars}
    Dec(BarCodeHeight, BB * 2);
    {draw the bearer bars}
    Canvas.Rectangle(X-bcBarModWidth, Y,
                     X+BarCodeWidth+bcBarModWidth, Y+BB);
    Canvas.Rectangle(X-bcBarModWidth, Y+BarCodeHeight+BB,
                     X+BarCodeWidth+bcBarModWidth, Y+BarCodeHeight+BB*2);
    {adjust top of BarCode}
    Inc(Y, BB);
  end;

  {draw the bar code}
  for I := 0 to bcBarInfo.Count-1 do begin
    if bkSpace in bcBarInfo[I].Kind then
      Inc(X, bcSpaceModWidth*bcBarInfo[I].Modules)
    else if (bkGuard in bcBarInfo[I].Kind) and FTallGuardBars then begin
      if bcGuardBarAbove and bcGuardBarBelow then
        X := DrawBar(X, Y-GA, bcBarModWidth*bcBarInfo[I].Modules, BarCodeHeight+2*GA)
      else if bcGuardBarAbove then
        X := DrawBar(X, Y-GA, bcBarModWidth*bcBarInfo[I].Modules, BarCodeHeight+GA)
      else if bcGuardBarBelow then
        X := DrawBar(X, Y, bcBarModWidth*bcBarInfo[I].Modules, BarCodeHeight+2*GA)
    end else if (bkBar in bcBarInfo[I].Kind) or (bkGuard in bcBarInfo[I].Kind) then
      X := DrawBar(X, Y, bcBarModWidth*bcBarInfo[I].Modules, BarCodeHeight)
    else if (bkThreeQuarterBar in bcBarInfo[I].Kind) then
      X := DrawBar(X, Y+TQ, bcBarModWidth*bcBarInfo[I].Modules, BarCodeHeight-TQ);
  end;
end;

 {added}
function TStBarCode.GetBarCodeWidth(ACanvas : TCanvas) : Double;
var
  PixelsPerInchX : Integer;
  SmallestWidth  : Double;
begin
  PixelsPerInchX := GetDeviceCaps(ACanvas.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);
  if bcBarModWidth < SmallestWidth then
    bcBarModWidth := Round(SmallestWidth);
  bcSpaceModWidth := Round(bcBarModWidth / FBarToSpaceRatio);

  CalcBarcodeWidth;

  {width in pixels (not counting text printed to left or right of code)}
  Result := bcNormalWidth + bcSpaceWidth + bcSupplementWidth;
  {return width of barcode in inches}
  Result := Result / PixelsPerInchX;
end;

procedure TStBarCode.GetCheckCharacters(const S : string; var C, K : Integer);
var
  I  : Integer;
  C1 : Integer;
  C2 : Integer;
  St : string;
begin
  C := -1;
  K := -1;
  St := S;
  case FBarCodeType of
    bcUPC_A :
      begin
        if Length(St) >= 11 then begin
          {get digits}
          GetDigits(St);
          {determine check character}
          C1 := (bcDigits[1] + bcDigits[3] + bcDigits[5] + bcDigits[7] +
                 bcDigits[9] + bcDigits[11]) * 3;
          C2 := bcDigits[2] + bcDigits[4] + bcDigits[6] +
                bcDigits[8] + bcDigits[10];
          C := 10 - ((C1 + C2) mod 10);
          if C = 10 then
            C := 0;
        end;
      end;
    bcUPC_E :
      begin
        {get digits}
        GetDigits(St);
        {determine check character}
        C1 := (bcDigits[2] + bcDigits[4] + bcDigits[6]) * 3;
        C2 := bcDigits[1] + bcDigits[3] + bcDigits[5];
        C := 10 - ((C1 + C2) mod 10);
        if C = 10 then
          C := 0;
      end;
    bcEAN_8 :
      begin
        if Length(St) >= 7 then begin
          {get digits}
          GetDigits(St);
          {determine check character}
          C1 := (bcDigits[1] + bcDigits[3] + bcDigits[5] + bcDigits[7]) * 3;
          C2 := bcDigits[2] + bcDigits[4] + bcDigits[6];
          C := 10 - ((C1 + C2) mod 10);
          if C = 10 then
            C := 0;
        end;
      end;
    bcEAN_13 :
      begin
        if Length(St) >= 12 then begin
          {get digits}
          GetDigits(St);
          {determine check character}
          C1 := (bcDigits[2] + bcDigits[4] + bcDigits[6] + bcDigits[8] +
                 bcDigits[10] + bcDigits[12]) * 3;
          C2 := bcDigits[1] + bcDigits[3] + bcDigits[5] + bcDigits[7] +
                bcDigits[9] + bcDigits[11];
          C := 10 - ((C1 + C2) mod 10);
          if C = 10 then
            C := 0;
        end;
      end;
    bcInterleaved2of5 :
      begin
        {get digits}
        bcDigitCount := GetDigits(St);

        C1 := 0;
        C2 := 0;
        for I := 1 to bcDigitCount do
          if Odd(I) then
            C1 := C1 + bcDigits[I]  {odd digits}
          else
            C2 := C2 + bcDigits[I]; {even digits}
        C2 := C2 * 3;

        C := 10 - ((C1 + C2) mod 10);
        if C = 10 then
          C := 0;
      end;
    bcCodabar :
      begin
        {get digits}
        bcDigitCount := GetDigits(St);

        C1 := 0;
        for I := 1 to bcDigitCount do
          C1 := C1 + bcDigits[I];

        C := 16 - (C1 mod 16);
        if C = 16 then
          C := 0;
      end;
    bcCode11 :
      begin
        {get digits}
        bcDigitCount := GetDigits(St);
        C1 := 0;
        for I := bcDigitCount downto 1 do
          C1 := C1 + bcDigits[I]*(bcDigitCount-I+1);
        C1 := C1 mod 11; {the "C" check character}
        C2 := C1;
        for I := bcDigitCount downto 1 do
          C2 := C2 + bcDigits[I]*(bcDigitCount-I+2);
        C2 := C2 mod 11; {the "K" check character}
        K := C2;
        C := C1;
      end;
    bcCode39 :
      begin
        {get digits}
        bcDigitCount := GetDigits(St);

        C1 := 0;
        for I := 1 to bcDigitCount do
          C1 := C1 + bcDigits[I];

        C := 43 - (C1 mod 43);
        if C = 43 then
          C := 0;
      end;
    bcCode93 :
      begin
        {get digits}
        bcDigitCount := GetDigits(St);
        C1 := 0;
        for I := bcDigitCount downto 1 do
          C1 := C1 + bcDigits[I]*(bcDigitCount-I+1);
        C1 := C1 mod 47; {the "C" check character}
        C2 := C1;
        for I := bcDigitCount downto 1 do
          C2 := C2 + bcDigits[I]*(bcDigitCount-I+2);
        C2 := C2 mod 47; {the "K" check character}
        K := C2;
        C := C1;
      end;
    bcCode128 :
      begin
        {get digits}
        bcDigitCount := GetDigits(St);

        C1 := bcDigits[1];
        for I := 2 to bcDigitCount do
          C1 := C1 + bcDigits[I]*(I-1);

        C := C1 mod 103;
        if C = 103 then
          C := 0;
      end;
  end;
end;

function TStBarCode.GetCode : string;
begin
  Result := Text;
end;

function TStBarCode.GetDigits(Characters : string) : Integer;

  procedure GetACode128CDigit (c : Char; var Index : Integer;
                               var bcDigitPos : Integer);
  var
    J : Integer;

  begin
    case (c) of
      #130     : bcDigits[bcDigitPos + 1] := 98;  {rest are manufactured characters}
      #131     : bcDigits[bcDigitPos + 1] := 97;
      #132     : bcDigits[bcDigitPos + 1] := 96;
      #133     : bcDigits[bcDigitPos + 1] := 98;
      #134     : bcDigits[bcDigitPos + 1] := 100;
      #135     : bcDigits[bcDigitPos + 1] := 99;
      #136     : bcDigits[bcDigitPos + 1] := 103;
      #137     : bcDigits[bcDigitPos + 1] := 104;
      #138     : bcDigits[bcDigitPos + 1] := 105;
      #139     : bcDigits[bcDigitPos + 1] := 106;
    else
      try
        J := StrToInt (Copy (Characters, Index, 2));
        bcDigits[bcDigitPos + 1] := J;
        Inc (Index);
      except
        RaiseStError(EStBarCodeError, stscInvalidCharacter);
      end;
    end;
    Inc (Index);
    Inc (bcDigitPos);
  end;

  procedure GetACode128ABDigit (c : Char; var Index : Integer;
                                var bcDigitPos : Integer);
  begin
    case c of
      ' '      : bcDigits[bcDigitPos + 1] := 0;
      '!'      : bcDigits[bcDigitPos + 1] := 1;
      '"'      : bcDigits[bcDigitPos + 1] := 2;
      '#'      : bcDigits[bcDigitPos + 1] := 3;
      '$'      : bcDigits[bcDigitPos + 1] := 4;
      '%'      : bcDigits[bcDigitPos + 1] := 5;
      '&'      : bcDigits[bcDigitPos + 1] := 6;
      ''''     : bcDigits[bcDigitPos + 1] := 7;
      '('      : bcDigits[bcDigitPos + 1] := 8;
      ')'      : bcDigits[bcDigitPos + 1] := 9;
      '*'      : bcDigits[bcDigitPos + 1] := 10;
      '+'      : bcDigits[bcDigitPos + 1] := 11;
      ','      : bcDigits[bcDigitPos + 1] := 12;
      '-'      : bcDigits[bcDigitPos + 1] := 13;
      '.'      : bcDigits[bcDigitPos + 1] := 14;
      '/'      : bcDigits[bcDigitPos + 1] := 15;
      '0'..'9' : bcDigits[bcDigitPos + 1] := 16 + Ord(c)-Ord('0');
      ':'      : bcDigits[bcDigitPos + 1] := 26;