rm_barcode.pas

pdf47 、maxi code二维....delphi生成源代码,非常有用 !

function TRMBarCodeInfo.GetSupplementalCode: string;
begin
  Result := FBarCode.SupplementalCode;
end;

procedure TRMBarCodeInfo.SetSupplementalCode(Value: string);
begin
  FBarCode.SupplementalCode := Value;
end;

function TRMBarCodeInfo.GetShowGuardChars: Boolean;
begin
  Result := FBarCode.ShowGuardChars;
end;

procedure TRMBarCodeInfo.SetShowGuardChars(Value: Boolean);
begin
  FBarCode.ShowGuardChars := Value;
end;

function TRMBarCodeInfo.GetShowCode: Boolean;
begin
  Result := FBarCode.ShowCode;
end;

procedure TRMBarCodeInfo.SetShowCode(Value: Boolean);
begin
  FBarCode.ShowCode := Value;
end;

function TRMBarCodeInfo.GetExtendedSyntax: Boolean;
begin
  Result := FBarCode.ExtendedSyntax;
end;

procedure TRMBarCodeInfo.SetExtendedSyntax(Value: Boolean);
begin
  FBarCode.ExtendedSyntax := Value;
end;

function TRMBarCodeInfo.GetBearerBars: Boolean;
begin
  Result := FBarCode.BearerBars;
end;

procedure TRMBarCodeInfo.SetBearerBars(Value: Boolean);
begin
  FBarCode.BearerBars := Value;
end;

function TRMBarCodeInfo.GetCode128Subset: TStCode128CodeSubset;
begin
  Result := FBarCode.Code128Subset;
end;

procedure TRMBarCodeInfo.SetCode128Subset(Value: TStCode128CodeSubset);
begin
  FBarCode.Code128Subset := Value;
end;

function TRMBarCodeInfo.GetBarWidth: Double;
begin
  Result := FBarCode.BarWidth;
end;

procedure TRMBarCodeInfo.SetBarWidth(Value: Double);
begin
  FBarCode.BarWidth := Value;
end;

function TRMBarCodeInfo.GetBarNarrowToWideRatio: Integer;
begin
  Result := FBarCode.BarNarrowToWideRatio;
end;

procedure TRMBarCodeInfo.SetBarNarrowToWideRatio(Value: Integer);
begin
  FBarCode.BarNarrowToWideRatio := Value;
end;

function TRMBarCodeInfo.GetBarToSpaceRatio: Double;
begin
  Result := FBarCode.BarToSpaceRatio;
end;

procedure TRMBarCodeInfo.SetBarToSpaceRatio(Value: Double);
begin
  FBarCode.BarToSpaceRatio := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMBarCodeView }

type
  THackBarCode = class(TStBarCode)
  end;

constructor TRMBarCodeView.Create;
begin
  inherited Create;
  BaseName := 'BarCode';

  FBarCode := TStBarCode.Create(nil);
  FBarCodeInfo := TRMBarCodeInfo.Create(FBarCode);
end;

destructor TRMBarCodeView.Destroy;
begin
  FreeAndNil(FBarCodeInfo);
  FreeAndNil(FBarCode);

  inherited Destroy;
end;

procedure TRMBarCodeView.Draw(aCanvas: TCanvas);
var
  liCodeStr: string;
  EMF, liEmf1: TMetafile;
  EMFCanvas: TMetafileCanvas;
