Title: A VCL Component to print labels (II)
Question: A simple component to print labels
Answer:
A simple VCL componet to print labels.
A few days ago I wrote an article about a class to print labels (3156)
With the help of Mike Heydon we have rewritten the class to convert it to a component and easier to use.
What do we need to print labels ?
1. The size (height and width) of every label.
2. The number of labels per row.
3. The top and left margin.
4. The kind of measure: pixels,inches or millimetres.
5. The font to use.
6. And of course data to fill the labels.
With the next component we can do it very simply, Im going to use a pseudo-code to explain the use of the component TPrtLabels:
begin
PrtLabels.Measurements:=plmInches; // plmMillimetres or plmPixels
PrtLabels.Font:=FontDialog1.Font; // I get the font from a Font Dialog
PrtLabels.LabelsPerRow:=4; // 4 Label per row
PrtLabels.LabelWidth:=3; // only an example
PrtLabels.LabelHeight:=1.5; // only an example
PrtLabels.LeftMargin:=0; // only an example
PrtLabels.TopMargin:=0; // only an example
PrtLabels.Open; // open the printer
Table.First // Im going to read a customer table
while not Table.Eof do begin
PrtLabels.Add(["Name","Street","City"]); // I fill the content of every label
Table.Next;
end;
PrtLabels.Close; // close the printer and print any label pending on the buffer
PrtLabels.Free;
end;
We need only 3 methods: Open, Add and Close.
The properties that we need are:
Measurements (plmInches, plmMillimetres or plmPixels)
LabelsPerRow
LabelWidth
LabelHeight
LeftMargin
TopMargin
Font
Thanks Mike
The componet:
///////////////////////////////////////////////////////////////////////////
unit ULabels2;
{
VCL Component to print labels
Authors:
Mike Heydon
Alejandro Castro
Date: 1/Abr/2002
}
interface
uses SysUtils, Windows, Classes, Graphics, Printers;
type
TPrtLabelMeasures = (plmPixels,plmInches,plmMillimetres);
TPrtLabels = class(TComponent)
private
FFont : TFont;
FMeasurements : TPrtLabelMeasures;
FTopMargin,
FLeftMargin,
FLabelHeight,
FLabelWidth : double; // Selected Measure
FLabelLines,
FLabelsPerRow : word; // ABS Pixels
TopMarginPx,
LeftMarginPx,
LabelHeightPx,
LabelWidthPx : integer;
TabStops : array of word;
DataArr : array of array of string;
CurrLab : word;
procedure SetFont(Value : TFont);
procedure IniDataArr;
procedure FlushBuffer;
procedure SetDataLength(xLabelLines,xLabelsPerRow: Word);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Add(LabLines : array of string);
procedure Close;
procedure Open;
published
property Font : TFont read FFont write SetFont;
property Measurements : TPrtLabelMeasures read FMeasurements write FMeasurements;
property LabelWidth : double read FLabelWidth write FLabelWidth;
property LabelHeight : double read FLabelHeight write FLabelHeight;
property TopMargin : double read FTopMargin write FTopMargin;
property LeftMargin : double read FLeftMargin write FLeftMargin;
property LabelsPerRow : word read FLabelsPerRow write FLabelsPerRow;
// property LabelLines : word read FLabelLines write FLabelLines;
end;
procedure Register;
implementation
const MMCONV = 25.4;
procedure Register;
begin
RegisterComponents('Mah2001',[TPrtLabels]);
end;
constructor TPrtLabels.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FMeasurements := plmInches;
FLabelHeight := 0.0;
FLabelWidth := 0.0;
FTopMargin := 0.0;
FLeftMargin := 0.0;
FLabelsPerRow := 1;
FLabelLines := 1;
FFont := TFont.Create;
TabStops := nil;
DataArr := nil;
end;
destructor TPrtLabels.Destroy;
begin
FFont.Free;
TabStops := nil;
DataArr := nil;
inherited Destroy;
end;
procedure TPrtLabels.SetFont(Value : TFont);
begin
FFont.Assign(Value);
end;
procedure TPrtLabels.SetDataLength(xLabelLines,xLabelsPerRow: Word);
begin
if (xLabelLines+xLabelsPerRow)1 then
SetLength(DataArr,xLabelLines,xLabelsPerRow);
end;
procedure TPrtLabels.Open;
var PixPerInX,PixPerInY,i : integer;
begin
if (FLabelsPerRow + FLabelLines) 1 then begin
SetLength(TabStops,FLabelsPerRow);
SetDataLength(FLabelLines,FLabelsPerRow);
// SetLength(DataArr,FLabelLines,FLabelsPerRow);
Printer.Canvas.Font.Assign(FFont);
Printer.BeginDoc;
PixPerInX := GetDeviceCaps(Printer.Handle,LOGPIXELSX);
PixPerInY := GetDeviceCaps(Printer.Handle,LOGPIXELSY);
case FMeasurements of
plmInches : begin
LabelWidthPx := trunc(LabelWidth * PixPerInX);
LabelHeightPx := trunc(LabelHeight * PixPerInY);
TopMarginPx := trunc(TopMargin * PixPerInX);
LeftMarginPx := trunc(LeftMargin * PixPerInY);
end;
plmMillimetres : begin
LabelWidthPx := trunc(LabelWidth * PixPerInX * MMCONV);
LabelHeightPx := trunc(LabelHeight * PixPerInY * MMCONV);
TopMarginPx := trunc(TopMargin * PixPerInX * MMCONV);
LeftMarginPx := trunc(LeftMargin * PixPerInY * MMCONV);
end;
plmPixels : begin
LabelWidthPx := trunc(LabelWidth);
LabelHeightPx := trunc(LabelHeight);
TopMarginPx := trunc(TopMargin);
LeftMarginPx := trunc(LeftMargin);
end;
end;
for i := 0 to FLabelsPerRow - 1 do
TabStops[i] := LeftMarginPx + (LabelWidthPx * i);
IniDataArr;
end;
end;
procedure TPrtLabels.Close;
begin
if (FLabelsPerRow + FLabelLines) 1 then begin
FlushBuffer;
Printer.EndDoc;
TabStops := nil;
DataArr := nil;
end;
end;
procedure TPrtLabels.IniDataArr;
var i,ii : integer;
begin
CurrLab := 0;
for i := 0 to High(DataArr) do // FLabelLines - 1 do
for ii := 0 to High(DataArr[i]) do //FLabelsPerRow do
DataArr[i,ii] := '';
end;
procedure TPrtLabels.FlushBuffer;
var i,ii,y,SaveY : integer;
begin
if CurrLab 0 then begin
if Printer.Canvas.PenPos.Y = 0 then Printer.Canvas.MoveTo(0,TopMarginPx);
y :=Printer.Canvas.PenPos.Y;
SaveY := y;
for i := 0 to fLabelLines - 1 do begin
for ii := 0 to fLabelsPerRow - 1 do begin
Printer.Canvas.TextOut(TabStops[ii],y,DataArr[i,ii]);
end;
inc(y,Printer.Canvas.Textheight('X'));
end;
if (LabelHeightPx + SaveY) + LabelHeightPx Printer.PageHeight then
Printer.NewPage
else
Printer.Canvas.MoveTo(0,LabelHeightPx + SaveY);
IniDataArr;
end;
end;
procedure TPrtLabels.Add(LabLines : array of string);
var i : integer;
begin
if Length(LabLines)FLabelLines then begin
FLabelLines:=Length(LabLines);
SetDataLength(fLabelLines,fLabelsPerRow);
end;
inc(CurrLab);
for i := 0 to high(LabLines) do
if i DataArr[i,CurrLab-1] := LabLines[i];
if CurrLab = FLabelsPerRow then FlushBuffer;
end;
end.