delphi 一个打印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.