stbarc.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** 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: StBarC.pas 4.03                             *}
{*********************************************************}
{* SysTools: bar code components                         *}
{*********************************************************}

{$I StDefine.inc}

unit StBarC;

interface

uses
  Windows,
  Classes, ClipBrd, Controls, Graphics, Messages, SysUtils,
  StBase, StConst;

const
  {.Z+}
  bcMaxBarCodeLen = 255;
  bcGuardBarAbove = True;
  bcGuardBarBelow = True;
  bcDefNarrowToWideRatio = 2;
  {.Z-}

type
  TStBarKind = (bkSpace, bkBar, bkThreeQuarterBar, bkHalfBar, bkGuard, bkSupplement, bkBlankSpace);
  {.Z+}
  TStBarKindSet = set of TStBarKind;
  TStDigitArray = array[1..bcMaxBarCodeLen] of Byte;
  {.Z-}

  {.Z+}
  TStBarData = class
    FKind    : TStBarKindSet;
    FModules : Integer;
  public
    property Kind : TStBarKindSet
      read FKind
      write FKind;
    property Modules : Integer
      read FModules
      write FModules;
  end;
  {.Z-}

  {.Z+}
  TStBarCodeInfo = class
  private
    FBars       : TList;

    function GetBars(Index : Integer) : TStBarData;
    function GetCount : Integer;

  public
    constructor Create;
      virtual;
    destructor Destroy;
      override;
    procedure Add(ModuleCount : Integer; BarKind : TStBarKindSet);
    procedure Clear;

    property Bars[Index : Integer] : TStBarData
      read GetBars;
      default;

    property Count : Integer
      read GetCount;
  end;
  {.Z-}

  TStBarCodeType = (bcUPC_A, bcUPC_E, bcEAN_8, bcEAN_13,
                    bcInterleaved2of5, bcCodabar, bcCode11,
                    bcCode39, bcCode93, bcCode128);
  TStCode128CodeSubset = (csCodeA, csCodeB, csCodeC);

  TStBarCode = class(TGraphicControl)
  protected {private}
    {property variables}
    {.Z+}
    FAddCheckChar     : Boolean;
    FBarCodeType      : TStBarCodeType;
    FBarColor         : TColor;
    FBarToSpaceRatio  : Double;
    FBarNarrowToWideRatio : Integer;
    FBarWidth         : Double;         {in mils}
    FCode128Subset    : TStCode128CodeSubset;
    FBearerBars       : Boolean;
    FShowCode         : Boolean;
    FShowGuardChars   : Boolean;
    FSupplementalCode : string;
    FTallGuardBars    : Boolean;
    FExtendedSyntax   : Boolean;

    {internal variables}
    bcBarInfo        : TStBarCodeInfo;
    bcBarModWidth    : Integer; {width of single bar}
    bcCheckK         : Integer; {"K" check character for use by Code11}
    bcDigits         : TStDigitArray;
    bcDigitCount     : Integer;
    bcSpaceModWidth  : Integer; {width of empty space between bars}
    bcNormalWidth    : Integer;
    bcSpaceWidth     : Integer;
    bcSupplementWidth: Integer;

    {property methods}
    function GetCode : string;
    function GetVersion : string;
    procedure SetAddCheckChar(Value : Boolean);
    procedure SetBarCodeType(Value : TStBarCodeType);
    procedure SetBarColor(Value : TColor);
    procedure SetBarToSpaceRatio(Value : Double);
    procedure SetBarNarrowToWideRatio(Value: Integer);
    procedure SetBarWidth(Value : Double);
    procedure SetBearerBars(Value : Boolean);
    procedure SetCode(const Value : string);
    procedure SetCode128Subset(Value : TStCode128CodeSubset);
    procedure SetExtendedSyntax (const v : Boolean);
    procedure SetShowCode(Value : Boolean);
    procedure SetShowGuardChars(Value : Boolean);
    procedure SetSupplementalCode(const Value : string);
    procedure SetTallGuardBars(Value : Boolean);
    procedure SetVersion(const Value : string);

    {internal methods}
    procedure CalcBarCode;
    procedure CalcBarCodeWidth;
    function DrawBar(XPos, YPos, AWidth, AHeight : Integer) : Integer;
    procedure DrawBarCode(const R : TRect);
    function GetDigits(Characters : string) : Integer;
    procedure PaintPrim(const R : TRect);
    function SmallestLineWidth(PixelsPerInch : Integer) : Double;

    {VCL message methods}
    procedure CMTextChanged(var Msg : TMessage);
      message CM_TEXTCHANGED;

  protected
   procedure Loaded;
     override;
    procedure Paint;
      override;
  public
    constructor Create(AOwner : TComponent);
      override;
    destructor Destroy;
      override;
    {.Z-}

    procedure CopyToClipboard;
    procedure GetCheckCharacters(const S : string; var C, K : Integer);
    function GetBarCodeWidth(ACanvas : TCanvas) : Double;
    procedure PaintToCanvas(ACanvas : TCanvas; ARect : TRect);
    procedure PaintToCanvasSize(ACanvas : TCanvas; X, Y, H : Double);
    procedure PaintToDC(DC : hDC; ARect : TRect);
    procedure PaintToDCSize(DC : hDC; X, Y, W, H : Double);
    procedure SaveToFile(const FileName : string);
    function Validate(DisplayError : Boolean) : Boolean;

  published
    {properties}
    property Align;
    property Color;
    property Cursor;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Visible;

    property AddCheckChar : Boolean
      read FAddCheckChar
      write SetAddCheckChar;

    property BarCodeType : TStBarCodeType
      read FBarCodeType
      write SetBarCodeType;

    property BarColor : TColor
      read FBarColor
      write SetBarColor;

    property BarToSpaceRatio : Double
      read FBarToSpaceRatio
      write SetBarToSpaceRatio;

    property BarNarrowToWideRatio : Integer
      read FBarNarrowToWideRatio
      write SetBarNarrowToWideRatio
      default bcDefNarrowToWideRatio;

    property BarWidth : Double
      read FBarWidth
      write SetBarWidth;

    property BearerBars : Boolean
      read FBearerBars
      write SetBearerBars;

    property Code : string
      read GetCode
      write SetCode;

    property Code128Subset : TStCode128CodeSubset
      read FCode128Subset
      write SetCode128Subset;

    property ExtendedSyntax : Boolean
             read FExtendedSyntax write SetExtendedSyntax
             default False;

    property ShowCode : Boolean
      read FShowCode
      write SetShowCode;

    property ShowGuardChars : Boolean
      read FShowGuardChars
      write SetShowGuardChars;

    property SupplementalCode : string
      read FSupplementalCode
      write SetSupplementalCode;

    property TallGuardBars : Boolean
      read FTallGuardBars
      write SetTallGuardBars;

    property Version : string
      read GetVersion
      write SetVersion
      stored False;

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


