二维码编程

二维码编程 {----------------------------------------------------------------------------- Unit Name: RM_barC2 Author: lz Email: SinMax@163.net 此代码献给所有喜欢编码的朋友，和我的最爱的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; 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));