begin
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);

  if (Memo1.Count > 0) and (Length(Memo1[0]) > 0) and
    ((FBarCode.BarCodeType in [bcCode39, bcCode128, bcCodabar]) or RMisNumeric(Memo1[0])) then
    liCodeStr := Memo1[0]
  else
    liCodeStr := cbDefaultText;

  try
    FBarCode.Code := liCodeStr;
  except
    FBarCode.Code := cbDefaultText;
  end;

  EMF := TMetafile.Create;
  EMF.Width := spWidth;
  EMF.Height := spHeight;
  EMFCanvas := TMetafileCanvas.Create(EMF, 0);
  FBarCode.PaintToCanvas(EMFCanvas, Rect(0, 0, spWidth, spHeight));

  EMFCanvas.Free;

  CalcGaps;

  liEmf1 := nil;
  ShowBackground;
  IntersectClipRect(aCanvas.Handle, RealRect.Left, RealRect.Top, RealRect.Right, RealRect.Bottom);
  try
    case FBarCodeInfo.RotationType of
      rmatNone:
        begin
          RMPrintGraphic(aCanvas, RealRect, emf, IsPrinting, DirectDraw, False);
          //          aCanvas.StretchDraw(RealRect, EMF);
        end;
      rmat90:
        begin
          liEMF1 := TMetafile.Create;
          liEMF1.Width := spWidth;
          liEMF1.Height := spHeight;
          RotateWmf(emf, liEmf1, 90);
          RMPrintGraphic(aCanvas, RealRect, liEmf1, IsPrinting, DirectDraw, False);
          aCanvas.StretchDraw(RealRect, liEmf1);
        end;
      rmat180:
        begin
          liEMF1 := TMetafile.Create;
          liEMF1.Width := spWidth;
          liEMF1.Height := spHeight;
          RotateWmf(emf, liEmf1, 180);
          RMPrintGraphic(aCanvas, RealRect, liEmf1, IsPrinting, DirectDraw, False);
          //          aCanvas.StretchDraw(RealRect, liEmf1);
        end;
      rmat270:
        begin
          liEMF1 := TMetafile.Create;
          liEMF1.Width := spWidth;
          liEMF1.Height := spHeight;
          RotateWmf(emf, liEmf1, 270);
          RMPrintGraphic(aCanvas, RealRect, liEmf1, IsPrinting, DirectDraw, False);
          //          aCanvas.StretchDraw(RealRect, liEmf1);
        end;
    end;
  finally
    Windows.SelectClipRgn(aCanvas.Handle, 0);
  end;
  liEmf1.Free;
  EMF.Free;

  ShowFrame;
  RestoreCoord;
end;

procedure TRMBarCodeView.PlaceOnEndPage(aStream: TStream);
begin
  inherited;
end;

procedure TRMBarCodeView.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FBarCodeInfo.RotationType := TRMBarCodeAngleType(RMReadByte(aStream));
  RMReadFont(aStream, FBarCode.Font);
  FBarCode.AddCheckChar := RMReadBoolean(aStream);
  FBarCode.BarCodeType := TStBarCodeType(RMReadByte(aStream));
  FBarCode.BarColor := RMReadInt32(aStream);
  FBarCode.BarToSpaceRatio := RMReadInt32(aStream) / 1000;
  FBarCode.BarNarrowToWideRatio := RMReadInt32(aStream);
  FBarCode.BarWidth := RMReadInt32(aStream) / 1000;
  FBarCode.BearerBars := RMReadBoolean(aStream);
  FBarCode.Code128Subset := TStCode128CodeSubset(RMReadByte(aStream));
  FBarCode.ExtendedSyntax := RMReadBoolean(aStream);
  FBarCode.ShowCode := RMReadBoolean(aStream);
  FBarCode.ShowGuardChars := RMReadBoolean(aStream);
  FBarCode.SupplementalCode := RMReadString(aStream);
  FBarCode.TallGuardBars := RMReadBoolean(aStream);
end;

procedure TRMBarCodeView.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0); // 版本号
  RMWriteByte(aStream, Byte(FBarCodeInfo.RotationType));
  RMWriteFont(aStream, FBarCode.Font);
  RMWriteBoolean(aStream, FBarCode.AddCheckChar);
  RMWriteByte(aStream, Byte(FBarCode.BarCodeType));
  RMWriteInt32(aStream, FBarCode.BarColor);
  RMWriteInt32(aStream, Round(FBarCode.BarToSpaceRatio * 1000));
  RMWriteInt32(aStream, FBarCode.BarNarrowToWideRatio);
  RMWriteInt32(aStream, Round(FBarCode.BarWidth * 1000));
  RMWriteBoolean(aStream, FBarCode.BearerBars);
  RMWriteByte(aStream, Byte(FBarCode.Code128Subset));
  RMWriteBoolean(aStream, FBarCode.ExtendedSyntax);
  RMWriteBoolean(aStream, FBarCode.ShowCode);
  RMWriteBoolean(aStream, FBarCode.ShowGuardChars);
  RMWriteString(aStream, FBarCode.SupplementalCode);
  RMWriteBoolean(aStream, FBarCode.TallGuardBars);
