ppbarcod.pas

QuickRep1: TQuickRep QRImage1: TQRImage QRLabel1: TQRLabel Edit1: TEdit Butt

    * EAN-13
    * EAN-8
    * FIM A,B,C
    * Interleaved 2 of 5
    * PostNet
    * UPC-A
    * UPC-E

    When creating a barcode use the BarCodeType property to specify the
    symbology which should be used to encode the data. Use the Data
    property to specify the data to be encoded.}

  {@TppBarCode.Alignment

    Determines the position of any human-readable text which is part of the
    barcode. These are the possible values:

    <Table>
    Value	        Meaning
    ---------------------------
    taLeftJustify	Align text to the left side of the control
    taCenter	        Center text horizontally in the control
    taRightJustify	Align text to the right side of the control

    Note: This setting is ignored for EAN-13 and UPC-A barcodes. These two
    symbologies have special text placement requirements, which must be
    supported in order to create valid barcodes
    </Table>}

  {@TppBarCode.Data

    Run-time and read-only. Contains the data as retrieved from the database,
    which will be encoded.}

  TppBarCode = class(TppCustomBarCode)
    protected
    {  procedure SetBarCodeType(Value: TppBarCodeType); override;}
    public
      constructor Create(AOwner: TComponent); override;

    published
      property AddOnCode;
      property AutoEncode;
      property AutoSizeFont;
      property BarCodeType;
      property BarColor;
      property BarWidth stored False;
      property BearerBars;
      property CalcCheckDigit;
      property Data;
      property Orientation;
      property PrintHumanReadable;
      property WideBarRatio stored False;

      property Alignment;
      property AutoSize default True;
      property Color;
      property Font;
      property OnDrawCommandClick;
      property OnDrawCommandCreate;
      property ReprintOnOverFlow;
      property ShiftWithParent;
      property Transparent;
      property UserName;
      property Visible;

      {these properties saved in 'fake' properties}
      property Height stored False;
      property Left stored False;
      property Top stored False;
      property Width stored False;

    end; {class, TppBarCode}


  {@TppDBBarCode

    A bar code is a series of lines and spaces which represent data. A
    special set of rules is used to convert data into the lines and spaces
    of a barcode. This set of rules is called a symbology. There are many
    different symbologies, some for general purpose use and some for very
    specific applications. With TppBarCode, you can create valid bar codes
    for the most popular symbologies. They are:

    * Codabar
    * Code 128
    * Code 39
    * EAN-13
    * EAN-8
    * FIM A,B,C
    * Interleaved 2 of 5
    * PostNet
    * UPC-A
    * UPC-E

    When creating a barcode use the BarCodeType property to specify the
    symbology which should be used to encode the data. Use the DataPipeline
    and DataField properties to specify the database field which contains
    the data to be encoded.}

  {@TppDBBarCode.DataField

    Specifies the field in the DataPipeline which contains the data to be
    encoded.}

  {@TppDBBarCode.DataPipeline

    The DataPipeline property determines where the component obtains the
    data to encode. Each DataPipeline contains a set of fields. The field
    which will be used by the component is specified via the DataField
    property.}

  TppDBBarCode = class(TppCustomBarCode)
    protected
      function  GetData: String; override;
      procedure SetCaption(Value: String); override;
      procedure SetDataField(const Value: String); override;

    public
      procedure Notify(aCommunicator: TppCommunicator; aOperation: TppOperationType); override;

      function  IsDataAware: Boolean; override;

    published
      property AddOnCode;
      property AutoEncode;
      property AutoSizeFont;
      property BarCodeType;
      property BarColor;
      property BarWidth stored False;
      property BearerBars;
      property CalcCheckDigit;
      property DataField;
      property DataPipeline;
      property Orientation;
      property PrintHumanReadable;
      property WideBarRatio stored False;

      property Alignment;
      property AutoSize default True;
      property Color;
      property Font;
      property OnDrawCommandClick;
      property OnDrawCommandCreate;
      property ReprintOnOverFlow;
      property ShiftWithParent;
      property Transparent;
      property UserName;
      property Visible;

      {these properties saved in 'fake' properties}
      property Height stored False;
      property Left stored False;
      property Top stored False;
      property Width stored False;

    end; {class, TppDBBarCode}

