stbarpn.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: StBarPN.pas 4.03                            *}
{*********************************************************}
{* SysTools: PostNet Bar Code component                  *}
{*********************************************************}

{$I StDefine.inc}

unit StBarPN;

interface

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

type
  TStPNBarCodeDims = packed record
    PixPerBar        : Longint;
    PixPerSpace      : Longint;
    ShortBarHeight   : Longint;
    TallBarHeight    : Longint;
    Width            : Longint;
    Height           : Longint;
  end;

  TStPNBarCodeRes = packed record
    XRes  : Longint;
    YRes  : Longint;
  end;

  TStPNBarCode = class(TGraphicControl)
  protected {private}
    {property variables}
    FPostalCode        : string;
    FCheckNumber       : Integer;


    {internal variables}
    pnbcDisplayDims    : TStPNBarCodeDims;
    pnbcDefRes         : TStPNBarCodeRes;

    {property methods}
    function  GetVersion : string;
    procedure SetPostalCode(Value : String);
    procedure SetVersion (const v : string);

    {internal methods}
    function DrawTallBar(C         : TCanvas;
                         Dims      : TStPNBarCodeDims;
                         XPos      : Integer;
                         AddSpace  : Boolean) : Longint;
    function DrawShortBar(C        : TCanvas;
                          Dims     : TStPNBarCodeDims;
                          XPos     : Integer;
                          AddSpace : Boolean) : Longint;
    function DrawNumber(C          : TCanvas;
                        Dims       : TStPNBarCodeDims;
                        Value      : Integer;
                        XPos       : Longint;
                        FrontGuard : Boolean;
                        EndGuard   : Boolean) : Longint;
    procedure DrawBarCode(C : TCanvas; Dims : TStPNBarCodeDims);
    procedure SetCheckNumber;

(*
    procedure CMTextChanged(var Msg : TMessage);
      message CM_TEXTCHANGED;
*)

  protected
    procedure Loaded; override;
    procedure Paint; override;
  public
    constructor Create(AOwner : TComponent); override;

    procedure ComputeSizes(C        : TCanvas;
                           Res      : TStPNBarCodeRes;
                           var Dims : TStPNBarCodeDims);
    procedure CopyToClipboard;
    procedure PaintToCanvas(ACanvas : TCanvas; Position : TPoint);
    procedure PaintToDC(DC : hDC; Position : TPoint);
    procedure PaintToPrinterCanvas(ACanvas : TCanvas; Position : TPoint);
    procedure PaintToPrinterDC(DC : hDC; Position : TPoint);
    procedure SaveToFile(ACanvas : TCanvas; const FileName : string);
    procedure SaveToFileRes(Res : TStPNBarCodeRes; const FileName : string);

  published
    {properties}
    property Cursor;
    property Enabled;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property Visible;

    property PostalCode : string read FPostalCode write SetPostalCode;

    property Version : string read GetVersion write SetVersion stored False;

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


implementation

{*** TStPNBarCode ***}

function TStPNBarCode.GetVersion : string;
begin
  Result := StVersionStr;
end;


procedure TStPNBarCode.SetVersion(const v : string);
begin
end;

constructor TStPNBarCode.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  {defaults}
  pnbcDefRes.XRes := 0;
  pnbcDefRes.YRes := 0;
{set arbitrary values for height/width so that component automatically resizes}
  Height := 10;
  Width  := 10;
  PostalCode := '12345';
  SetCheckNumber;
end;


procedure TStPNBarCode.Loaded;
begin
  inherited Loaded;
  Invalidate;
end;


procedure TStPNBarCode.Paint;
begin
  ComputeSizes(Canvas, pnbcDefRes, pnbcDisplayDims);
  Height := pnbcDisplayDims.Height;
  Width  := pnbcDisplayDims.Width;
  DrawBarCode(Canvas, pnbcDisplayDims);
end;


procedure TStPNBarCode.SetCheckNumber;
var
  I : Longint;
begin
  if (Length(TrimL(FPostalCode)) < 5) then Exit;
  FCheckNumber := 0;
  for I := 1 to Length(FPostalCode) do
    FCheckNumber := FCheckNumber + StrToInt(FPostalCode[I]);
  I := FCheckNumber mod 10;
  if (I > 0) then
    FCheckNumber := 10 - I
  else
    FCheckNumber := 0;
end;

procedure TStPNBarCode.SetPostalCode(Value : string);
var
  I : Integer;
  Local : string;                                                        
begin
  if (csLoading in ComponentState) then Exit;

  Local := TrimL(Value);                                                 

  {strip non-numerics}
  I := 1;
  repeat
    if not (Local[I] in ['0'..'9']) then
      System.Delete(Local, I, 1)
    else
      Inc(I);
  until (I > Length(Local));

  { looks like a valid Postal Code?}
  if (Local <> FPostalCode) then begin                                   
     if (Length(Local) in [5, 9, 11]) then begin                         
      FPostalCode := Local;
      SetCheckNumber;
      Invalidate;
    end else
      RaiseStError(EStPNBarCodeError, stscInvalidLength);
  end; { else it's the same code, don't bother updating }
end;


function TStPNBarCode.DrawTallBar(C        : TCanvas;
                                  Dims     : TStPNBarCodeDims;
                                  XPos     : Integer;
                                  AddSpace : Boolean) : Longint;
var
  YPos : Longint;
begin
  Result := XPos;
  YPos := Dims.Height - 5 - Dims.TallBarHeight;
  C.Rectangle(XPos, YPos, XPos+Dims.PixPerBar, YPos+Dims.TallBarHeight);
  Result := Result + Dims.PixPerBar;

  if (AddSpace) then
    Inc(Result, Dims.PixPerSpace);
end;


function TStPNBarCode.DrawShortBar(C        : TCanvas;
                                   Dims     : TStPNBarCodeDims;
                                   XPos     : Integer;
                                   AddSpace : Boolean) : Longint;
var
  YPos : Longint;
begin
  Result := XPos;
  YPos := Dims.Height - 5 - Dims.ShortBarHeight;
  C.Rectangle(XPos, YPos, XPos+Dims.PixPerBar, YPos+Dims.ShortBarHeight);
  Result := Result + Dims.PixPerBar;

  if (AddSpace) then
    Inc(Result, Dims.PixPerSpace);
end;


function TStPNBarCode.DrawNumber(C          : TCanvas;
                                 Dims       : TStPNBarCodeDims;
                                 Value      : Integer;
                                 XPos       : Longint;
                                 FrontGuard : Boolean;
                                 EndGuard   : Boolean) : Longint;
begin
  Result := XPos;
  if (FrontGuard) then
    Result := DrawTallBar(C, Dims, Result, True);

  case Value of
    0 : begin
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
        end;

    1 : begin
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
        end;

    2 : begin
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
        end;

    3 : begin
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
        end;

    4 : begin
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
        end;

    5 : begin
          Result := DrawShortBar(C, Dims, Result, True);
          Result := DrawTallBar(C,  Dims, Result, True);
          Result := DrawShortBar(C, Dims, Result, True);