1 unit unitmain;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
9 Buttons, Printers;
10
11 type
12
13 { TForm1 }
14
15 TForm1 = class(TForm)
16 Button1: TButton;
17 btnZPL: TButton;
18 Label1: TLabel;
19 Label2: TLabel;
20 Label3: TLabel;
21 ListBox1: TListBox;
22 Memo1: TMemo;
23 procedure btnZPLClick(Sender: TObject);
24 procedure Button1Click(Sender: TObject);
25 procedure FormCreate(Sender: TObject);
26 private
27 { private declarations }
28 procedure PrintString(S:String);
29 procedure PrintStream(St:TStream);
30 procedure PrintSample;
31 procedure PrintZebraSample;
SetCurrentPrinternull32 function SetCurrentPrinter: boolean;
33 public
34 { public declarations }
35 end;
36
37 var
38 Form1: TForm1;
39
40 implementation
41
42 {$R *.lfm}
43
44 const
45 CRLF = #13#10;
46
47 { TForm1 }
48
49 procedure TForm1.FormCreate(Sender: TObject);
50 begin
51 // fill in the printer list
52 Listbox1.Items.Assign(Printer.Printers);
53 end;
54
55 procedure TForm1.PrintString(S: String);
56 var
57 Written: Integer;
58 begin
59 Printer.Write(S[1], Length(S), Written);
60 end;
61
62 const
63 MaxBufSize = 256;
64
65 procedure TForm1.PrintStream(St: TStream);
66 var
67 Written: Integer;
68 Buffer: array[0..MaxBufSize-1] of byte;
69 begin
70 while St.Position<St.Size do begin
71 Written := St.Read(Buffer, MaxBufSize);
72 Printer.Write(Buffer, Written, Written);
73 end;
74 end;
75
76 procedure TForm1.PrintSample;
77 var
78 S: TStringStream;
79 begin
80 // print a plain string
81 PrintString('=== FIRST A STRING ==='+LineEnding);
82 PrintString(Memo1.Text);
83 PrintString('=== NOW USING A STREAM ==='+LineEnding);
84 // print using a stream
85 S := TStringStream.Create(Memo1.Text);
86 PrintStream(S);
87 S.Free;
88 end;
89
90 procedure TForm1.PrintZebraSample;
91 var
92 s: String;
93 begin
94 // sample code taken from the Online ZPL viewer
95 // http://labelary.com/viewer.html
96 s :=
97 '^XA' + CRLF +
98 '^FX Top section with company logo, name and address.' + CRLF +
99 '^CF0,60' + CRLF +
100 '^FO50,50^GB100,100,100^FS' + CRLF +
101 '^FO75,75^FR^GB100,100,100^FS' + CRLF +
102 '^FO88,88^GB50,50,50^FS' + CRLF +
103 '^FO220,50^FDInternational Shipping, Inc.^FS' + CRLF +
104 '^CF0,40' + CRLF +
105 '^FO220,100^FD1000 Shipping Lane^FS' + CRLF +
106 '^FO220,135^FDShelbyville TN 38102^FS' + CRLF +
107 '^FO220,170^FDUnited States (USA)^FS' + CRLF +
108 '^FO50,250^GB700,1,3^FS' + CRLF +
109 '^FX Second section with recipient address and permit information.' + CRLF +
110 '^CFA,30' + CRLF +
111 '^FO50,300^FDJohn Doe^FS' + CRLF +
112 '^FO50,340^FD100 Main Street^FS' + CRLF +
113 '^FO50,380^FDSpringfield TN 39021^FS' + CRLF +
114 '^FO50,420^FDUnited States (USA)^FS' + CRLF +
115 '^CFA,15' + CRLF +
116 '^FO600,300^GB150,150,3^FS' + CRLF +
117 '^FO638,340^FDPermit^FS' + CRLF +
118 '^FO638,390^FD123456^FS' + CRLF +
119 '^FO50,500^GB700,1,3^FS' + CRLF +
120 '^FX Third section with barcode.' + CRLF +
121 '^BY5,2,270' + CRLF +
122 '^FO100,550^BC^FD12345678^FS' + CRLF +
123 '^FX Fourth section (the two boxes on the bottom).' + CRLF +
124 '^FO50,900^GB700,250,3^FS' + CRLF +
125 '^FO400,900^GB1,250,3^FS' + CRLF +
126 '^CF0,40' + CRLF +
127 '^FO100,960^FDShipping Ctr. X34B-1^FS' + CRLF +
128 '^FO100,1010^FDREF1 F00B47^FS' + CRLF +
129 '^FO100,1060^FDREF2 BL4H8^FS' + CRLF +
130 '^CF0,190' + CRLF +
131 '^FO485,965^FDCA^FS' + CRLF +
132 '^XZ' + CRLF;
133 PrintString(s);
134 end;
135
TForm1.SetCurrentPrinternull136 function TForm1.SetCurrentPrinter: boolean;
137 begin
138 result := false;
139 if Listbox1.ItemIndex<0 then begin
140 ShowMessage('Select a printer from the list');
141 exit;
142 end;
143
144 // on a freshly retrieved printer list, either method could
145 // be used to select a printer: SetPrinter or PrinterIndex
146 //Printer.PrinterIndex := Listbox1.ItemIndex;
147 Printer.SetPrinter(ListBox1.Items[Listbox1.ItemIndex]);
148 result := true;
149 end;
150
151 procedure TForm1.Button1Click(Sender: TObject);
152 begin
153 if not SetCurrentPrinter then
154 exit;
155
156 Printer.Title := Caption;
157 Printer.RawMode := True;
158 Printer.BeginDoc;
159 PrintSample;
160 Printer.EndDoc;
161 end;
162
163 procedure TForm1.btnZPLClick(Sender: TObject);
164 begin
165 if not SetCurrentPrinter then
166 exit;
167
168 Printer.Title := 'Zebra test';
169 Printer.RawMode := True;
170 Printer.BeginDoc;
171 PrintZebraSample;
172 Printer.EndDoc;
173 end;
174
175 end.
176
177