implementation

const
  {left and right codes for UPC_A}
  UPC_A_LeftHand : array[0..9] of string[8] =
    ('0001101', {0}
     '0011001', {1}
     '0010011', {2}
     '0111101', {3}
     '0100011', {4}
     '0110001', {5}
     '0101111', {6}
     '0111011', {7}
     '0110111', {8}
     '0001011'  {9} );

  UPC_A_RightHand : array[0..9] of string[8] =
    ('1110010', {0}
     '1100110', {1}
     '1101100', {2}
     '1000010', {3}
     '1011100', {4}
     '1001110', {5}
     '1010000', {6}
     '1000100', {7}
     '1001000', {8}
     '1110100'  {9} );

const
  UPC_E_OddParity : array[0..9] of string[8] =
    ('0001101', {0}
     '0011001', {1}
     '0010011', {2}
     '0111101', {3}
     '0100011', {4}
     '0110001', {5}
     '0101111', {6}
     '0111011', {7}
     '0110111', {8}
     '0001011'  {9} );

  UPC_E_EvenParity : array[0..9] of string[8] =
    ('0100111', {0}
     '0110011', {1}
     '0011011', {2}
     '0100001', {3}
     '0011101', {4}
     '0111001', {5}
     '0000101', {6}
     '0010001', {7}
     '0001001', {8}
     '0010111'  {9} );

