rm_st2dbarc.pas

这是一个功能强大

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: St2DBarC.pas 4.03                           *}
{*********************************************************}
{* SysTools: Two-Dimensional Barcodes                    *}
{*********************************************************}

{$I RM_StDefine.inc}

unit RM_St2DBarC;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Controls,
  Graphics,
  StdCtrls,
  Math,
  ClipBrd,
  RM_StConst;

resourcestring

  StEBadBarHeight        = 'Bar Height cannot be less than one';
  StEBadBarHeightToWidth = 'BarHeightToWidth cannot be less than one';
  StEBadBarWidth         = 'Bar Width cannot be less than one';
  StEBadCountryCode      = 'Invalid Country Code';
  StEBadNumCols          = 'Invalid Number of columns';
  StEBadNumRows          = 'Invalid number of rows';
  StEBadPostalCode       = 'Invalid Postal Code';
  StEBadServiceClass     = 'Invalid Service Class';
  StEBadQuietZone        = 'Invalid Quiet Zone';
  StECodeTooLarge        = 'Code too large for barcode';
  StEGLIOutOfRange       = 'GLI value out of range';
  StEInvalidCodeword     = 'Invalid Codeword';
  StENeedBarHeight       = 'Either BarHeight or BarHeightToWidth is required';
  StENeedHorz            = 'Horizontal size needs to be specified';
  StENeedVert            = 'Vertical size needs to be specified';

type
  { Generic 2D barcode types and constants }

  TStDataMode = (dmBinary, dmText, dmNumeric);

  { PDF417 types and constants }

  TStPDF417CodewordList = array [0..2700] of Word;
  TStPDF417ECCLevels = (ecAuto, ecLevel0, ecLevel1, ecLevel2, ecLevel3,
                        ecLevel4, ecLevel5, ecLevel6, ecLevel7, ecLevel8);

  { MaxiCode types and constants }

  TStMaxiCodeMode = (cmMode2, cmMode3, cmMode4, cmMode5, cmMode6);

const
  StMaxiCodeGaloisField    = 64;  { Galois field to work in }
  StMaxiCodeECCPoly        = 67;  { Primary polynomial - }
  StMaxMaxiCodeECCDataSize = 144; { Max amount of data }

