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