A Class to Print Labels

Problem/Question/Abstract:

A very simple class to print labels

Answer:

A very simple class to print labels.

What do we need to print labels ?

The size (height and width) of every label.
The number of labels per row.
The top and left margin.
The kind of measure: pixels or inches.
The font to use.
And of course data to fill the labels.

With the next class we can do it very simply, Im going to use a pseudo-code to explain the use of the class TAlLabels:

var
  xLabels: TAlLabels;

begin
  xLabels := TAlLabels.Create;
  xLabels.Inches := True; // im going to use inches instead of pixels
  xLabels.Font := FontDialog1.Font; // I get the font from a Font Dialog
  xLabels.LabelsPerRow := 4; // 4 Label per row
  xLabels.LabelWidthInch := 3; // only an example
  xLabels.LabelHeightInch := 1.5; // only an example
  xLabels.LeftMarginInch := 0; // only an example
  xLabels.TopMarginInch := 0; // only an example
  xLabels.Open; // open the printer
  Table.First // Im going to read a customer table
  while not Table.Eof do
  begin
    xLabels.Fill(["Name", "Street", "City"]); // I fill the content of every label
    Table.Next;
  end;
  xLabels.Close; // close the printer and print any label pending on the buffer
  xLabels.Free;
end;

We need only 3 methods: Open, Fill and Close.

The properties that we need are:

Inches: True if the measure is on Inches, False if the measure is on Pixels.

Font
LabelsPerRow
LabelWidthInch
LabelHeightInch
LeftMarginInch
TopMarginInch

if we need to specify pixels instead of Inches we are going to use the next properties.

LabelWidth
LabelHeight
LeftMargin
TopMargin
Inches := False

Thus, the same example with pixels will be

var
  xLabels: TAlLabels;

  begin
    xLabels := TAlLabels.Create;
    xLabels.Inches := False; // im going to use pixels instead of inches
    xLabels.Font := FontDialog1.Font; // I get the font from a Font Dialog
    xLabels.LabelsPerRow := 4; // 4 Label per row
    xLabels.LabelWidth := 300; // only an example
    xLabels.LabelHeight := 200; // only an example
    xLabels.LeftMargin := 0; // only an example
    xLabels.TopMargin := 0; // only an example
    xLabels.Open; // open the printer
    Table.First // Im going to read a customer table
    while not Table.Eof do
    begin
      xLabels.Fill(["Name", "Street", "City"]); // I fill the content of every label
      Table.Next;
    end;
    xLabels.Close; // close the printer and print any label pending on the buffer
    xLabels.Free;
  end;

The class:

unit ULabels;
{
Class to print labels
Author: Alejandro Castro
Date 1/Abr/2002
}

interface

uses SysUtils, Windows, Graphics, Printers;

type
  TAlLabels = class(TObject)
  private

    xWhichLabel: Integer;
    xBuffer: Boolean;
    xLabelsPerRow: Integer;
    xRowsPerLabel: Integer;

    function ReadLabxRow: Integer;
    procedure WriteLabxRow(const Value: Integer);

    function ReadRowxLab: Integer;
    procedure WriteRowxLab(const Value: Integer);

    function ReadFont: TFont;
    procedure WriteFont(const Value: TFont);

  public
    LabelWidth: Integer; // width on pixels of every label
    LabelWidthInch: Real; // width on inches of every label

    LabelHeight: Integer; //  height on pixels of every label
    LabelHeightInch: Real; // height on inches of every label

    TopMargin: Integer; // margin on pixels on top of every page
    TopMarginInch: Real; // margin on inches on top of every page

    LeftMargin: Integer; // margin on inches on top of every page
    LeftMarginInch: Real; // margin on inches on top of every page

    Inches: Boolean; // true=size on inches, false=size on pixels

    TabsStop: array of integer; // horizontal position on pixels of every label
    Content: array of array of string; // content of every label

    property Font: TFont read ReadFont write WriteFont; // font for all rows
    property LabelsPerRow: Integer read ReadLabxRow write WriteLabxRow;
    property RowsPerLabel: Integer read ReadRowxLab write WriteRowxLab;

    constructor Create;
    procedure Fill(xCont: array of string); // fill a label
    procedure PrintRow; // print a row of labels
    procedure Clean; // clean the array CONTENT of labels
    procedure Close; // close the printer and print pending labels
    procedure Open; // open the printer

  end;