end;

procedure TRMBarCodeView.ShowEditor;
var
  tmp: TRMBarcodeForm;
begin
  tmp := TRMBarcodeForm.Create(nil);
  try
    tmp.edtCode.Text := cbDefaultText;
    tmp.cmbTypes.ItemIndex := ord(FBarCode.BarCodeType);
    tmp.chkAddCheckChar.Checked := FBarCode.AddCheckChar;
    tmp.eZoom.Text := FloatToStr(FBarCode.BarToSpaceRatio);
    tmp.chkViewText.Checked := FBarCode.ShowCode;
    tmp.chkTallGuardBars.Checked := FBarCode.TallGuardBars;
    if Memo.Count > 0 then
      tmp.edtCode.Text := Memo.Strings[0];
    if tmp.ShowModal = mrOk then
    begin
      RMDesigner.BeforeChange;
      Memo.Clear;
      Memo.Add(tmp.edtCode.Text);
      FBarCode.BarCodeType := TStBarCodeType(tmp.cmbTypes.ItemIndex);
      FBarCode.AddCheckChar := tmp.chkAddCheckChar.Checked;
      FBarCode.BarToSpaceRatio := StrToFloat(tmp.eZoom.Text);
      FBarCode.ShowCode := tmp.chkViewText.Checked;
      FBarCode.TallGuardBars := tmp.chkTallGuardBars.Checked;
    end;
  finally
    tmp.Free;
  end;
end;

function TRMBarCodeView.GetDirectDraw: Boolean;
begin
  Result := (FFlags and flBarCodeDirectDraw) = flBarCodeDirectDraw;
end;

procedure TRMBarCodeView.SetDirectDraw(Value: Boolean);
begin
  FFlags := (FFlags and not flBarCodeDirectDraw);
  if Value then
    FFlags := FFlags + flBarCodeDirectDraw;
end;

function TRMBarCodeView.GetViewCommon: string;
begin
  Result := '[BarCode]';
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRM2DBarCodeView }

constructor TRM2DBarCodeView.Create;
begin
  inherited Create;
  BaseName := 'BarCode2D';

  FBarCodeType := rmbtPDF417;

  FViewpdf417 := TStPDF417Barcode.Create(nil);
  FViewMaxi := TStMaxiCodeBarcode.Create(nil); //121 * 121
  FillColor := clWhite;
  spHeight := 80;
  spWidth := 300;
end;

destructor TRM2DBarCodeView.Destroy;
begin
  FViewpdf417.Free;
  FViewMaxi.Free;
  inherited Destroy;
end;

type
  THack2dBarCode = class(TStCustom2DBarcode)
  end;

procedure TRM2DBarCodeView.Draw(aCanvas: TCanvas);
var
  liBarCodeStr: string;
  liEmf: TMetafile;
  liEmfCanvas: TMetafileCanvas;
  Fixcolor: Tcolor;