{******************************************************************************
 *
 ** R T T I
 *
{******************************************************************************}

  {@TraTppBarCodeRTTI }
  TraTppBarCodeRTTI = class(TraTppComponentRTTI)
    public
      class procedure GetPropList(aClass: TClass; aPropList: TraPropList); override;
      class function  GetPropRec(aClass: TClass; const aPropName: String; var aPropRec: TraPropRec): Boolean; override;
      class function  GetPropValue(aObject: TObject; const aPropName: String; var aValue): Boolean; override;
      class function  RefClass: TClass; override;
      class function  SetPropValue(aObject: TObject; const aPropName: String; var aValue): Boolean; override;
  end; {class, TraTppBarCodeRTTI}


implementation

uses
  ppForms, ppPrintr, ppPrnDev, ppViewr;


{******************************************************************************
 *
 **  C U S T O M   B A R C O D E
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.Create}

constructor TppCustomBarCode.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  FAutoEncode := False;
  FAutoSizeFont := True;
  FAddOnCode := '';
  FBarCodeType := bcCode39;
  FBarCodeImage := nil;
  FData := '';
  FDrawCommand := nil;
  FBarColor := clBlack;
  FBarWidth := ppToMMThousandths(0.010, utInches, pprtHorizontal, nil);
  FBearerBars := False;
  FCalcCheckDigit := True;
  Color := clWhite;
  FOrientation := orLeftToRight;
  FPrintHumanReadable := True;
  FWideBarRatio := ppToMMThousandths(3, utInches, pprtHorizontal, nil);
  FUpdating := 0;

  {assign default properties}
  Font.Name := 'Courier New';
  FData := 'Barcode';

  SetMMWidth(ppToMMThousandths(1.53,  utInches, pprtHorizontal, nil));
  SetMMHeight(ppToMMThousandths(0.5083, utInches, pprtVertical, nil));

  AutoSize := True;

  {need to set this last}
  FCodeOK := True;

  DrawCommandClass := TppDrawBarCode;

end; {constructor, Create}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.Destroy}

destructor TppCustomBarCode.Destroy;
begin

  FDrawCommand.Free;

  FBarCodeImage.Free;

  inherited Destroy;
end; {destructor, Destroy}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.GetDefaultPropHint }

function TppCustomBarCode.GetDefaultPropHint: String;
begin
  Result := ppLoadStr(694); {'Data to be encoded'}
end; {function, GetDefaultPropHint}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.PropertiesToDrawCommand }

procedure TppCustomBarCode.PropertiesToDrawCommand(aDrawCommand: TppDrawCommand);
var
  lDrawBarCode: TppDrawBarCode;


begin

  inherited PropertiesToDrawCommand(aDrawCommand);

  if not(aDrawCommand is TppDrawBarCode) then Exit;

  lDrawBarCode := TppDrawBarCode(aDrawCommand);

  {create print object}
  lDrawBarCode.Left   := PrintPosRect.Left;
  lDrawBarCode.Top    := PrintPosRect.Top;
  lDrawBarCode.Height := PrintPosRect.Bottom - PrintPosRect.Top;
  lDrawBarCode.Width  := PrintPosRect.Right  - PrintPosRect.Left;

  lDrawBarCode.Alignment         := Alignment;
  lDrawBarCode.AddOnCode         := FAddOnCode;
  lDrawBarCode.AutoEncode        := FAutoEncode;
  lDrawBarCode.AutoSize          := AutoSize;
  lDrawBarCode.AutoSizeFont      := AutoSizeFont;
  lDrawBarCode.BarCodeType       := FBarCodeType;
  lDrawBarCode.BarColor          := FBarColor;
  lDrawBarCode.BarWidth          := FBarWidth;
  lDrawBarCode.BearerBars        := FBearerBars;
  lDrawBarCode.CalcCheckDigit    := FCalcCheckDigit;
  lDrawBarCode.Color             := Color;
  lDrawBarCode.Data              := GetData;
  lDrawBarCode.CodeOK            := IsValidData(lDrawBarCode.Data);
  lDrawBarCode.Font              := Font;
  lDrawBarCode.Orientation       := FOrientation;
  lDrawBarCode.PrintHumanReadable:= FPrintHumanReadable;
  lDrawBarCode.Transparent       := Transparent;
  lDrawBarCode.WideBarRatio      := WideBarRatio;


end; {procedure, PropertiesToDrawCommand}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.BeginUpdate }

procedure TppCustomBarCode.BeginUpdate;
begin
  Inc(FUpdating);

end; {procedure, BeginUpdate}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.EndUpdate }

procedure TppCustomBarCode.EndUpdate;
begin

  if FUpdating > 0 then
    Dec(FUpdating);

  if FUpdating = 0 then
    if AutoSize then
      AdjustBounds
    else
      InvalidateDesignControl;

end; {procedure, EndUpdate}

{------------------------------------------------------------------------------}
{ TppCustomBarCode.PaintDesignControl }

procedure TppCustomBarCode.PaintDesignControl(aCanvas: TCanvas);
begin

  if FUpdating > 0 then Exit;

  FPainting    := True;

  try

    DrawBarCode;

    if (pppcDesigning in DesignState) and not FCodeOk  then
      begin
        aCanvas.Pen.Style   := psDash;
        aCanvas.Brush.Style := bsClear;
        aCanvas.Rectangle(0, 0, spWidth, spHeight);

      end;


  finally

    FPainting := False;

  end;

end; {procedure, PaintDesignControl}

{------------------------------------------------------------------------------}

{