implementation

constructor TAlLabels.Create;
begin
  RowsPerLabel := 1;
  LabelsPerRow := 1;

  LabelWidth := 0;
  LabelWidthInch := 0;

  LabelHeight := 0;
  LabelHeightInch := 0;

  TopMargin := 0;
  TopMarginInch := 0;

  LeftMargin := 0;
  LeftMarginInch := 0;

  Inches := True;

  xWhichLabel := 0;
  xBuffer := False;

end;

procedure TAlLabels.Open;
var
  PixPerInX, PixPerInY, i: Integer;
begin
  Printer.BeginDoc;
  PixPerInX := getDeviceCaps(Printer.Handle, LOGPIXELSX);
  PixPerInY := getDeviceCaps(Printer.Handle, LOGPIXELSY);
  if Inches then
  begin
    LabelWidth := Trunc(LabelWidthInch * PixPerInX);
    LabelHeight := Trunc(LabelHeightInch * PixPerInY);
    LeftMargin := Trunc(LeftMarginInch * PixPerInX);
    TopMargin := Trunc(TopMarginInch * PixPerInY);
  end;
  for i := 0 to LabelsPerRow - 1 do
    TabsStop[i] := LeftMargin + LabelWidth * (i);
  Clean;
end;

procedure TAlLabels.Close;
begin
  PrintRow;
  Printer.EndDoc;
end;

function TAlLabels.ReadLabxRow: Integer;
begin
  Result := xLabelsPerRow;
end;

procedure TAlLabels.WriteLabxRow(const Value: Integer);
var
  i: Integer;
begin
  xLabelsPerRow := Value;

  SetLength(TabsStop, Value);
  for i := 0 to high(Content) do
    SetLength(Content[i], Value);
  Clean;
end;

function TAlLabels.ReadRowxLab: Integer;
begin
  Result := xRowsPerLabel;
end;

procedure TAlLabels.WriteRowxLab(const Value: Integer);
begin
  SetLength(Content, Value);
  xRowsPerLabel := Value;
  LabelsPerRow := LabelsPerRow; // to call the WriteLabxRow function
  Clean;
end;

function TAlLabels.ReadFont: TFont;
begin
  Result := Printer.Canvas.Font;
end;

procedure TAlLabels.WriteFont(const Value: TFont);
begin
  Printer.Canvas.Font.Assign(Value);
end;

procedure TAlLabels.Clean;
var
  i, j: Integer;
begin
  for i := 0 to high(Content) do
    for j := 0 to high(Content[i]) do
      Content[i, j] := '';
  xBuffer := False;
  xWhichLabel := 0;
end;

procedure TAlLabels.Fill(xCont: array of string);
var
  i: Integer;
begin
  xBuffer := True;
  if High(xCont) + 1 > RowsPerLabel then
    RowsPerLabel := High(xCont) + 1;

  for i := 0 to High(xCont) do
    Content[i, xWhichLabel] := xCont[i];

  inc(xWhichLabel);
  if xWhichLabel >= LabelsPerRow then
  begin
    PrintRow();
  end;
end;

procedure TAlLabels.PrintRow;
var
  i, j, k, y, y1: Integer;
begin
  if xBuffer then
  begin
    if Printer.Canvas.PenPos.y = 0 then
      Printer.Canvas.MoveTo(0, TopMargin);

    y := Printer.Canvas.PenPos.y;
    y1 := y;

    for i := 0 to RowsPerLabel - 1 do
    begin
      for j := 0 to xWhichLabel - 1 do
      begin
        Printer.Canvas.TextOut(TabsStop[j], y, Content[i, j]);
      end;
      inc(y, Printer.Canvas.Textheight('X'));
    end;

    k := LabelHeight + y1;
    if k + LabelHeight > Printer.PageHeight then
      Printer.NewPage
    else
      Printer.Canvas.MoveTo(0, LabelHeight + y1);
  end;
  Clean;

end;

end.


Component Download: http://www.baltsoft.com/files/dkb/attachment/ULabels.zip