type
  TStMaxiCodeECCData = array [0..StMaxMaxiCodeECCDataSize] of Byte;
  TStMaxiCodeECCPoly = (epPrimary, epStandard, epEnhanced);
  TStMaxiCodeECCInterleave = (imNone, imEven, imOdd);

  { E2DBarcodeError }

  E2DBarcodeError = class (Exception);

  { TStCustom2DBarcode }

  TStCustom2DBarcode = class (TGraphicControl)
    protected { private }
      FCode              : string;
      FBarWidth          : Integer;
      FBackgroundColor   : TColor;
      FCaption           : string;
      FECCLevel          : Integer;
      FExtendedSyntax    : Boolean;
      FRelativeBarHeight : Boolean;
      FBarHeightToWidth  : Integer;
      FBarHeight         : Integer;

      FQuietZone         : Integer;
      FAlignment         : TAlignment;
      FCaptionLayout     : TTextLayout;
      FBarCodeRect       : TRect;
      FUsedCodewords     : Integer;
      FFreeCodewords     : Integer;
      FUsedECCCodewords  : Integer;
      FTotalCodewords    : Integer;

    { protected }
      FBitmap            : TBitmap;

      function  CalculateBarCodeWidth (PaintableWidth : Integer) : Integer;
                virtual; abstract;
      function  CalculateBarCodeHeight (PaintableHeight : Integer) : Integer;
                virtual; abstract;
      procedure DrawBarcode; virtual; abstract;
      procedure GenerateBarcodeBitmap (BCWidth  : Integer;
                                       BCHeight : Integer);
      procedure GenerateCodewords; virtual; abstract;
      function  GetBarCodeHeight : Integer;
      function  GetBarCodeWidth : Integer;
      procedure GetCurrentResolution (var ResX : Integer; var ResY : Integer);
      function GetVersion : string;
      procedure Paint; override;
      procedure SetAlignment (const v : TAlignment);
      procedure SetBackgroundColor (const v : TColor);
      procedure SetBarHeight (const v : Integer); virtual;
      procedure SetBarHeightToWidth (const v : Integer); virtual;
      procedure SetBarWidth (const v : Integer); virtual;
      procedure SetBitmap (const v : TBitmap);
      procedure SetCaption (const v : string);
      procedure SetCaptionLayout (const v : TTextLayout);
      procedure SetCode (const v : string);
      procedure SetECCLevel (const v : Integer);
      procedure SetExtendedSyntax (const v : Boolean);
      procedure SetRelativeBarHeight (const v : Boolean); virtual;
      procedure SetQuietZone (const v : Integer);
      procedure SetVersion(const Value : string);

    public
      constructor Create (AOwner : TComponent); override;
      destructor Destroy; override;

      procedure CopyToClipboard;
      procedure CopyToClipboardRes (ResX : Integer; ResY : Integer);
      procedure PaintToCanvas (ACanvas : TCanvas; Position : TPoint);
      procedure PaintToCanvasRes (ACanvas : TCanvas; Position : TPoint;
                                  ResX : Integer; ResY : Integer);
      procedure PaintToCanvasSize (ACanvas : TCanvas; X, Y, H : Double);
      procedure PaintToDC (DC : hDC; Position : TPoint);
      procedure PaintToDCRes (DC : hDC; Position : TPoint;
                              ResX : Integer; ResY : Integer);
      procedure PaintToPrinterCanvas (ACanvas : TCanvas; Position : TPoint);
      procedure PaintToPrinterCanvasRes (ACanvas : TCanvas; Position : TPoint;
                                         ResX : Integer; ResY : Integer);
      procedure PaintToPrinterCanvasSize (ACanvas : TCanvas; X, Y, H : Double);
      procedure PaintToPrinterDC (DC : hDC; Position : TPoint);
      procedure PaintToPrinterDCRes (DC : hDC; Position : TPoint;
                                     ResX : Integer; ResY : Integer);                                     
      procedure RenderToResolution (var OutBitmap : TBitmap;
                                    ResX : Integer;
                                    ResY : Integer;
                                    var SizeX : Integer;
                                    var SizeY : Integer); virtual; abstract;
      procedure SaveToFile (const FileName : string);
      procedure SaveToFileRes (const FileName : string;
                               ResX : Integer; ResY : Integer);

      property Alignment : TAlignment read FAlignment write SetAlignment
               default taCenter;
      property BackgroundColor : TColor
               read FBackgroundColor write SetBackgroundColor default clWhite;
      property BarCodeHeight : Integer read GetBarCodeHeight;
      property BarCodeRect : TRect read FBarCodeRect;
      property BarCodeWidth : Integer read GetBarCodeWidth;
      property BarHeight : Integer read FBarHeight write SetBarHeight
               default 2;
      property BarHeightToWidth : Integer
               read FBarHeightToWidth write SetBarHeightToWidth default 4;
      property BarWidth : Integer read FBarWidth write SetBarWidth default 2;
      property Bitmap : TBitmap read FBitmap write SetBitmap stored False;
      property Caption : string read FCaption write SetCaption;
      property CaptionLayout : TTextLayout
               read FCaptionLayout write SetCaptionLayout
               default tlBottom;
      property Code : string read FCode write SetCode;
      property ECCLevel : Integer read FECCLevel write SetECCLevel default 0;
      property ExtendedSyntax : Boolean
               read FExtendedSyntax write SetExtendedSyntax default True;
      property FreeCodewords : Integer read FFreeCodewords;
      property RelativeBarHeight : Boolean
               read FRelativeBarHeight write SetRelativeBarHeight
               default False;
      property QuietZone : Integer read FQuietZone write SetQuietZone
               default 8;
      property TotalCodewords : Integer read FTotalCodewords;
      property UsedCodewords : Integer read FUsedCodewords;
      property UsedECCCodewords : Integer read FUsedECCCodewords;

      property Color default clBlack;

    published
      property Version : string read GetVersion write SetVersion stored False;
    
      { Properties }
      property Align;
      property Cursor;
      property Enabled;
      property Font;
      property ParentColor;
      property ParentFont;
      property ParentShowHint;
      property ShowHint;
      property Visible;

      { Events }
      property OnClick;
      property OnDblClick;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
  end;

  { TStPDF417Barcode }

  TStPDF417Barcode = class (TStCustom2DBarcode)
    private
      FTruncated       : Boolean;
      FCodewords       : TStPDF417CodewordList;
      FNumCodewords    : Integer;
      FNewTextCodeword : Boolean;
      FHighlight       : Boolean;
      FNumRows         : Integer;
      FNumColumns      : Integer;

    protected
      procedure AddCodeword (Value : Word);
      function  CalculateBarCodeWidth (PaintableWidth : Integer) : Integer;
                override;
      function  CalculateBarCodeHeight (PaintableHeight : Integer) : Integer;
                override;
      procedure CalculateECC (NumCodewords : Integer; ECCLen : Integer);