const
  EAN_LeftHandA : array[0..9] of string[8] =
    ('0001101', {0}
     '0011001', {1}
     '0010011', {2}
     '0111101', {3}
     '0100011', {4}
     '0110001', {5}
     '0101111', {6}
     '0111011', {7}
     '0110111', {8}
     '0001011'  {9} );

  EAN_LeftHandB : array[0..9] of string[8] =
    ('0100111', {0}
     '0110011', {1}
     '0011011', {2}
     '0100001', {3}
     '0011101', {4}
     '0111001', {5}
     '0000101', {6}
     '0010001', {7}
     '0001001', {8}
     '0010111'  {9} );

const
  Interleaved_2of5 : array[0..9] of string[5] =
    ('00110', {0}
     '10001', {1}
     '01001', {2}
     '11000', {3}
     '00101', {4}
     '10100', {5}
     '01100', {6}
     '00011', {7}
     '10010', {8}
     '01010'  {9} );

const
  Codabar : array[0..19] of string[7] =
     {BSBSBSB}      {bar-space-bar-space-bar...}
    ('0000011', {0}
     '0000110', {1}
     '0001001', {2}
     '1100000', {3}
     '0010010', {4}
     '1000010', {5}
     '0100001', {6}
     '0100100', {7}
     '0110000', {8}
     '1001000', {9}
     '0001100', {-}
     '0011000', { $}
     '1000101', {:}
     '1010001', {/}
     '1010100', {.}
     '0010101', {+}
     '0011010', {A}
     '0101001', {B}
     '0001011', {C}
     '0001110'  {D});

const
  Code11 :  array[0..11] of string[5] =
     {BSBSB}    {bar-space-bar-space-bar...} {0-narrow, 1-wide}
    ('00001',   {0}
     '10001',   {1}
     '01001',   {2}
     '11000',   {3}
     '00101',   {4}
     '10100',   {5}
     '01100',   {6}
     '00011',   {7}
     '10010',   {8}
     '10000',   {9}
     '00100',   {-}
     '00110');  {stop character}

const
  Code39 : array[0..43] of string[9] =
     {BSBSBSBSB}      {bar-space-bar-space-bar...} {0-narrow, 1-wide}
    ('000110100',   {0}
     '100100001',   {1}
     '001100001',   {2}
     '101100000',   {3}
     '000110001',   {4}
     '100110000',   {5}
     '001110000',   {6}
     '000100101',   {7}
     '100100100',   {8}
     '001100100',   {9}
     '100001001',   {A}
     '001001001',   {B}
     '101001000',   {C}
     '000011001',   {D}
     '100011000',   {E}
     '001011000',   {F}
     '000001101',   {G}
     '100001100',   {H}
     '001001100',   {I}
     '000011100',   {J}
     '100000011',   {K}
     '001000011',   {L}
     '101000010',   {M}
     '000010011',   {N}
     '100010010',   {O}
     '001010010',   {P}
     '000000111',   {Q}
     '100000110',   {R}
     '001000110',   {S}
     '000010110',   {T}
     '110000001',   {U}
     '011000001',   {V}
     '111000000',   {W}
     '010010001',   {X}
     '110010000',   {Y}
     '011010000',   {Z}
     '010000101',   {-}
     '110000100',   {.}
     '011000100',   {SPACE}
     '010101000',   { $}
     '010100010',   {/}
     '010001010',   {+}
     '000101010',   {%}
     '010010100');  {*}

const