begin
  //  spHeight := Param.cheight + 4;
  //  spWidth := Param.cwidth + 4;
  Fixcolor := clWhite; // $00F8F8F8; //248 248 248 2003-3-25
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);
  if Memo1.Count > 0 then
  begin
    liBarCodeStr := Memo1.Text;
    if liBarCodeStr <> '' then
      SetLength(liBarCodeStr, Length(liBarCodeStr) - 2);
  end
  else
    liBarCodeStr := '';

  liEmf := TMetafile.Create;
  liEmf.Width := spWidth;
  liEmf.Height := spHeight;
  liEmfCanvas := TMetafileCanvas.Create(liEmf, 0);

  if FBarCodeType = rmbtpdf417 then
  begin
    FViewpdf417.code := liBarCodeStr;
    FViewpdf417.SetBounds(0, 0, spWidth, spHeight);
    THack2dBarCode(FViewpdf417).GenerateBarcodeBitmap(spWidth, spHeight);
    with FViewpdf417 do
    begin
      liEMFCanvas.Brush.Color := FillColor;
      liEMFCanvas.Brushcopy(Rect(0, 0, Bitmap.Width, Bitmap.Height), Bitmap,
        Rect(0, 0, Bitmap.Width, Bitmap.Height), Fixcolor);
    end;
  end
  else
  begin
    FViewMaxi.Code := liBarCodeStr;
    FViewMaxi.SetBounds(0, 0, spWidth, spHeight);
    THack2dBarCode(FViewMaxi).GenerateBarcodeBitmap(spWidth, spHeight);
    with FViewMaxi do
    begin
      liEMFCanvas.Brush.Color := FillColor;
      liEMFCanvas.Brushcopy(Rect(0, 0, Bitmap.Width, Bitmap.Height), Bitmap,
        Rect(0, 0, Bitmap.Width, Bitmap.Height), Fixcolor);
    end;
  end;

  liEmfCanvas.Free;
  CalcGaps;

  ShowBackground;
  IntersectClipRect(aCanvas.Handle, RealRect.Left, RealRect.Top, RealRect.Right, RealRect.Bottom);
  try
    RMPrintGraphic(aCanvas, RealRect, liEmf, IsPrinting, DirectDraw, False);
    //    aCanvas.StretchDraw(RealRect, liEMF);
  finally
    Windows.SelectClipRgn(aCanvas.Handle, 0);
  end;
  liEMF.Free;

  ShowFrame;
  RestoreCoord;
end;

procedure TRM2DBarCodeView.PlaceOnEndPage(aStream: TStream);
begin
  inherited;
end;

procedure TRM2DBarCodeView.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FBarCodeType := TRM2DBarCodeType(RMReadByte(aStream));
  if FBarCodeType = rmbtpdf417 then
  begin
    FViewpdf417.ECCLevel := TStPDF417ECCLevels(RMReadByte(aStream));
    FViewpdf417.NumColumns := RMReadInt32(aStream);
    FViewpdf417.NumRows := RMReadInt32(aStream);
    FViewpdf417.Truncated := RMReadBoolean(aStream);

    FViewpdf417.BarHeight := RMReadInt32(aStream);
    FViewpdf417.BarHeightToWidth := RMReadInt32(aStream);
    FViewpdf417.BarWidth := RMReadInt32(aStream);
    FViewpdf417.CaptionLayout := TTextLayout(RMReadByte(aStream));
    FViewpdf417.ExtendedSyntax := RMReadBoolean(aStream);
    FViewpdf417.RelativeBarHeight := RMReadBoolean(aStream);
    FViewpdf417.QuietZone := RMReadInt32(aStream);
    FViewpdf417.Caption := RMReadString(aStream);
    RMReadFont(aStream, FViewpdf417.Font);
  end
  else if FBarCodeType = rmbtMAXI then
  begin
    FViewMaxi.AutoScale := RMReadBoolean(aStream);
    FViewMaxi.CarrierCountryCode := RMReadInt32(aStream);
    FViewMaxi.CarrierPostalCode := RMReadString(aStream);
    FViewMaxi.CarrierServiceClass := RMReadInt32(aStream);
    FViewMaxi.HorPixelsPerMM := RMReadInt32(aStream) / 1000;
    FViewMaxi.Mode := TStMaxiCodeMode(RMReadByte(aStream));
    FViewMaxi.VerPixelsPerMM := RMReadInt32(aStream) / 1000;

    FViewMaxi.BarHeight := RMReadInt32(aStream);
    FViewMaxi.BarHeightToWidth := RMReadInt32(aStream);
    FViewMaxi.BarWidth := RMReadInt32(aStream);
    FViewMaxi.CaptionLayout := TTextLayout(RMReadByte(aStream));
    FViewMaxi.ExtendedSyntax := RMReadBoolean(aStream);
    FViewMaxi.RelativeBarHeight := RMReadBoolean(aStream);
    FViewMaxi.QuietZone := RMReadInt32(aStream);
    FViewMaxi.Caption := RMReadString(aStream);
    RMReadFont(aStream, FViewMaxi.Font);
  end;
end;

procedure TRM2DBarCodeView.SaveToStream(aStream: TStream);
begin