rm_barcode.pas

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

{-----------------------------------------------------------------------------
 Unit Name: RM_barC2
 Author:    lz
 Email:     [e-mail]
 此代码献给所有喜欢编码的朋友，和我的最爱的huang xiao。
-----------------------------------------------------------------------------}

unit RM_BarCode;

interface

{$I RM.INC}

{$IFDEF TurboPower}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Math, StdCtrls, RM_Class, Buttons, ExtCtrls, ComCtrls,
  RM_Common, RM_Ctrls, RM_DsgCtrls
  , RM_StBarC, RM_St2DBarC //SysTools 4.0 incold
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
  {$IFDEF Delphi6}, Variants{$ENDIF};

const
  cbDefaultText = '12345678';

type

  TRMBarCodeAngleType = (rmatNone, rmat90, rmat180, rmat270);

  TRMBarCodeObject = class(TComponent) // fake component
  end;

  TRMBarCodeInfo = class(TPersistent)
  private
    FBarCode: TStBarCode;
    FRotationType: TRMBarCodeAngleType;

    function GetBarTextFont: TFont;
    procedure SetBarTextFont(Value: TFont);
    function GetAddCheckChar: Boolean;
    procedure SetAddCheckChar(Value: Boolean);
    function GetBarCodeType: TStBarCodeType;
    procedure SetBarCodeType(Value: TStBarCodeType);
    function GetBarColor: TColor;
    procedure SetBarColor(Value: TColor);
    function GetTallGuardBars: Boolean;
    procedure SetTallGuardBars(Value: Boolean);
    function GetSupplementalCode: string;
    procedure SetSupplementalCode(Value: string);
    function GetShowGuardChars: Boolean;
    procedure SetShowGuardChars(Value: Boolean);
    function GetShowCode: Boolean;
    procedure SetShowCode(Value: Boolean);
    function GetExtendedSyntax: Boolean;
    procedure SetExtendedSyntax(Value: Boolean);
    function GetBearerBars: Boolean;
    procedure SetBearerBars(Value: Boolean);
    function GetCode128Subset: TStCode128CodeSubset;
    procedure SetCode128Subset(Value: TStCode128CodeSubset);
    function GetBarWidth: Double;
    procedure SetBarWidth(Value: Double);
    function GetBarNarrowToWideRatio: Integer;
    procedure SetBarNarrowToWideRatio(Value: Integer);
    function GetBarToSpaceRatio: Double;
    procedure SetBarToSpaceRatio(Value: Double);
  public
    constructor Create(aBarCode: TStBarCode);
    destructor Destroy; override;
  published
    property BarTextFont: TFont read GetBarTextFont write SetBarTextFont;
    property RotationType: TRMBarCodeAngleType read FRotationType write FRotationType;
    property AddCheckChar: Boolean read GetAddCheckChar write SetAddCheckChar;
    property BarCodeType: TStBarCodeType read GetBarCodeType write SetBarCodeType;
    property BarColor: TColor read GetBarColor write SetBarColor;
    property TallGuardBars: Boolean read GetTallGuardBars write SetTallGuardBars;
    property SupplementalCode: string read GetSupplementalCode write SetSupplementalCode;
    property ShowGuardChars: Boolean read GetShowGuardChars write SetShowGuardChars;
    property ShowCode: Boolean read GetShowCode write SetShowCode;
    property ExtendedSyntax: Boolean read GetExtendedSyntax write SetExtendedSyntax;
    property BearerBars: Boolean read GetBearerBars write SetBearerBars;
    property Code128Subset: TStCode128CodeSubset read GetCode128Subset write SetCode128Subset;
    property BarToSpaceRatio: Double read GetBarToSpaceRatio write SetBarToSpaceRatio;
    property BarNarrowToWideRatio: Integer read GetBarNarrowToWideRatio write SetBarNarrowToWideRatio;
    property BarWidth: Double read GetBarWidth write SetBarWidth;
  end;

  { TRMBarCodeView }
  TRMBarCodeView = class(TRMReportView)
  private
    FBarCode: TStBarCode;
    FBarCodeInfo: TRMBarCodeInfo;

    function GetDirectDraw: Boolean;
    procedure SetDirectDraw(Value: Boolean);
  protected
    function GetViewCommon: string; override;
    procedure PlaceOnEndPage(aStream: TStream); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure Draw(aCanvas: TCanvas); override;

    procedure ShowEditor; override;
  published
    property LeftFrame;
    property TopFrame;
    property RightFrame;
    property BottomFrame;
    property FillColor;
    property DataField;
    //property BarCode: TStBarCode read FBarCode;
    property DirectDraw: Boolean read GetDirectDraw write SetDirectDraw;
    property PrintFrame;
    property Printable;
    property BarCodeInfo: TRMBarCodeInfo read FBarCodeInfo write FBarCodeInfo;
  end;

  TRM2DBarcodeType = (rmbtPDF417, rmbtMAXI);

  { TRM2DBarCodeView }
  TRM2DBarCodeView = class(TRMReportView)
  private
    FBarCodeType: TRM2DBarCodeType;
    FViewpdf417: TStPDF417Barcode;
    FViewMaxi: TStMaxiCodeBarcode;

    function GetDirectDraw: Boolean;
    procedure SetDirectDraw(Value: Boolean);
  protected
    function GetViewCommon: string; override;
    procedure PlaceOnEndPage(aStream: TStream); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure Draw(aCanvas: TCanvas); override;

    procedure ShowEditor; override;
    procedure DefinePopupMenu(aPopup: TRMCustomMenuItem); override;
  published
    property LeftFrame;
    property TopFrame;
    property RightFrame;
    property BottomFrame;
    property FillColor;
    property Memo;
    property BarCodeType: TRM2DBarCodeType read FBarCodeType write FBarCodeType;
    //    property PDF417Barcode: TStPDF417Barcode read FViewpdf417;
    property MaxiCodeBarcode: TStMaxiCodeBarcode read FViewMaxi;
    property DirectDraw: Boolean read GetDirectDraw write SetDirectDraw;
    property PrintFrame;
    property Printable;
  end;

  { TRMBar2CodeForm }
  TRM2DBarCodeForm = class(TForm)
    SaveDialog1: TSaveDialog;
    Panel3: TPanel;
    DBBtn: TSpeedButton;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    edtCode: TMemo;
    Choos2DType: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    btnOK: TButton;
    btnCancel: TButton;
    Panel1: TPanel;
    GroupBox2: TGroupBox;
    Label7: TLabel;
    cmbMaxiMode: TComboBox;
    Label10: TLabel;
    Edit2: TEdit;
    Edit4: TEdit;
    Label12: TLabel;
    Label11: TLabel;
    Edit3: TEdit;
    GroupBox4: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ComboBox1: TComboBox;
    GroupBox1: TGroupBox;
    Label13: TLabel;
    Label8: TLabel;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    Label9: TLabel;
    CheckBox2: TCheckBox;
    CheckBox5: TCheckBox;
    ComboBox2: TComboBox;
    ComboBox4: TComboBox;
    Edit1: TEdit;
    Edit5: TEdit;
    CheckBox1: TCheckBox;
    CheckBox3: TCheckBox;
    rb1: TRadioButton;
    rb2: TRadioButton;
    rb3: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DBBtnClick(Sender: TObject);
    procedure SpinEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpinEdit2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SpinEdit3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ComboBox2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure CheckBox2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure barcolorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure backgroundColorKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btnOKKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btnCancelKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure CheckBox2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Edit3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Edit4KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Choos2DTypeChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1DblClick(Sender: TObject);
    procedure edtCodeChange(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure CheckBox5KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SpinEdit1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure cmbMaxiModeChange(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure Edit5Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edtCodeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpeedButton2Click(Sender: TObject);
    procedure RB1Click(Sender: TObject);
    procedure rb2Click(Sender: TObject);
    procedure rb3Click(Sender: TObject);
  private
    { Private declarations }
    FPDF417: TStPDF417Barcode;
    FMaxi: TStMaxiCodeBarcode;
    FSpinEdit1, FSpinEdit2, FSpinEdit3: TRMSpinEdit;
    FBusy: Boolean;
    function Check2BarCode(S: ansistring): Boolean;
    procedure Localize;
    procedure ShowSample;
  public
    { Public declarations }
  end;

  {$ENDIF}
implementation

{$R *.dfm}

{$IFDEF TurboPower}

uses RM_Const, RM_Utils, RM_EditorBarCode;

const
  flBarcodeDirectDraw = $2;

procedure RotateWmf(AWmf, DestWmf: TMetaFile; const Angle: Double);
var
  d1, d2, d3, d4, d5, d6: Double;
  pXf: XFORM;
  liMetafile: TMetafile;
  liMetafileCanvas: TMetafileCanvas;
  R: TRect;

  function _CalAngle(PointX, PointY: Double): Double;
  var
    d1, d2, d3: Double;
  begin
    d1 := -PointX;
    d2 := -PointY;
    if d1 <> 0 then
    begin
      d3 := ArcTan(Abs(d2 / d1)) * 180 / PI;
      if (d2 > 0) and (d1 < 0) then
        d3 := 180 - d3
      else if (d2 <= 0) and (d1 < 0) then
        d3 := d3 + 180
      else if (d2 < 0) and (d1 > 0) then
        d3 := 360 - d3;
    end
    else
    begin
      if d2 > 0 then
        d3 := 90
      else if D2 < 0 then
        d3 := 270
      else
        d3 := -1;
    end;
    Result := d3;
  end;

begin
  if not Assigned(AWmf) or (Angle = 0) then
    Exit;
  if (AWmf.Width = 0) or (AWmf.Height = 0) then
    Exit;

  with pXf do
  begin
    d3 := -Angle * PI / 180;
    d1 := COS(d3);
    d2 := SIN(d3);

    eM11 := d1;
    eM12 := d2;
    eM21 := -d2;
    eM22 := d1;

    d4 := AWmf.Width / 2;
    d5 := AWmf.Height / 2;

    d3 := _CalAngle(d4, d5) - Angle;
    d3 := -d3 * PI / 180;

    d6 := sqrt(d4 * d4 + d5 * d5);
    d1 := COS(d3) * d6 + d4;
    d2 := -SIN(d3) * d6 + d5;

    eDx := d1;
    eDy := d2;
  end;

  liMetafile := TMetafile.Create;
  try
    R := Rect(0, 0, AWmf.Width, AWmf.Height);
    liMetafile.Width := AWmf.Width;
    liMetafile.Height := AWmf.Height;

    liMetafileCanvas := TMetafileCanvas.Create(liMetafile, 0);
    try
      SetGraphicsMode(AWmf.Handle, GM_COMPATIBLE);
      SetGraphicsMode(liMetafileCanvas.Handle, GM_ADVANCED);
      SetWorldTransform(liMetafileCanvas.Handle, pXf);
      PlayEnhMetaFile(liMetafileCanvas.Handle, AWmf.Handle, R);
    finally
      liMetafileCanvas.Free;
    end;

    DestWmf.Clear;
    DestWmf.Assign(liMetafile);
  finally
    liMetafile.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMBarCodeInfo }

constructor TRMBarCodeInfo.Create(aBarCode: TStBarCode);
begin
  inherited Create;

  FRotationType := rmatNone;
  FBarCode := aBarCode;
end;

destructor TRMBarCodeInfo.Destroy;
begin
  inherited;
end;

function TRMBarCodeInfo.GetBarTextFont: TFont;
begin
  Result := FBarCode.Font;
end;

procedure TRMBarCodeInfo.SetBarTextFont(Value: TFont);
begin
  FBarCode.Font.Assign(Value);
end;

function TRMBarCodeInfo.GetAddCheckChar: Boolean;
begin
  Result := FBarCode.AddCheckChar;
end;

procedure TRMBarCodeInfo.SetAddCheckChar(Value: Boolean);
begin
  FBarCode.AddCheckChar := Value;
end;

function TRMBarCodeInfo.GetBarCodeType: TStBarCodeType;
begin
  Result := FBarCode.BarCodeType;
end;

procedure TRMBarCodeInfo.SetBarCodeType(Value: TStBarCodeType);
begin
  FBarCode.BarCodeType := Value;
end;

function TRMBarCodeInfo.GetBarColor: TColor;
begin
  Result := FBarCode.BarColor;
end;

procedure TRMBarCodeInfo.SetBarColor(Value: TColor);
begin
  FBarCode.BarColor := Value;
end;

function TRMBarCodeInfo.GetTallGuardBars: Boolean;
begin
  Result := FBarCode.TallGuardBars;
end;

procedure TRMBarCodeInfo.SetTallGuardBars(Value: Boolean);
begin
  FBarCode.TallGuardBars := Value;
end;