1 | unit main;
|
---|
2 |
|
---|
3 | {$mode objfpc}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
|
---|
9 | StdCtrls, Spin, Buttons, ExtDlgs, ubarcodes;
|
---|
10 |
|
---|
11 | type
|
---|
12 |
|
---|
13 | { TMainForm }
|
---|
14 |
|
---|
15 | TMainForm = class(TForm)
|
---|
16 | BarcodesTree: TTreeView;
|
---|
17 | btnSaveToFile: TBitBtn;
|
---|
18 | btnCopyToClipboard: TBitBtn;
|
---|
19 | btnFont: TButton;
|
---|
20 | cbHumanReadableText: TCheckBox;
|
---|
21 | cbAddChecksum: TCheckBox;
|
---|
22 | cbDisplayChecksum: TCheckBox;
|
---|
23 | cbAutoSize: TCheckBox;
|
---|
24 | cbRecommendedSymbolSize: TCheckBox;
|
---|
25 | clbColor: TColorButton;
|
---|
26 | clbForeground: TColorButton;
|
---|
27 | cmbBearerBarsBox: TComboBox;
|
---|
28 | clbBackground: TColorButton;
|
---|
29 | edText: TEdit;
|
---|
30 | FontDialog: TFontDialog;
|
---|
31 | gbGeometry: TGroupBox;
|
---|
32 | gbShow: TGroupBox;
|
---|
33 | gbChecksum: TGroupBox;
|
---|
34 | gbColors: TGroupBox;
|
---|
35 | lblWhiteSpaceWidth: TLabel;
|
---|
36 | lblScale: TLabel;
|
---|
37 | lblError: TLabel;
|
---|
38 | lblMargin: TLabel;
|
---|
39 | lblText: TLabel;
|
---|
40 | lblSymbolHeight: TLabel;
|
---|
41 | nbOptions: TNotebook;
|
---|
42 | pgOptions_Plessey: TPage;
|
---|
43 | pgOptions_QR: TPage;
|
---|
44 | Panel1: TPanel;
|
---|
45 | Panel2: TPanel;
|
---|
46 | BarcodePanel: TPanel;
|
---|
47 | rgPlessey_Checkchar: TRadioGroup;
|
---|
48 | rgQR_ECCLevel: TRadioGroup;
|
---|
49 | SaveDialog1: TSaveDialog;
|
---|
50 | seWhiteSpaceWidth: TSpinEdit;
|
---|
51 | seScale: TSpinEdit;
|
---|
52 | seMargin: TSpinEdit;
|
---|
53 | seSymbolHeight: TSpinEdit;
|
---|
54 | btnSampleText: TSpeedButton;
|
---|
55 | Splitter1: TSplitter;
|
---|
56 | procedure BarcodeChange(Sender: TObject);
|
---|
57 | procedure BarcodesTreeChange(Sender: TObject; Node: TTreeNode);
|
---|
58 | procedure BarcodesTreeCustomDrawItem(Sender: TCustomTreeView;
|
---|
59 | Node: TTreeNode; {%H-}State: TCustomDrawState; var DefaultDraw: Boolean);
|
---|
60 | procedure btnCopyToClipboardClick(Sender: TObject);
|
---|
61 | procedure btnFontClick(Sender: TObject);
|
---|
62 | procedure btnSampleTextClick(Sender: TObject);
|
---|
63 | procedure btnSaveToFileClick(Sender: TObject);
|
---|
64 | procedure cbAutoSizeChange(Sender: TObject);
|
---|
65 | procedure cbRecommendedSymbolSizeChange(Sender: TObject);
|
---|
66 | procedure edTextChange(Sender: TObject);
|
---|
67 | procedure FormCreate(Sender: TObject);
|
---|
68 | procedure rgPlessey_CheckcharClick(Sender: TObject);
|
---|
69 | procedure rgQR_ECCLevelClick(Sender: TObject);
|
---|
70 | procedure SaveDialogTypeChange(Sender: TObject);
|
---|
71 | private
|
---|
72 | FBarCode: TLazBarcodeCustomText;
|
---|
73 | FFileName: String;
|
---|
74 | procedure PopulateBarcodesTree;
|
---|
75 | procedure SelectBarCode(ANode: TTreeNode);
|
---|
76 | procedure UpdateErrorMsg;
|
---|
77 |
|
---|
78 | public
|
---|
79 |
|
---|
80 | end;
|
---|
81 |
|
---|
82 | var
|
---|
83 | MainForm: TMainForm;
|
---|
84 |
|
---|
85 | implementation
|
---|
86 |
|
---|
87 | {$R *.lfm}
|
---|
88 |
|
---|
89 | uses
|
---|
90 | TypInfo;
|
---|
91 |
|
---|
92 | type
|
---|
93 | TLazBarcodeClass = class of TLazBarcodeCustomText;
|
---|
94 | TBarcodeAccess = class(TLazBarcodeCustomText);
|
---|
95 | TSimpleBarcodeAccess = class(TSimpleBarcode);
|
---|
96 |
|
---|
97 | { We must register all barcode classes because barcodes will be created in this
|
---|
98 | application based on a string containing the class name. }
|
---|
99 | procedure RegisterBarcodes;
|
---|
100 | begin
|
---|
101 | RegisterClass(TBarcodeC11);
|
---|
102 | RegisterClass(TBarcodeC128);
|
---|
103 | RegisterClass(TBarcode2of5);
|
---|
104 | RegisterClass(TBarcode3of9);
|
---|
105 | RegisterClass(TBarcodeEAN);
|
---|
106 | RegisterClass(TBarcodeChannelCode);
|
---|
107 | RegisterClass(TBarcodePlessey);
|
---|
108 | RegisterClass(TBarcodeTelepen);
|
---|
109 | RegisterClass(TBarcodeMedical);
|
---|
110 | RegisterClass(TBarcodePostal);
|
---|
111 | RegisterClass(TBarcodePDF417);
|
---|
112 |
|
---|
113 | RegisterClass(TBarcodeQR);
|
---|
114 | RegisterClass(TBarcodeMicroQR);
|
---|
115 | RegisterClass(TBarcodeAztec);
|
---|
116 | RegisterClass(TBarcodeAztecRune);
|
---|
117 | RegisterClass(TBarcodeDatamatrix);
|
---|
118 | end;
|
---|
119 |
|
---|
120 |
|
---|
121 | { TMainForm }
|
---|
122 |
|
---|
123 | procedure TMainForm.BarcodeChange(Sender: TObject);
|
---|
124 | begin
|
---|
125 | if FBarcode = nil then
|
---|
126 | exit;
|
---|
127 |
|
---|
128 | if Sender = seScale then
|
---|
129 | TBarcodeAccess(FBarcode).Scale := seScale.Value
|
---|
130 | else
|
---|
131 | if Sender = seMargin then
|
---|
132 | TBarcodeAccess(FBarcode).Margin := seMargin.Value
|
---|
133 | else
|
---|
134 | if Sender = seWhiteSpaceWidth then
|
---|
135 | TBarcodeAccess(FBarcode).WhiteSpaceWidth := seWhiteSpaceWidth.Value
|
---|
136 | else
|
---|
137 | if Sender = seSymbolHeight then
|
---|
138 | TBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value
|
---|
139 | else
|
---|
140 | if (Sender = cmbBearerBarsBox) then
|
---|
141 | TBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex)
|
---|
142 | else
|
---|
143 | if Sender = clbColor then
|
---|
144 | TBarcodeAccess(FBarcode).Color := clbColor.ButtonColor
|
---|
145 | else
|
---|
146 | if Sender = clbBackground then
|
---|
147 | TBarcodeAccess(FBarcode).BackgroundColor := clbBackground.ButtonColor
|
---|
148 | else
|
---|
149 | if Sender = clbForeground then
|
---|
150 | TBarcodeAccess(FBarcode).ForegroundColor := clbForeground.ButtonColor
|
---|
151 | else
|
---|
152 | if (Sender = cbHumanReadableText) and (FBarcode is TCustomBarcode) then
|
---|
153 | TBarcodeAccess(FBarcode).ShowHumanReadableText := cbHumanReadableText.Checked
|
---|
154 | else
|
---|
155 | if (Sender = cbAddChecksum) and (FBarcode is TSimpleBarcode) then
|
---|
156 | begin
|
---|
157 | TSimpleBarcodeAccess(FBarcode).AddChecksum := cbAddChecksum.Checked;
|
---|
158 | cbDisplayChecksum.Enabled := cbAddChecksum.Checked;
|
---|
159 | end
|
---|
160 | else
|
---|
161 | if (Sender = cbDisplayChecksum) and (FBarcode is TSimpleBarcode) then
|
---|
162 | TSimpleBarcodeAccess(FBarcode).DisplayChecksum := cbDisplayChecksum.Checked;
|
---|
163 | end;
|
---|
164 |
|
---|
165 | procedure TMainForm.btnSampleTextClick(Sender: TObject);
|
---|
166 | begin
|
---|
167 | if FBarCode <> nil then
|
---|
168 | begin
|
---|
169 | FBarcode.SampleText;
|
---|
170 | edText.Text := FBarcode.Text;
|
---|
171 | end;
|
---|
172 | end;
|
---|
173 |
|
---|
174 | procedure TMainForm.BarcodesTreeChange(Sender: TObject; Node: TTreeNode);
|
---|
175 | begin
|
---|
176 | SelectBarcode(Node);
|
---|
177 | end;
|
---|
178 |
|
---|
179 | procedure TMainForm.BarcodesTreeCustomDrawItem(Sender: TCustomTreeView;
|
---|
180 | Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
|
---|
181 | begin
|
---|
182 | if (Node.HasChildren) or (Node.Level = 0) then
|
---|
183 | Sender.Canvas.Font.Style := [fsBold]
|
---|
184 | else
|
---|
185 | Sender.Canvas.Font.Style := [];
|
---|
186 | DefaultDraw := true;
|
---|
187 | end;
|
---|
188 |
|
---|
189 | procedure TMainForm.btnCopyToClipboardClick(Sender: TObject);
|
---|
190 | begin
|
---|
191 | FBarcode.CopyToClipboard;
|
---|
192 | end;
|
---|
193 |
|
---|
194 | procedure TMainForm.btnFontClick(Sender: TObject);
|
---|
195 | begin
|
---|
196 | FontDialog.Font.Assign(FBarcode.Font);
|
---|
197 | if FontDialog.Execute then
|
---|
198 | FBarcode.Font.Assign(FontDialog.Font);
|
---|
199 | end;
|
---|
200 |
|
---|
201 | procedure TMainForm.btnSaveToFileClick(Sender: TObject);
|
---|
202 | begin
|
---|
203 | with TSaveDialog.Create(self) do
|
---|
204 | try
|
---|
205 | Filter := 'Windows bitmap files (*.bmp)|*.bmp|' +
|
---|
206 | 'Portable network graphic files (*.png)|*.png|' +
|
---|
207 | 'JPEG image files (*.jpg;*.jpeg)|*.jpg;*.jpeg|' +
|
---|
208 | 'TIFF image files (*.tiff; *.tif)|*.tiff;*.tif|'+
|
---|
209 | 'XPM image files (*.xpm)|*.xpm|' +
|
---|
210 | 'Scalable vector graphics files (*.svg)|*.svg|'+
|
---|
211 | 'Encapsulated PostScript files (*.eps;*.ps)|*.eps;*.ps|'+
|
---|
212 | 'All files (*.*)|*.*';
|
---|
213 | FilterIndex := 2;
|
---|
214 | DefaultExt := '.png';
|
---|
215 | InitialDir := ExtractFileName(FFileName);
|
---|
216 | OnTypeChange := @SaveDialogTypeChange;
|
---|
217 | if Execute then
|
---|
218 | begin
|
---|
219 | FFileName := FileName;
|
---|
220 | case lowercase(ExtractFileExt(FFileName)) of
|
---|
221 | '.bmp':
|
---|
222 | FBarcode.SaveToFile(FFileName, TBitmap);
|
---|
223 | '.png':
|
---|
224 | FBarcode.SaveToFile(FFileName, TPortableNetworkGraphic);
|
---|
225 | '.jpg', '.jpeg':
|
---|
226 | FBarcode.SaveTofile(FFileName, TJpegImage);
|
---|
227 | '.tif', '.tiff':
|
---|
228 | FBarcode.SaveToFile(FFileName, TTiffImage);
|
---|
229 | '.xpm':
|
---|
230 | FBarcode.SaveToFile(FFileName, TPixmap);
|
---|
231 | '.svg':
|
---|
232 | FBarcode.SaveToSvgFile(FFileName);
|
---|
233 | '.eps', '.ps':
|
---|
234 | Fbarcode.SaveToEpsFile(FFileName);
|
---|
235 | else
|
---|
236 | raise Exception.Create('Image type not supported.');
|
---|
237 | end;
|
---|
238 | end;
|
---|
239 | finally
|
---|
240 | Free;
|
---|
241 | end;
|
---|
242 | end;
|
---|
243 |
|
---|
244 | procedure TMainForm.cbAutoSizeChange(Sender: TObject);
|
---|
245 | begin
|
---|
246 | if Assigned(FBarcode) then
|
---|
247 | begin
|
---|
248 | FBarcode.AutoSize := cbAutoSize.Checked;
|
---|
249 | if FBarcode.AutoSize then
|
---|
250 | begin
|
---|
251 | FBarcode.Align := alNone;
|
---|
252 | FBarcode.AnchorSideLeft.Control := FBarcode.Parent;
|
---|
253 | FBarcode.AnchorSideLeft.Side := asrCenter;
|
---|
254 | FBarcode.AnchorSideTop.Control := FBarcode.Parent;
|
---|
255 | FBarcode.AnchorSideTop.Side := asrCenter;
|
---|
256 | end else
|
---|
257 | begin
|
---|
258 | FBarcode.AnchorSideLeft.Control := nil;
|
---|
259 | FBarcode.AnchorSideTop.Control := nil;
|
---|
260 | FBarcode.Align := alClient;
|
---|
261 | end;
|
---|
262 | end;
|
---|
263 | end;
|
---|
264 |
|
---|
265 | procedure TMainForm.cbRecommendedSymbolSizeChange(Sender: TObject);
|
---|
266 | begin
|
---|
267 | seScale.Enabled := not cbRecommendedSymbolSize.Checked;
|
---|
268 | lblScale.Enabled := seScale.Enabled;
|
---|
269 | seMargin.Enabled := not cbRecommendedSymbolSize.Checked;
|
---|
270 | lblMargin.Enabled := seMargin.Enabled;
|
---|
271 | seWhitespaceWidth.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'WhiteSpaceWidth');
|
---|
272 | lblWhitespaceWidth.Enabled := seWhitespaceWidth.Enabled;
|
---|
273 | seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'SymbolHeight');
|
---|
274 | lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
|
---|
275 | cmbBearerBarsBox.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'BearerBarMode');
|
---|
276 | if FBarcode is TSimpleBarcode then
|
---|
277 | begin
|
---|
278 | TSimpleBarcode(FBarcode).RecommendedSymbolSize := cbRecommendedSymbolSize.Checked;
|
---|
279 | if not cbRecommendedSymbolSize.Checked then
|
---|
280 | begin
|
---|
281 | TSimpleBarcode(FBarcode).Scale := seScale.Value;
|
---|
282 | TSimpleBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value;
|
---|
283 | TSimpleBarcode(FBarcode).Margin := seMargin.Value;
|
---|
284 | TSimpleBarcodeAccess(FBarcode).WhitespaceWidth := seWhiteSpaceWidth.Value;
|
---|
285 | TSimpleBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex);
|
---|
286 | end;
|
---|
287 | end else
|
---|
288 | if FBarcode is TBarcodePDF417 then
|
---|
289 | begin
|
---|
290 | seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked;
|
---|
291 | lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
|
---|
292 | end;
|
---|
293 | end;
|
---|
294 |
|
---|
295 | procedure TMainForm.FormCreate(Sender: TObject);
|
---|
296 | begin
|
---|
297 | nbOptions.PageIndex := -1;
|
---|
298 | PopulateBarcodesTree;
|
---|
299 | end;
|
---|
300 |
|
---|
301 | procedure TMainForm.rgPlessey_CheckcharClick(Sender: TObject);
|
---|
302 | begin
|
---|
303 | if FBarcode is TBarcodePlessey then
|
---|
304 | TBarcodePlessey(FBarcode).CheckChar := TPlesseyCheckChar(rgPlessey_CheckChar.ItemIndex);
|
---|
305 | end;
|
---|
306 |
|
---|
307 | procedure TMainForm.rgQR_ECCLevelClick(Sender: TObject);
|
---|
308 | begin
|
---|
309 | if FBarcode is TBarcodeQR then
|
---|
310 | TBarcodeQR(FBarcode).ECCLevel := TBarcodeQR_ECCLevel(rgQR_ECCLevel.ItemIndex);
|
---|
311 | end;
|
---|
312 |
|
---|
313 | procedure TMainForm.SaveDialogTypeChange(Sender: TObject);
|
---|
314 | var
|
---|
315 | dlg: TSaveDialog;
|
---|
316 | L: TStrings;
|
---|
317 | idx: Integer;
|
---|
318 | begin
|
---|
319 | dlg := Sender as TSaveDialog;
|
---|
320 | L := TStringList.Create;
|
---|
321 | try
|
---|
322 | L.StrictDelimiter := true;
|
---|
323 | L.Delimiter := '|';
|
---|
324 | L.DelimitedText := dlg.Filter;
|
---|
325 | idx := (dlg.FilterIndex - 1) * 2 + 1;
|
---|
326 | dlg.DefaultExt := ExtractfileExt(L[idx]);
|
---|
327 | finally
|
---|
328 | L.Free;
|
---|
329 | end;
|
---|
330 | end;
|
---|
331 |
|
---|
332 | procedure TMainForm.edTextChange(Sender: TObject);
|
---|
333 | begin
|
---|
334 | FBarcode.Text := edText.Text;
|
---|
335 | UpdateErrorMsg;
|
---|
336 | end;
|
---|
337 |
|
---|
338 | procedure TMainForm.PopulateBarcodesTree;
|
---|
339 | var
|
---|
340 | node, child: TTreeNode;
|
---|
341 | begin
|
---|
342 | with BarcodesTree do begin
|
---|
343 | Items.BeginUpdate;
|
---|
344 | try
|
---|
345 | Items.Clear;
|
---|
346 |
|
---|
347 | node := Items.AddChild(nil, '1-dimensional barcodes');
|
---|
348 | child := Items.AddChildObject(node, 'Code 11', PChar('TBarcodeC11'));
|
---|
349 | child := Items.AddChildObject(node, 'Code 128 and related', PChar('TBarcodeC128'));
|
---|
350 | Items.AddChildObject(child, 'Code-128', Pointer(PtrInt(bctCode128)));
|
---|
351 | Items.AddChildObject(child, 'EAN-128', Pointer(PtrInt(bctEAN128)));
|
---|
352 | child := Items.AddChildObject(node, '2-of-5 codes', PChar('TBarcode2of5'));
|
---|
353 | Items.AddChildObject(child, 'Standard 2-of-5', Pointer(PtrInt(bctCode25Standard)));
|
---|
354 | Items.AddChildObject(child, 'Data Logic 2-of-5', Pointer(PtrInt(bctCode25DataLogic)));
|
---|
355 | Items.AddChildObject(child, 'IATA 2-of-5', Pointer(PtrInt(bctCode25IATA)));
|
---|
356 | Items.AddChildObject(child, 'Industrial 2-of-5', Pointer(PtrInt(bctCode25Industrial)));
|
---|
357 | Items.AddChildObject(child, 'Interleaved 2-of-5', Pointer(PtrInt(bctCode25Interleaved)));
|
---|
358 | Items.AddChildObject(child, 'ITF-14', Pointer(PtrInt(bctITF14)));
|
---|
359 | child := Items.AddChildObject(node, '3-of-9 codes', PChar('TBarcode3of9'));
|
---|
360 | Items.AddChildObject(child, 'Code 3-of-9 (C39)', Pointer(ptrInt(bctCode39)));
|
---|
361 | Items.AddChildObject(child, 'Code 3-of-9 extended (C39+)', Pointer(PtrInt(bctCode39Ext)));
|
---|
362 | Items.AddChildObject(child, 'LOGMARS', Pointer(PtrInt(bctLOGMARS)));
|
---|
363 | Items.AddChildObject(child, 'Code 93', Pointer(PtrInt(bctCode93)));
|
---|
364 | child := Items.AddChildObject(node, 'Channel code', PChar('TBarcodeChannelCode'));
|
---|
365 | child := Items.AddChildObject(node, 'UPC/EAN codes', PChar('TBarcodeEAN'));
|
---|
366 | Items.AddChildObject(child, 'EAN-8, EAN-13', Pointer(PtrInt(bctEAN)));
|
---|
367 | Items.AddChildObject(child, 'EAN-14', Pointer(PtrInt(bctEAN14)));
|
---|
368 | Items.AddChildObject(child, 'ISBN', Pointer(PtrInt(bctISBN)));
|
---|
369 | Items.AddChildObject(child, 'NVE-18', Pointer(PtrInt(bctNVE18)));
|
---|
370 | Items.AddChildObject(child, 'UPC-A', Pointer(PtrInt(bctUPCA)));
|
---|
371 | Items.AddChildObject(child, 'UPC-E', Pointer(PtrInt(bctUPCE)));
|
---|
372 | child := Items.AddChildObject(node, 'MSI/Plessey', PChar('TBarcodePlessey'));
|
---|
373 | Items.AddChildObject(child, 'Plessey', Pointer(PtrInt(bctPlessey)));
|
---|
374 | Items.AddChildObject(child, 'MSI/Plessey', Pointer(PtrInt(bctMSIPlessey)));
|
---|
375 | child := Items.AddChildObject(node, 'Telepen', PChar('TBarcodeTelepen'));
|
---|
376 | Items.AddChildObject(child, 'Telepen', Pointer(PtrInt(bctTelepen)));
|
---|
377 | Items.AddChildObject(child, 'Telepen numeric', Pointer(PtrInt(bctTelepenNum)));
|
---|
378 | child := Items.AddChildObject(node, 'Medical/pharmaceutical', PChar('TBarcodeMedical'));
|
---|
379 | Items.AddChildObject(child, 'CodaBar', Pointer(PtrInt(bctCodaBar)));
|
---|
380 | Items.AddChildObject(child, 'Code32', Pointer(PtrInt(bctCode32)));
|
---|
381 | Items.AddChildObject(child, 'Pharma one-track', Pointer(PtrInt(bctPharmaOne)));
|
---|
382 | Items.AddChildObject(child, 'Pharma two-track', Pointer(PtrInt(bctPharmaTwo)));
|
---|
383 | Items.AddChildObject(child, 'Pharmazentralnummer (7-digit)', Pointer(PtrInt(bctPZN7)));
|
---|
384 | Items.AddChildObject(child, 'Pharmazentralnummer (8-digit)', Pointer(PtrInt(bctPZN8)));
|
---|
385 | child := Items.AddChildObject(node, 'Postal barcodes', PChar('TBarcodePostal'));
|
---|
386 | Items.AddChildObject(child, 'Australia Post Customer', Pointer(PtrInt(bctAustraliaPostCustomer)));
|
---|
387 | Items.AddChildObject(child, 'Australia Post Reply Paid', Pointer(PtrInt(bctAustraliaPostReplyPaid)));
|
---|
388 | Items.AddChildObject(child, 'Australia Post Routing', Pointer(PtrInt(bctAustraliaPostRoute)));
|
---|
389 | Items.AddChildObject(child, 'Australia Post Redirection', Pointer(PtrInt(bctAustraliaPostRedirect)));
|
---|
390 | Items.AddChildObject(child, 'DAFT', Pointer(PtrInt(bctDaft)));
|
---|
391 | Items.AddChildObject(child, 'Deutsche Post IdentCode', Pointer(PtrInt(bctDeutschePostIdentCode)));
|
---|
392 | Items.AddChildObject(child, 'Deutsche Post LeitCode', Pointer(PtrInt(bctDeutschePostLeitCode)));
|
---|
393 | Items.AddChildObject(child, 'FIM (Face Identification Mark)', Pointer(PtrInt(bctFIM)));
|
---|
394 | Items.AddChildObject(child, 'Japanese Post', Pointer(PtrInt(bctJapanPost)));
|
---|
395 | Items.AddChildObject(child, 'KIX', Pointer(PtrInt(bctKix)));
|
---|
396 | Items.AddChildObject(child, 'Korea Post', Pointer(PtrInt(bctKoreaPost)));
|
---|
397 | Items.AddChildObject(child, 'Planet', Pointer(PtrInt(bctPlanet)));
|
---|
398 | Items.AddChildObject(child, 'PostNet', Pointer(PtrInt(bctPostNet)));
|
---|
399 | Items.AddChildObject(child, 'Royal Mail RM4SCC', Pointer(PtrInt(bctRM4SCC)));
|
---|
400 |
|
---|
401 | node := Items.AddChild(nil, '2-dimensional barcodes');
|
---|
402 | child := Items.AddChildObject(node, 'QR Code', PChar('TBarcodeQR'));
|
---|
403 | child := Items.AddChildObject(node, 'Micro QR', PChar('TBarcodeMicroQR'));
|
---|
404 | child := Items.AddChildObject(node, 'Aztec', PChar('TBarcodeAztec'));
|
---|
405 | child := Items.AddChildObject(node, 'Aztec Rune', PChar('TBarcodeAztecRune'));
|
---|
406 | child := Items.AddChildObject(node, 'Data Matrix', PChar('TBarcodeDataMatrix'));
|
---|
407 | child := Items.AddChildObject(node, 'PDF417 variants', PChar('TBarcodePDF417'));
|
---|
408 | Items.AddChildObject(child, 'PDF417', Pointer(PtrInt(bctPDF417)));
|
---|
409 | Items.AddChildObject(child, 'Compact PDF417', Pointer(PtrInt(bctPDF417trunc)));
|
---|
410 | Items.AddChildObject(child, 'MicroPDF417 (ISO 24728)', Pointer(PtrInt(bctMicroPDF417)));
|
---|
411 |
|
---|
412 | FullExpand;
|
---|
413 | finally
|
---|
414 | Items.EndUpdate;
|
---|
415 | end;
|
---|
416 | end;
|
---|
417 | end;
|
---|
418 |
|
---|
419 | procedure TMainForm.SelectBarcode(ANode: TTreeNode);
|
---|
420 | var
|
---|
421 | barcodeClassName: String;
|
---|
422 | barcodeClass: TLazBarcodeClass;
|
---|
423 | barcodeType: Integer;
|
---|
424 | begin
|
---|
425 | if (ANode = nil) then
|
---|
426 | begin
|
---|
427 | if FBarcode <> nil then FBarcode.Hide;
|
---|
428 | exit;
|
---|
429 | end;
|
---|
430 |
|
---|
431 | FreeAndNil(FBarcode);
|
---|
432 |
|
---|
433 | // Determine from the node's Data field the class of the barcode to be created
|
---|
434 | // and/or the value of the BarcodeType property.
|
---|
435 | if (ANode.Level = 1) and not ANode.HasChildren then
|
---|
436 | barcodeClassName := PChar(ANode.Data)
|
---|
437 | else
|
---|
438 | if (ANode.Level = 2) then
|
---|
439 | begin
|
---|
440 | barcodeClassName := PChar(ANode.Parent.Data);
|
---|
441 | barcodeType := {%H-}PtrInt(ANode.Data);
|
---|
442 | end else
|
---|
443 | begin
|
---|
444 | if FBarcode <> nil then FBarcode.Hide;
|
---|
445 | exit;
|
---|
446 | end;
|
---|
447 |
|
---|
448 | // Create barcode from information provided in the node's Data field.
|
---|
449 | barcodeClass := TLazBarcodeClass(GetClass(barcodeClassName));
|
---|
450 | FBarcode := barcodeClass.Create(self);
|
---|
451 | FBarcode.Parent := BarcodePanel;
|
---|
452 |
|
---|
453 | // Apply general properties
|
---|
454 | FBarcode.Text := edText.Text;
|
---|
455 | TBarcodeAccess(FBarcode).Color := clbColor.ButtonColor;
|
---|
456 | TBarcodeAccess(FBarcode).BackgroundColor := clbBackground.ButtonColor;
|
---|
457 | TBarcodeAccess(FBarcode).ForegroundColor := clbForeground.ButtonColor;
|
---|
458 | TBarcodeAccess(FBarcode).Scale := seScale.Value;
|
---|
459 | TBarcodeAccess(FBarcode).Margin := seMargin.Value;
|
---|
460 | TBarcodeAccess(FBarcode).WhiteSpaceWidth := seWhitespaceWidth.Value;
|
---|
461 | TBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex);
|
---|
462 | TBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value;
|
---|
463 | TBarcodeAccess(FBarcode).RecommendedSymbolSize := cbRecommendedSymbolSize.Checked;
|
---|
464 |
|
---|
465 | // Apply specific properties for each barcode class - not very elegant...
|
---|
466 | if (FBarcode is TCustomBarcode) then
|
---|
467 | TBarcodeAccess(FBarcode).ShowHumanReadableText := cbHumanReadableText.Checked;
|
---|
468 |
|
---|
469 | if (FBarcode is TSimpleBarCode) then
|
---|
470 | begin
|
---|
471 | TSimpleBarcodeAccess(FBarcode).AddChecksum := cbAddChecksum.Checked;
|
---|
472 | cbAddChecksum.Enabled := IsPublishedProp(FBarcode, 'AddChecksum');
|
---|
473 | TSimpleBarcodeAccess(FBarcode).DisplayChecksum := cbDisplayChecksum.Checked;
|
---|
474 | cbDisplayChecksum.Enabled := cbAddChecksum.Checked and IsPublishedProp(FBarcode, 'DisplayChecksum');
|
---|
475 | if (ANode.Level = 2) then
|
---|
476 | TSimpleBarcodeAccess(FBarcode).BarcodeType := TBarcodeType(barcodeType);
|
---|
477 | end;
|
---|
478 |
|
---|
479 | cbAutoSizeChange(nil);
|
---|
480 |
|
---|
481 | // Show options page corresponding to the selected barcode type.
|
---|
482 | if (FBarcode is TBarcodePlessey) and (TBarcodePlessey(FBarcode).BarcodeType = bctMSIPlessey) then
|
---|
483 | nbOptions.PageIndex := pgOptions_Plessey.PageIndex
|
---|
484 | else
|
---|
485 | if (FBarcode is TBarcodeQR) then
|
---|
486 | nbOptions.PageIndex := pgOptions_QR.PageIndex
|
---|
487 | else
|
---|
488 | nbOptions.PageIndex := -1;
|
---|
489 |
|
---|
490 | // Enable/disable GUI components
|
---|
491 | cbHumanReadableText.Enabled := not ((FBarcode is TBarcodeSquare) or (FBarcode is TBarcodePDF417));
|
---|
492 | btnFont.Enabled := cbHumanReadableText.Enabled;
|
---|
493 | seWhiteSpaceWidth.Enabled := IsPublishedProp(FBarcode, 'WhiteSpaceWidth') and not cbRecommendedSymbolSize.Checked;
|
---|
494 | lblWhitespaceWidth.Enabled := seWhiteSpaceWidth.Enabled;
|
---|
495 | if FBarcode is TBarcodePDF417 then
|
---|
496 | begin
|
---|
497 | seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked;
|
---|
498 | lblSymbolHeight.Caption := 'Row height ratio';
|
---|
499 | end else
|
---|
500 | begin
|
---|
501 | seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'SymbolHeight');
|
---|
502 | lblSymbolHeight.Caption := 'Symbol height';
|
---|
503 | end;
|
---|
504 | lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
|
---|
505 |
|
---|
506 | // Show error message from rendering, if available.
|
---|
507 | UpdateErrorMsg;
|
---|
508 | end;
|
---|
509 |
|
---|
510 | procedure TMainForm.UpdateErrorMsg;
|
---|
511 | begin
|
---|
512 | lblError.Visible := FBarcode.ErrorString <> '';
|
---|
513 | lblError.Caption := FBarcode.ErrorString;
|
---|
514 | if FBarcode <> nil then
|
---|
515 | FBarcode.Visible := not lblError.Visible;
|
---|
516 | end;
|
---|
517 |
|
---|
518 | initialization
|
---|
519 | RegisterBarcodes;
|
---|
520 |
|
---|
521 | end.
|
---|
522 |
|
---|