Impressao - componente simples para impressao de etiquetas

{simple VCL componet to print labels. 

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 <= FLabelLines - 1 then 

      DataArr[i,CurrLab-1] := LabLines[i]; 

  if CurrLab = FLabelsPerRow then FlushBuffer; 

end; 

end.