Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
A VCL Component to print labels Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
26-Jul-03
Category
Reporting /Printing
Language
Delphi 5.x
Views
115
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Alejandro Castro

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: 
1   
2   begin
3     PrtLabels.Measurements := plmInches; // plmMillimetres or plmPixels
4     PrtLabels.Font := FontDialog1.Font; // I get the font from a Font Dialog
5     PrtLabels.LabelsPerRow := 4; // 4 Label per row
6     PrtLabels.LabelWidth := 3; // only an example
7     PrtLabels.LabelHeight := 1.5; // only an example
8     PrtLabels.LeftMargin := 0; // only an example
9     PrtLabels.TopMargin := 0; // only an example
10    PrtLabels.Open; // open the printer
11    Table.First // Im going to read a customer table
12    while not Table.Eof do
13    begin
14      PrtLabels.Add(["Name", "Street", "City"]); // I fill the content of every label
15      Table.Next;
16    end;
17    PrtLabels.Close; // close the printer and print any label pending on the buffer
18    PrtLabels.Free;
19  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: 

20  unit ULabels2;
21  {
22  VCL Component to print labels
23  
24  Authors:
25  Mike Heydon
26  Alejandro Castro
27  
28  Date: 1/Abr/2002
29  }
30  
31  interface
32  uses SysUtils, Windows, Classes, Graphics, Printers;
33  
34  type
35    TPrtLabelMeasures = (plmPixels, plmInches, plmMillimetres);
36  
37    TPrtLabels = class(TComponent)
38    private
39      FFont: TFont;
40      FMeasurements: TPrtLabelMeasures;
41      FTopMargin,
42        FLeftMargin,
43        FLabelHeight,
44        FLabelWidth: double; // Selected Measure
45      FLabelLines,
46        FLabelsPerRow: word; // ABS Pixels
47      TopMarginPx,
48        LeftMarginPx,
49        LabelHeightPx,
50        LabelWidthPx: integer;
51      TabStops: array of word;
52      DataArr: array of array of string;
53      CurrLab: word;
54      procedure SetFont(Value: TFont);
55      procedure IniDataArr;
56      procedure FlushBuffer;
57      procedure SetDataLength(xLabelLines, xLabelsPerRow: Word);
58  
59    public
60      constructor Create(AOwner: TComponent); override;
61      destructor Destroy; override;
62      procedure Add(LabLines: array of string);
63      procedure Close;
64      procedure Open;
65    published
66      property Font: TFont read FFont write SetFont;
67      property Measurements: TPrtLabelMeasures read FMeasurements write FMeasurements;
68      property LabelWidth: double read FLabelWidth write FLabelWidth;
69      property LabelHeight: double read FLabelHeight write FLabelHeight;
70      property TopMargin: double read FTopMargin write FTopMargin;
71      property LeftMargin: double read FLeftMargin write FLeftMargin;
72      property LabelsPerRow: word read FLabelsPerRow write FLabelsPerRow;
73      //    property LabelLines : word read FLabelLines write FLabelLines;
74    end;
75  
76  procedure register;
77  
78  implementation
79  
80  const
81    MMCONV = 25.4;
82  
83  procedure register;
84  begin
85    RegisterComponents('Mah2001', [TPrtLabels]);
86  end;
87  
88  constructor TPrtLabels.Create(AOwner: TComponent);
89  begin
90    inherited Create(AOwner);
91  
92    FMeasurements := plmInches;
93    FLabelHeight := 0.0;
94    FLabelWidth := 0.0;
95    FTopMargin := 0.0;
96    FLeftMargin := 0.0;
97    FLabelsPerRow := 1;
98    FLabelLines := 1;
99    FFont := TFont.Create;
100   TabStops := nil;
101   DataArr := nil;
102 end;
103 
104 destructor TPrtLabels.Destroy;
105 begin
106   FFont.Free;
107   TabStops := nil;
108   DataArr := nil;
109 
110   inherited Destroy;
111 end;
112 
113 procedure TPrtLabels.SetFont(Value: TFont);
114 begin
115   FFont.Assign(Value);
116 end;
117 
118 procedure TPrtLabels.SetDataLength(xLabelLines, xLabelsPerRow: Word);
119 begin
120   if (xLabelLines + xLabelsPerRow) > 1 then
121     SetLength(DataArr, xLabelLines, xLabelsPerRow);
122 end;
123 
124 procedure TPrtLabels.Open;
125 var
126   PixPerInX, PixPerInY, i: integer;
127 begin
128   if (FLabelsPerRow + FLabelLines) > 1 then
129   begin
130     SetLength(TabStops, FLabelsPerRow);
131     SetDataLength(FLabelLines, FLabelsPerRow);
132     //    SetLength(DataArr,FLabelLines,FLabelsPerRow);
133     Printer.Canvas.Font.Assign(FFont);
134     Printer.BeginDoc;
135     PixPerInX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
136     PixPerInY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
137 
138     case FMeasurements of
139       plmInches:
140         begin
141           LabelWidthPx := trunc(LabelWidth * PixPerInX);
142           LabelHeightPx := trunc(LabelHeight * PixPerInY);
143           TopMarginPx := trunc(TopMargin * PixPerInX);
144           LeftMarginPx := trunc(LeftMargin * PixPerInY);
145         end;
146 
147       plmMillimetres:
148         begin
149           LabelWidthPx := trunc(LabelWidth * PixPerInX * MMCONV);
150           LabelHeightPx := trunc(LabelHeight * PixPerInY * MMCONV);
151           TopMarginPx := trunc(TopMargin * PixPerInX * MMCONV);
152           LeftMarginPx := trunc(LeftMargin * PixPerInY * MMCONV);
153         end;
154 
155       plmPixels:
156         begin
157           LabelWidthPx := trunc(LabelWidth);
158           LabelHeightPx := trunc(LabelHeight);
159           TopMarginPx := trunc(TopMargin);
160           LeftMarginPx := trunc(LeftMargin);
161         end;
162     end;
163 
164     for i := 0 to FLabelsPerRow - 1 do
165       TabStops[i] := LeftMarginPx + (LabelWidthPx * i);
166     IniDataArr;
167   end;
168 end;
169 
170 procedure TPrtLabels.Close;
171 begin
172   if (FLabelsPerRow + FLabelLines) > 1 then
173   begin
174     FlushBuffer;
175     Printer.EndDoc;
176     TabStops := nil;
177     DataArr := nil;
178   end;
179 end;
180 
181 procedure TPrtLabels.IniDataArr;
182 var
183   i, ii: integer;
184 begin
185   CurrLab := 0;
186   for i := 0 to High(DataArr) do // FLabelLines - 1 do
187     for ii := 0 to High(DataArr[i]) do //FLabelsPerRow do
188       DataArr[i, ii] := '';
189 end;
190 
191 procedure TPrtLabels.FlushBuffer;
192 var
193   i, ii, y, SaveY: integer;
194 begin
195   if CurrLab > 0 then
196   begin
197     if Printer.Canvas.PenPos.Y = 0 then
198       Printer.Canvas.MoveTo(0, TopMarginPx);
199     y := Printer.Canvas.PenPos.Y;
200     SaveY := y;
201 
202     for i := 0 to fLabelLines - 1 do
203     begin
204       for ii := 0 to fLabelsPerRow - 1 do
205       begin
206         Printer.Canvas.TextOut(TabStops[ii], y, DataArr[i, ii]);
207       end;
208 
209       inc(y, Printer.Canvas.Textheight('X'));
210     end;
211 
212     if (LabelHeightPx + SaveY) + LabelHeightPx > Printer.PageHeight then
213       Printer.NewPage
214     else
215       Printer.Canvas.MoveTo(0, LabelHeightPx + SaveY);
216 
217     IniDataArr;
218   end;
219 end;
220 
221 procedure TPrtLabels.Add(LabLines: array of string);
222 var
223   i: integer;
224 begin
225 
226   if Length(LabLines) > FLabelLines then
227   begin
228     FLabelLines := Length(LabLines);
229     SetDataLength(fLabelLines, fLabelsPerRow);
230   end;
231 
232   inc(CurrLab);
233 
234   for i := 0 to high(LabLines) do
235     if i <= FLabelLines - 1 then
236       DataArr[i, CurrLab - 1] := LabLines[i];
237 
238   if CurrLab = FLabelsPerRow then
239     FlushBuffer;
240 end;
241 
242 end.



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

			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC