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
VCL-General
Language
Delphi 5.x
Views
91
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   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

			
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