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
|
