delphi 打印LabelsVCL组件|笨鱼技术网

Problem/Question/Abstract:

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 ?

The size (height and width) of every label.
The number of labels per row.
The top and left margin.
The kind of measure: pixels,inches or millimetres.
The font to use.
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

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 <= FLabelLines - 1 then
DataArr[i, CurrLab - 1] := LabLines[i];

if CurrLab = FLabelsPerRow then
FlushBuffer;
end;

end.