rm_st2dbarc.pas

这是一个功能强大

     { csCodeSetD }
      {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
     (-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {000}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {010}
      -1, -1, -1, -1, -1, -1, -1, -1, 28, 29, {020}
      30, -1, 59, -1, -1, -1, -1, -1, -1, -1, {030}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {040}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {050}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {060}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {070}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {080}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {090}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {100}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {110}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {120}
      -1, -1, -1, -1, -1, -1, -1, -1, 47, 48, {130}
      49, 50, 51, 52, 53, 54, 55, 56, 57, -1, {140}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {150}
      -1, 37, -1, -1, -1, -1, -1, -1, 38, -1, {160}
      -1, 39, -1, -1, -1, 40, 41, -1, -1, -1, {170}
      42, -1, -1, 43, 44, -1, -1, 45, -1, -1, {180}
      -1, 46, -1, -1, -1, -1, -1, -1, -1, -1, {190}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {200}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {210}
      -1, -1, -1, -1,  0,  1,  2,  3,  4,  5, {220}
       6,  7,  8,  9, 10, 11, 12, 13, 14, 15, {230}
      16, 17, 18, 19, 20, 21, 22, 23, 24, 25, {240}
      26, 32, 33, 34, 35, 36),                {250}
     { csCodeSetE }
      {0} {1} {2} {3} {4} {5} {6} {7} {8} {9}
     ( 0,  1,  2,  3,  4,  5,  6,  7,  8,  9, {000}
      10, 11, 12, 13, 14, 15, 16, 17, 18, 19, {010}
      20, 21, 22, 23, 24, 25, 26, 30, 32, 33, {020}
      34, 35, 59, -1, -1, -1, -1, -1, -1, -1, {030}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {040}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {050}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {060}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {070}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {080}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {090}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {100}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {110}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {120}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {130}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, 48, {140}
      49, 50, 51, 52, 53, 54, 55, 56, 57, 36, {150}
      37, -1, 38, 39, 40, 41, 42, 43, -1, 44, {160}
      -1, -1, -1, 45, 46, -1, -1, -1, -1, -1, {170}
      -1, -1, 47, -1, -1, -1, -1, -1, -1, -1, {180}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {190}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {200}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {210}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {220}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {230}
      -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, {240}
      -1, -1, -1, -1, -1, -1));               {250}

{ TStCustom2DBarcode }

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

  FBitmap := TBitmap.Create;

  FBarWidth          := 2;
  FBarHeight         := 0;
  FBackgroundColor   := clWhite;
  FExtendedSyntax    := True;
  FQuietZone         := 8;
  FAlignment         := taCenter;
  FCaptionLayout     := tlBottom;
  Width              := 329;
  Height             := 50;
  Color              := clBlack;
  FECCLevel          := 2;
  FRelativeBarHeight := False;
  FBarHeightToWidth  := 4;
  FBarHeight         := 2;
  FCaption           := '';
  FCode              := '';
  FECCLevel          := 0;
end;

destructor TStCustom2DBarcode.Destroy;
begin
  FBitmap.Free;

  inherited Destroy;
end;

procedure TStCustom2DBarcode.CopyToClipboard;
begin
  CopyToClipboardRes (0, 0);
end;

procedure TStCustom2DBarcode.CopyToClipboardRes (ResX : Integer;
                                                 ResY : Integer);
var
  MetaFile       : TMetaFile;
  MetaFileCanvas : TMetaFileCanvas;
  RenderBMP      : TBitmap;
  SizeX          : Integer;
  SizeY          : Integer;

begin
  Clipboard.Clear;
  Clipboard.Open;
  try
    RenderBmp := TBitmap.Create;
    try
      RenderToResolution (RenderBmp, ResX, ResY, SizeX, SizeY);
      Clipboard.Assign (RenderBmp);

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

procedure TStCustom2DBarcode.GenerateBarcodeBitmap (BCWidth  : Integer;
                                                    BCHeight : Integer);
var
  TextHeight    : Integer;
  TextWidth     : Integer;
  XPos          : Integer;
  YPos          : Integer;
  TopOffset     : Integer;
  BottomOffset  : Integer;
  BarCodeHeight : Integer;
  BarCodeWidth  : Integer;
  RWidthOffset  : Integer;
  LWidthOffset  : Integer;
  PaintHeight   : Integer;

begin
  { Initialize the canvas }
  FBitmap.Width := BCWidth;
  FBitmap.Height := BCHeight;
  FBitmap.Canvas.Pen.Color := Color;
  FBitmap.Canvas.Brush.Color := BackgroundColor;
  FBitmap.Canvas.FillRect (Rect (0, 0, BCWidth, BCHeight));
  FBitmap.Canvas.Brush.Color := Color;

  { Calculate the size of the caption }
  FBitmap.Canvas.Font.Assign (Font);
  TextHeight := FBitmap.Canvas.TextHeight ('Yg0');
  TextWidth := FBitmap.Canvas.TextWidth (Caption);

  { determine x position of the caption }
  XPos := 0;
  case FAlignment of
    taLeftJustify :
      XPos := 0;
    taRightJustify :
      if BCWidth - TextWidth > 0 then
        XPos := BCWidth - TextWidth
      else
        XPos := 0;
    taCenter :
      if BCWidth - TextWidth > 0 then
        XPos := BCWidth div 2 - TextWidth div 2
      else
        XPos := 0;
  end;

  { determine the y position of the caption.  In addition, determine offsets
    for the barcode painting. }
  TopOffset := 0;
  BottomOffset := 0;
  YPos := 0;
  case FCaptionLayout of
    tlBottom :
      begin
        if BCHeight - 2 - TextHeight > 0 then
          YPos := BCHeight - 2 - TextHeight
        else
          YPos := 0;
        if Caption <> '' then
          BottomOffset := TextHeight + 4;
      end;
    tlTop :
      begin
        YPos := 0;
        if Caption <> '' then
          TopOffset := TextHeight + 4;
      end;
    tlCenter :
      if BCHeight - TextHeight > 0 then
        YPos := BCHeight div 2 - TextHeight div 2
      else
        YPos := 0;
  end;

  { determine the size of the barcode and calculate the rectangle the
    barcode should be painted in.  Take into account the size of the
    caption (and it's existance), and the quiet zone.}
  PaintHeight := BCHeight - QuietZone * 2 - BottomOffset - TopOffset;
  BarCodeHeight := CalculateBarCodeHeight (PaintHeight);
  BarCodeWidth := CalculateBarCodeWidth (BCWidth);
  if BarCodeHeight < PaintHeight then begin
    Inc (BottomOffset, (PaintHeight - BarCodeHeight) div 2);
    Inc (TopOffset, (PaintHeight - BarCodeHeight) div 2);
  end;

  { Position the barcode horizontally }
  LWidthOffset := QuietZone;
  RWidthOffset := QuietZone;
  if BarCodeWidth < BCWidth - QuietZone * 2 then
    case Alignment of
      taLeftJustify :
        begin
          LWidthOffset := QuietZone;
          RWidthOffset := BCWidth - BarCodeWidth - QuietZone;
        end;
      taRightJustify :
        begin
          RWidthOffset := QuietZone;
          LWidthOffset := BCWidth - BarCodeWidth - QuietZone;
        end;
      taCenter :
        begin
          LWidthOffset := (BCWidth - BarCodeWidth) div 2;
          RWidthOffset := (BCWidth - BarCodeWidth) div 2;
        end;
    end;

  { Save the barcode rectangle }
  FBarCodeRect := Rect (LWidthOffset,
                        QuietZone + TopOffset,