Author: Alejandro Castro
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:
1 var
2 xLabels: TAlLabels;
3
4 begin
5 xLabels := TAlLabels.Create;
6 xLabels.Inches := True; // im going to use inches instead of pixels
7 xLabels.Font := FontDialog1.Font; // I get the font from a Font Dialog
8 xLabels.LabelsPerRow := 4; // 4 Label per row
9 xLabels.LabelWidthInch := 3; // only an example
10 xLabels.LabelHeightInch := 1.5; // only an example
11 xLabels.LeftMarginInch := 0; // only an example
12 xLabels.TopMarginInch := 0; // only an example
13 xLabels.Open; // open the printer
14 Table.First // Im going to read a customer table
15 while not Table.Eof do
16 begin
17 xLabels.Fill(["Name", "Street", "City"]); // I fill the content of every label
18 Table.Next;
19 end;
20 xLabels.Close; // close the printer and print any label pending on the buffer
21 xLabels.Free;
22 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
23 var
24 xLabels: TAlLabels;
25
26 begin
27 xLabels := TAlLabels.Create;
28 xLabels.Inches := False; // im going to use pixels instead of inches
29 xLabels.Font := FontDialog1.Font; // I get the font from a Font Dialog
30 xLabels.LabelsPerRow := 4; // 4 Label per row
31 xLabels.LabelWidth := 300; // only an example
32 xLabels.LabelHeight := 200; // only an example
33 xLabels.LeftMargin := 0; // only an example
34 xLabels.TopMargin := 0; // only an example
35 xLabels.Open; // open the printer
36 Table.First // Im going to read a customer table
37 while not Table.Eof do
38 begin
39 xLabels.Fill(["Name", "Street", "City"]); // I fill the content of every label
40 Table.Next;
41 end;
42 xLabels.Close; // close the printer and print any label pending on the buffer
43 xLabels.Free;
44 end;
45
46 The class:
47
48 unit ULabels;
49 {
50 Class to print labels
51 Author: Alejandro Castro
52 Date 1/Abr/2002
53 }
54
55 interface
56
57 uses SysUtils, Windows, Graphics, Printers;
58
59 type
60 TAlLabels = class(TObject)
61 private
62
63 xWhichLabel: Integer;
64 xBuffer: Boolean;
65 xLabelsPerRow: Integer;
66 xRowsPerLabel: Integer;
67
68 function ReadLabxRow: Integer;
69 procedure WriteLabxRow(const Value: Integer);
70
71 function ReadRowxLab: Integer;
72 procedure WriteRowxLab(const Value: Integer);
73
74 function ReadFont: TFont;
75 procedure WriteFont(const Value: TFont);
76
77 public
78 LabelWidth: Integer; // width on pixels of every label
79 LabelWidthInch: Real; // width on inches of every label
80
81 LabelHeight: Integer; // height on pixels of every label
82 LabelHeightInch: Real; // height on inches of every label
83
84 TopMargin: Integer; // margin on pixels on top of every page
85 TopMarginInch: Real; // margin on inches on top of every page
86
87 LeftMargin: Integer; // margin on inches on top of every page
88 LeftMarginInch: Real; // margin on inches on top of every page
89
90 Inches: Boolean; // true=size on inches, false=size on pixels
91
92 TabsStop: array of integer; // horizontal position on pixels of every label
93 Content: array of array of string; // content of every label
94
95 property Font: TFont read ReadFont write WriteFont; // font for all rows
96 property LabelsPerRow: Integer read ReadLabxRow write WriteLabxRow;
97 property RowsPerLabel: Integer read ReadRowxLab write WriteRowxLab;
98
99 constructor Create;
100 procedure Fill(xCont: array of string); // fill a label
101 procedure PrintRow; // print a row of labels
102 procedure Clean; // clean the array CONTENT of labels
103 procedure Close; // close the printer and print pending labels
104 procedure Open; // open the printer
105
106 end;
107
108 implementation
109
110 constructor TAlLabels.Create;
111 begin
112 RowsPerLabel := 1;
113 LabelsPerRow := 1;
114
115 LabelWidth := 0;
116 LabelWidthInch := 0;
117
118 LabelHeight := 0;
119 LabelHeightInch := 0;
120
121 TopMargin := 0;
122 TopMarginInch := 0;
123
124 LeftMargin := 0;
125 LeftMarginInch := 0;
126
127 Inches := True;
128
129 xWhichLabel := 0;
130 xBuffer := False;
131
132 end;
133
134 procedure TAlLabels.Open;
135 var
136 PixPerInX, PixPerInY, i: Integer;
137 begin
138 Printer.BeginDoc;
139 PixPerInX := getDeviceCaps(Printer.Handle, LOGPIXELSX);
140 PixPerInY := getDeviceCaps(Printer.Handle, LOGPIXELSY);
141 if Inches then
142 begin
143 LabelWidth := Trunc(LabelWidthInch * PixPerInX);
144 LabelHeight := Trunc(LabelHeightInch * PixPerInY);
145 LeftMargin := Trunc(LeftMarginInch * PixPerInX);
146 TopMargin := Trunc(TopMarginInch * PixPerInY);
147 end;
148 for i := 0 to LabelsPerRow - 1 do
149 TabsStop[i] := LeftMargin + LabelWidth * (i);
150 Clean;
151 end;
152
153 procedure TAlLabels.Close;
154 begin
155 PrintRow;
156 Printer.EndDoc;
157 end;
158
159 function TAlLabels.ReadLabxRow: Integer;
160 begin
161 Result := xLabelsPerRow;
162 end;
163
164 procedure TAlLabels.WriteLabxRow(const Value: Integer);
165 var
166 i: Integer;
167 begin
168 xLabelsPerRow := Value;
169
170 SetLength(TabsStop, Value);
171 for i := 0 to high(Content) do
172 SetLength(Content[i], Value);
173 Clean;
174 end;
175
176 function TAlLabels.ReadRowxLab: Integer;
177 begin
178 Result := xRowsPerLabel;
179 end;
180
181 procedure TAlLabels.WriteRowxLab(const Value: Integer);
182 begin
183 SetLength(Content, Value);
184 xRowsPerLabel := Value;
185 LabelsPerRow := LabelsPerRow; // to call the WriteLabxRow function
186 Clean;
187 end;
188
189 function TAlLabels.ReadFont: TFont;
190 begin
191 Result := Printer.Canvas.Font;
192 end;
193
194 procedure TAlLabels.WriteFont(const Value: TFont);
195 begin
196 Printer.Canvas.Font.Assign(Value);
197 end;
198
199 procedure TAlLabels.Clean;
200 var
201 i, j: Integer;
202 begin
203 for i := 0 to high(Content) do
204 for j := 0 to high(Content[i]) do
205 Content[i, j] := '';
206 xBuffer := False;
207 xWhichLabel := 0;
208 end;
209
210 procedure TAlLabels.Fill(xCont: array of string);
211 var
212 i: Integer;
213 begin
214 xBuffer := True;
215 if High(xCont) + 1 > RowsPerLabel then
216 RowsPerLabel := High(xCont) + 1;
217
218 for i := 0 to High(xCont) do
219 Content[i, xWhichLabel] := xCont[i];
220
221 inc(xWhichLabel);
222 if xWhichLabel >= LabelsPerRow then
223 begin
224 PrintRow();
225 end;
226 end;
227
228 procedure TAlLabels.PrintRow;
229 var
230 i, j, k, y, y1: Integer;
231 begin
232 if xBuffer then
233 begin
234 if Printer.Canvas.PenPos.y = 0 then
235 Printer.Canvas.MoveTo(0, TopMargin);
236
237 y := Printer.Canvas.PenPos.y;
238 y1 := y;
239
240 for i := 0 to RowsPerLabel - 1 do
241 begin
242 for j := 0 to xWhichLabel - 1 do
243 begin
244 Printer.Canvas.TextOut(TabsStop[j], y, Content[i, j]);
245 end;
246 inc(y, Printer.Canvas.Textheight('X'));
247 end;
248
249 k := LabelHeight + y1;
250 if k + LabelHeight > Printer.PageHeight then
251 Printer.NewPage
252 else
253 Printer.Canvas.MoveTo(0, LabelHeight + y1);
254 end;
255 Clean;
256
257 end;
258
259 end.
Component Download: http://www.baltsoft.com/files/dkb/attachment/ULabels.zip
|
