/
RLBarcode.pas
2296 lines (2176 loc) · 76.6 KB
/
RLBarcode.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{******************************************************************************}
{ Projeto: FortesReport Community Edition }
{ É um poderoso gerador de relatórios disponível como um pacote de componentes }
{ para Delphi. Em FortesReport, os relatórios são constituídos por bandas que }
{ têm funções específicas no fluxo de impressão. Você definir agrupamentos }
{ subníveis e totais simplesmente pela relação hierárquica entre as bandas. }
{ Além disso possui uma rica paleta de Componentes }
{ }
{ Direitos Autorais Reservados(c) Copyright © 1999-2015 Fortes Informática }
{ }
{ Colaboradores nesse arquivo: Ronaldo Moreira }
{ Márcio Martins }
{ Régys Borges da Silveira }
{ Juliomar Marchetti }
{ }
{ Você pode obter a última versão desse arquivo na pagina do Projeto }
{ localizado em }
{ https://github.com/fortesinformatica/fortesreport-ce }
{ }
{ Para mais informações você pode consultar o site www.fortesreport.com.br ou }
{ no Yahoo Groups https://groups.yahoo.com/neo/groups/fortesreport/info }
{ }
{ Esta biblioteca é software livre; você pode redistribuí-la e/ou modificá-la }
{ sob os termos da Licença Pública Geral Menor do GNU conforme publicada pela }
{ Free Software Foundation; tanto a versão 2.1 da Licença, ou (a seu critério) }
{ qualquer versão posterior. }
{ }
{ Esta biblioteca é distribuída na expectativa de que seja útil, porém, SEM }
{ NENHUMA GARANTIA; nem mesmo a garantia implícita de COMERCIABILIDADE OU }
{ ADEQUAÇÃO A UMA FINALIDADE ESPECÍFICA. Consulte a Licença Pública Geral Menor}
{ do GNU para mais detalhes. (Arquivo LICENÇA.TXT ou LICENSE.TXT) }
{ }
{ Você deve ter recebido uma cópia da Licença Pública Geral Menor do GNU junto}
{ com esta biblioteca; se não, escreva para a Free Software Foundation, Inc., }
{ no endereço 59 Temple Street, Suite 330, Boston, MA 02111-1307 USA. }
{ Você também pode obter uma copia da licença em: }
{ http://www.opensource.org/licenses/gpl-license.php }
{ }
{******************************************************************************}
{******************************************************************************
|* Historico
|*
|* xx/xx/xxxx: Autor...
|* - Descrição...
******************************************************************************}
{$I RLReport.inc}
{@unit RLBarcode - Implementação dos componentes para código de barras. }
unit RLBarcode;
interface
uses
{$IfDef MSWINDOWS}
{$IfNDef FPC}
Windows,
{$EndIf}
{$EndIf}
Classes, SysUtils, DB,
{$IfDef CLX}
QTypes, QGraphics, QDialogs,
{$Else}
Types, Graphics, Dialogs,
{$EndIf}
{$IfDef FPC}
LCLIntf,
{$EndIf}
RLReport, RLConsts;
type
{@type TRLBarcodeType - Padrão de codificação para o código de barras.
Pode ser um dos seguintes valores:
bcCode2OF5Interleaved - Código 25, também conhecido como "Código 2 de 5". É
utilizado sobretudo no manuseio de inventários, em fichas de compensação
bancária, na identificação de envelopes de acabamento de fotografias, em
passagens aéreas, no manuseio de bagagens e cargas e em dezenas de outras
aplicações. É um formato de código distinto, de comprimento variável e
consiste em duas barras espessas em um total de cinco barras para cada
caractere codificado. O código deve ter comprimento par;
bcCode2OF5Industry - ITF ou "Entrelaçado de 2 de 5". Esse código de barras é um
dos formatos mais populares utilizados pelas indústrias de transporte e de
armazenamento e foi desenvolvido com base no Código 25. Ambos os formatos
utilizam as mesmas técnicas de codificação, exceto que, no formato ITF,
tanto as barras quanto os espaços transportam dados. Os dígitos de posição
ímpar são codificados nas barras e os dígitos de posição par são codificados
nos espaços. O ITF é um formato de alta densidade, de comprimento variável,
exclusivamente numérico;
bcCode2OF5Matrix - ver bcCode2OF5Industry;
bcCode39 - Código 39, também conhecido como "Código 3 de 9", é o formato mais
popular utilizado em inventário e controle não varejista. O formato consiste
em três elementos espessos (barras ou espaços) em um totalizado em manufatura,
aplicações militares e de saúde. O formato distinto de comprimento variável
aceita os 44 caracteres seguintes: 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.*$/+%. O
asterisco (*) é utilizado como caractere de início/parada, não podendo ser
utilizado no corpo da mensagem. Você também pode adicionar um dígito de verificação
que ajude a garantir a segurança do código de barras. O Código 39 suporta os
formatos de dígito de verificação Módulo 43 e xxx-nnnnnnn-c utilizados pela
alfândega dos E.U.A. para remessas de importação/exportação e em dezenas de
outras aplicações;
bcCode39Extended - O código extendido 39 foi desenvolvido para proporcionar
meios de codificar os caracteres adicionais que não são normalmente parte
do conjunto de caracteres do código 39 (caracteres minúsculos e símbolos). Os
caracteres extendidos são codificados por um par de caracteres normais do
código 39; por exemplo, uma minúscula "a" (que não faz parte do conjunto de
caracteres do código 39) pode ser codificado pelo par "+A". Um código de controle
de retorno do carro pode ser codificado pelo par "#";
bcCode128A - Código 128 é um formato alfanumérico de alta densidade e comprimento
variável utilizado na indústria de transporte e etiquetagem. Esse código possui
106 padrões de barras e espaços. Cada padrão pode ter três significados, dependendo
de qual dos três conjuntos de caracteres é empregado. Um conjunto de caracteres
codifica todos os caracteres de controle ASCII e maiúsculos, um outro codifica
todos os caracteres maiúsculos e minúsculos e o terceiro conjunto codifica os
pares de dígitos numéricos de 00 a 99. O conjunto de caracteres utilizado é
determinado pelo caractere inicial. O Código 128 também permite codificar quatro
códigos de função:
FNC1 - reservado para uso em EAN (European Article Numbering);
FNC2 - utilizado para instruir o leitor de código de barras na concatenação da
mensagem em um símbolo de código de barras com a mensagem no símbolo de texto;
FNC3 - utilizado para instruir o leitor de código de barras a efetuar uma redefinição;
FNC4 - utilizado em aplicações de sistemas fechados.
Uma variação do formato Código 128 é o EAN 128. Esse símbolo utiliza o mesmo
conjunto de códigos que o Código 128, mas os códigos de função de FNC2 a FNC4
não podem ser utilizados e FNC1 é utilizado como parte do código inicial;
bcCode128B - ver bcCode128A;
bcCode128C - ver bcCode128A;
bcCode93 - O código 93 é uma versão mais compacta do código 39. Codifica
exatamente os mesmos caracteres que o código 39, mas utiliza 9 elementos de
barra por caractere ao invés de 15. O dígito verificador o dígito verificador
módulo 43 é opcional, como no código 39;
bcCode93Extended - ver bcCode93;
bcMSI - O código de barras MSI Plessey é utilizado principalmente em bibliotecas e
em etiquetagem de prateleiras de lojas. O MSI Plessey é um formato de comprimento
variável que permite codificar os 10 caracteres seguintes: 0123456789. Cada caractere
consiste em oito elementos: quatro barras e quatro espaços;
bcPostNet - Os códigos de barras POSTNET (Postal Numeric Encoding Technique) são
utilizados para codificar códigos de endereçamento postal no correio dos
E.U.A. O processo de manuseio de correspondência do Serviço postal foi
desenvolvido para ser totalmente automatizado e os códigos de barras POSTNET
alimentam o equipamento automatizado. O POSTNET difere dos outros formatos em
que a altura das barras varia, e não a largura das barras. Cada número é
representado por um padrão de cinco barras. Uma única barra alta é utilizada
para as barras de início e parada. O POSTNET pode ser utilizado como código
de barras de ponto de entrega de cinco dígitos, de nove dígitos e de 11
dígitos. Esses códigos são freqüentemente utilizados em conjunto com as barras
FIM que se encontram no canto superior direito de uma correspondência, como
cartões-resposta comerciais;
bcCodaBar - O CodBar é utilizado freqüentemente em bibliotecas, bancos de
sangue e na atividade de encomendas aéreas. O formato de comprimento variável
permite a codificação dos 20 caracteres seguintes: 0123456789-$:/.+ABCD. Os
caracteres de início e de parada de uma mensagem CodBar precisam ser A, B, C ou D;
bcEAN8 - O sistema EAN (European Article Numbering) é uma versão européia do
código UPC (Universal Product Code). Atualmente, esse código é denominado
International Article Number, mas a abreviação EAN permanece. Os códigos
EAN encontram-se em itens de varejo na Europa. Esse número é apropriado para uso
em publicações e periódicos, aparecendo como um código de barras adicional
no lado direito do código de barras principal. É a versão simplificada do padrão
EAN-13 para aplicação em produtos onde a etiqueta no padrão EAN-13 fique muito
grande. O EAN-8 codifica até oito dígitos, consistindo em dois dígitos do código
do país, cinco dígitos de dados e um dígito de verificação. Um número opcional de
dois ou cinco dígitos pode ser acrescentado ao código de barras principal;
bcEAN13 - O EAN-13 é a versão européia do UPC (A) (Universal Product Code). É o
padrão adotado pela ABAC (EAN Brasil) para codificação de produtos em
supermercados. Também é designado para uso em publicações e periódicos, aparecendo
como um código de barras adicional no lado direito do código de barras principal. Permite
a codificação de até 13 dígitos numéricos. A diferença entre o EAN-13 e o
UPC (A) é que o EAN-13 codifica um 13° dígito no padrão de paridade dos seis dígitos
da esquerda de um símbolo UPC (A). Esse 13° dígito, combinado com o 12°, representa um
código de país. Um número opcional de dois ou cinco dígitos pode ser acrescentado ao
código de barras principal;
bcUPC_A - Os símbolos UPC (Universal Product Code) são usados em aplicações de
varejo nos Estados Unidos e no Canadá. O UPC(A) é um formato de 12
dígitos. O símbolo consiste em 11 dígitos de dados e um dígito de
verificação. Normalmente, o primeiro dígito representa o tipo de produto
sendo identificado. Os cinco dígitos seguintes são um código de fabricante
e os cinco dígitos seguintes são utilizados para identificar um produto específico;
bcUPC_E0 - Como o UPC(A), o UPC(E) é utilizado em aplicações de varejo, no entanto,
como o código de barras é menor, ele é mais adequado para itens menores. Esse formato
também é chamado de "zero suprimido" porque o UPC(E) compacta um código de 12 dígitos
UPC(A) em um código de seis dígitos. O UPC(E) suprime o dígito de sistema numérico,
os dígitos finais no código de fabricante e os zeros iniciais na parte de identificação
de produto do código. Um número opcional de dois ou cinco dígitos pode ser adicionado
ao do código de barras UPC(A) e UPC(E) principal. Esse número é designado para uso em
publicações e periódicos, aparecendo como um código de barras adicional no lado direito
do código de barras principal;
bcUPC_E1 - ver bcUPC_E0;
bcUPC_Supp2 - ver bcUPC_Supp;
bcUPC_Supp5 - ver bcUPC_Supp;
bcEAN128A - Mais abrangente que os demais códigos, o UCC/EAN-128 é complementar,
baseado em Identificadores de Aplicação (AI), identificando o significado e o
formato de dados. O UCC/EAN-128 pode, inclusive, ser aplicado em unidades de
distribuição, permitindo a identificação do número de lote, série, data de
fabricação, validade, textos livres e outros dados. A utilização do UCC/EAN-128
é múltipla, podendo ser aplicado na logística e automação de vários setores
produtivos e comerciais, como o ramo alimentício, farmacêutico, vestuário e
de papel, entre outros. Além disso, pode ser usado na distribuição, armazenamento,
inventários e gestão de estoque, proporcionando agilidade na captura de informações,
com menor margem de erros. Trata-se de um sistema que possui abrangência necessária
para a obtenção de grandes ganhos na cadeia distributiva, sempre objetivando a
otimizar e a maximizar, por meio da informação rápida e precisa;
bcEAN128B - ver bcEAN128A;
bcEAN128C - ver bcEAN128A.
:}
TRLBarcodeType = (bcCode2OF5Interleaved, bcCode2OF5Industry, bcCode2OF5Matrix,
bcCode39, bcCode39Extended, bcCode128A, bcCode128B, bcCode128C,
bcCode93, bcCode93Extended, bcMSI, bcPostNet, bcCodaBar, bcEAN8,
bcEAN13, bcUPC_A, bcUPC_E0, bcUPC_E1, bcUPC_Supp2, bcUPC_Supp5,
bcEAN128A, bcEAN128B, bcEAN128C);
{/@type}
// para uso interno somente
// blHalfFilled significa uma linha preta com altura de 2/5 (used for PostNet)
TRLBarcodeLineType = (blFilled, blNotFilled, blHalfFilled);
TRLBarcodeBarWidth = (bw100, bw100Ratio, bw150Ratio, bw200Ratio);
// quais textos mostrar
TRLBarcodeTextOption = (boNone, boCode, boType, boBoth);
TRLBarcodeCheckSumMethod = (cmNone, cmModule10);
{@type TRLBarcodeOrientation - Orientação do desenho das barras.
Pode ser um dos seguintes valores:
boLeftToRight - Da esquerda para a direita;
boBottomToTop - De baixo para cima;
boTopToBottom - De cima para baixo. :}
TRLBarcodeOrientation = (boLeftToRight, boBottomToTop, boTopToBottom);
{/@type}
{@type TRLBarcodeInvalidCode - O que deve ser exibido se o código contiver erros.
Pode ser um dos seguintes valores:
icEmptyRect - Apresenta um retângulo vazio;
icCrossOut - Apresenta o código de barras rasurado com uma cruz vermelha;
icDrawAnyway - Desenha as barras extraindo os dígitos inválidos.:}
TRLBarcodeInvalidCode = (icEmptyRect, icCrossOut, icDrawAnyway);
{/@type}
{ TRLCustomBarcode }
{@class TRLCustomBarcode - Classe base da qual podem derivar componentes para códigos de barras. @ancestor TRLCustomControl. }
{$IFDEF RTL230_UP}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF RTL230_UP}
TRLCustomBarcode = class(TRLCustomControl)
private
FBeforeText: TRLBeforeTextEvent;
FBarColor: TColor;
FShowText: TRLBarcodeTextOption;
FOrientation: TRLBarcodeOrientation;
FMargins: TRLMargins;
FModule: Integer;
FRatio: Double;
FBarcodeType: TRLBarcodeType;
FCheckSum: Boolean;
FCheckSumMethod: TRLBarcodeCheckSumMethod;
FModules: array[TRLBarcodeBarWidth] of ShortInt;
FInvalid: Boolean;
FInvalidCode: TRLBarcodeInvalidCode;
procedure GetBarInfo(AChar: Char; var ABarWidth: Integer;
var ALineType: TRLBarcodeLineType);
function GetTypeText: string;
function GetImageWidth(const ABarData: string): Integer;
function GetBarData(const AText: string): string;
procedure SetModule(Value: Integer);
procedure SetBarColor(const Value: TColor);
procedure SetShowText(const Value: TRLBarcodeTextOption);
procedure SetBarcodeType(const Value: TRLBarcodeType);
procedure SetRatio(const Value: Double);
procedure SetOrientation(const Value: TRLBarcodeOrientation);
procedure SetMargins(const AValue: TRLMargins);
procedure SetInvalidCode(const Value: TRLBarcodeInvalidCode);
procedure SetCheckSum(const Value: Boolean);
procedure SetCheckSumMethod(const Value: TRLBarcodeCheckSumMethod);
function GetAs2OF5Interleaved(const AText: string): string;
function GetAs2OF5Industry(const AText: string): string;
function GetAs2OF5Matrix(const AText: string): string;
function GetAs39(const AText: string): string;
function GetAs39Extended(const AText: string): string;
function GetAs128(const AText: string): string;
function GetAs93(const AText: string): string;
function GetAs93Extended(const AText: string): string;
function GetAsMSI(const AText: string): string;
function GetAsPostNet(const AText: string): string;
function GetAsCodaBar(const AText: string): string;
function GetAsEAN8(const AText: string): string;
function GetAsEAN13(const AText: string): string;
function GetAsUPC_A(const AText: string): string;
function GetAsUPC_E0(const AText: string): string;
function GetAsUPC_E1(const AText: string): string;
function GetAsUPC_Supp5(const AText: string): string;
function GetAsUPC_Supp2(const AText: string): string;
procedure MakeModules;
function DoCheckSumming(const AData: string): string;
function CreateBitmap(const AText: string; AWidth, AHeight: Integer): TBitmap;
function IsRatio: Boolean;
function CalcMarginalPixels: TRect;
protected
procedure CalcSize(var ASize: TPoint); override;
procedure InternalPrint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
{@prop AutoSize - Redimensionamento automático. Determina se o controle irá se redimensionar automaticamente de acordo com o tamanho do seu conteúdo. :/}
property AutoSize default True;
{@prop Caption - Texto a ser impresso como código de barras. :/}
property Caption;
{@prop BarColor - Cor das barras. Determina a cor das barras cheias. :/}
property BarColor: TColor read FBarColor write SetBarColor default clBlack;
{@prop ShowText - Determina se e como serão exibidas as informações junto com as barras.
Pode ser um dos seguintes valores:
boNone - Nenhum texto é exibido;
boCode - Apenas o valor do código de barras;
boType - Apenas o tipo de código de barras utilizado;
boBoth - Ambos o valor e o tipo de código. :/}
property ShowText: TRLBarcodeTextOption read FShowText write SetShowText default boNone;
{@prop Module - Fator de ampliação da largura das barras. :/}
property Module: Integer read FModule write SetModule default 1;
{@prop Ratio - Razão entre as larguras das barras. :/}
property Ratio: Double read FRatio write SetRatio stored IsRatio;
{@prop BarcodeType - Padrão de código de barras. @links TRLBarcodeType. :/}
property BarcodeType: TRLBarcodeType read FBarcodeType write SetBarcodeType default bcCode2of5Interleaved;
{@prop Orientation - Orientação da leitura das barras. :/}
property Orientation: TRLBarcodeOrientation read FOrientation write SetOrientation default boLeftToRight;
{@prop Margins - Margens externas do código de barras. @links TRLMargins. :/}
property Margins: TRLMargins read FMargins write SetMargins;
{@prop InvalidCode - Determina o que deve ser exibido se o código tiver algum erro. @links TRLBarcodeInvalidCode. :/}
property InvalidCode: TRLBarcodeInvalidCode read FInvalidCode write SetInvalidCode default icEmptyRect;
property CheckSum: Boolean read FCheckSum write SetCheckSum default False;
property CheckSumMethod: TRLBarcodeCheckSumMethod read FCheckSumMethod write SetCheckSumMethod default cmModule10;
{@prop BeforePrint - Antes da impressão. Ocorre antes da impressão do controle para alterar o texto ou anular a sua impressão. :/}
property BeforePrint: TRLBeforeTextEvent read FBeforeText write FBeforeText;
end;
{/@class}
{ TRLCustomDBBarcode }
{@class TRLCustomDBBarcode - Classe base da qual podem derivar componentes para códigos de barras dataware. @ancestor TRLCustomBarcode.}
{$IFDEF RTL230_UP}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF RTL230_UP}
TRLCustomDBBarcode = class(TRLCustomBarcode)
private
FDataField: TRLDataFieldProperty;
FDataFormula: string;
FDataSource: TDataSource;
function GetField: TField;
function GetFieldLabel: string;
function GetDataSet: TDataSet;
procedure SetDataField(const AValue: TRLDataFieldProperty);
procedure SetDataFormula(const AValue: string);
procedure SetDataSource(const AValue: TDataSource);
protected
function InternalMakeCaption: string; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function GetFieldText: string; dynamic;
public
constructor Create(AOwner: TComponent); override;
{@prop DataField - Nome do campo associado. :/}
property DataField: TRLDataFieldProperty read FDataField write SetDataField;
{@prop DataFormula - Expressão matemática envolvendo campos, valores e literais. :/}
property DataFormula: string read FDataFormula write SetDataFormula;
{@prop DataSource - Referência ao DataSource que controle utiliza para se conectar ao DataSet. :/}
property DataSource: TDataSource read FDataSource write SetDataSource;
{@prop Field - Referência para o objeto TField determinado pelas props DataField e DataSource. :/}
property Field: TField read GetField;
{@prop DataSet - Referência para o objeto TDataSet determinado pela prop DataSource. :/}
property DataSet: TDataSet read GetDataSet;
end;
{/@class}
{ TRLBarcode }
{@class TRLBarcode - Componente para códigos de barras. @pub. @ancestor TRLCustomBarcode. }
{$IFDEF RTL230_UP}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF RTL230_UP}
TRLBarcode = class(TRLCustomBarcode)
published
{@prop Align = ancestor /}
property Align;
{@prop Alignment = ancestor /}
property Alignment;
{@prop Anchors = ancestor /}
property Anchors;
{@prop AutoSize = ancestor /}
property AutoSize;
{@prop BarcodeType = ancestor /}
property BarcodeType;
{@prop BarColor = ancestor /}
property BarColor;
{@prop Behavior = ancestor /}
property Behavior;
{@prop Borders = ancestor /}
property Borders;
{@prop Caption = ancestor /}
property Caption;
{@prop CheckSum = ancestor /}
property CheckSum;
{@prop CheckSumMethod = ancestor /}
property CheckSumMethod;
{@prop Color = ancestor /}
property Color;
{@prop Font = ancestor /}
property Font;
{@prop FriendlyName = ancestor /}
property FriendlyName;
{@prop Holder = ancestor /}
property Holder;
{@prop HoldStyle = ancestor /}
property HoldStyle;
{@prop InvalidCode = ancestor /}
property InvalidCode;
{@prop Layout = ancestor /}
property Layout;
{@prop Margins = ancestor /}
property Margins;
{@prop Module = ancestor /}
property Module;
{@prop Orientation = ancestor /}
property Orientation;
{@prop ParentColor = ancestor /}
property ParentColor;
{@prop ParentFont = ancestor /}
property ParentFont;
{@prop Ratio = ancestor /}
property Ratio;
{@prop RealBounds = ancestor /}
property RealBounds;
{@prop SecondHolder = ancestor /}
property SecondHolder;
{@prop SecondHoldStyle = ancestor /}
property SecondHoldStyle;
{@prop ShowText = ancestor /}
property ShowText;
{@prop Transparent = ancestor /}
property Transparent;
{@prop Visible = ancestor /}
property Visible;
{@prop AfterPrint = ancestor /}
property AfterPrint;
{@prop BeforePrint = ancestor /}
property BeforePrint;
{@prop OnMeasureHeight = ancestor /}
property OnMeasureHeight;
end;
{/@class}
{@class TRLDBBarcode - Componente para códigos de barras dataware. @pub. @ancestor TRLCustomDBBarcode. }
{$IFDEF RTL230_UP}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF RTL230_UP}
TRLDBBarcode = class(TRLCustomDBBarcode)
published
{@prop Align = ancestor /}
property Align;
{@prop Alignment = ancestor /}
property Alignment;
{@prop Anchors = ancestor /}
property Anchors;
{@prop AutoSize = ancestor /}
property AutoSize;
{@prop BarcodeType = ancestor /}
property BarcodeType;
{@prop BarColor = ancestor /}
property BarColor;
{@prop Behavior = ancestor /}
property Behavior;
{@prop Borders = ancestor /}
property Borders;
{@prop CheckSum = ancestor /}
property CheckSum;
{@prop CheckSumMethod = ancestor /}
property CheckSumMethod;
{@prop Color = ancestor /}
property Color;
{@prop DataField = ancestor /}
property DataField;
{@prop DataFormula = ancestor /}
property DataFormula;
{@prop DataSource = ancestor /}
property DataSource;
{@prop Font = ancestor /}
property Font;
{@prop FriendlyName = ancestor /}
property FriendlyName;
{@prop Holder = ancestor /}
property Holder;
{@prop HoldStyle = ancestor /}
property HoldStyle;
{@prop InvalidCode = ancestor /}
property InvalidCode;
{@prop Layout = ancestor /}
property Layout;
{@prop Margins = ancestor /}
property Margins;
{@prop Module = ancestor /}
property Module;
{@prop Orientation = ancestor /}
property Orientation;
{@prop ParentColor = ancestor /}
property ParentColor;
{@prop ParentFont = ancestor /}
property ParentFont;
{@prop Ratio = ancestor /}
property Ratio;
{@prop RealBounds = ancestor /}
property RealBounds;
{@prop SecondHolder = ancestor /}
property SecondHolder;
{@prop SecondHoldStyle = ancestor /}
property SecondHoldStyle;
{@prop ShowText = ancestor /}
property ShowText;
{@prop Transparent = ancestor /}
property Transparent;
{@prop Visible = ancestor /}
property Visible;
{@prop AfterPrint = ancestor /}
property AfterPrint;
{@prop BeforePrint = ancestor /}
property BeforePrint;
{@prop OnMeasureHeight = ancestor /}
property OnMeasureHeight;
end;
{/@class}
{/@unit}
implementation
uses
RLUtils;
type
TRLBarcodeTypeInfo = record
Name: string; // name of barcode
DigitsOnly: Boolean; // numeric data only
end;
var
BarcodeTypeInfo: array[TRLBarcodeType] of TRLBarcodeTypeInfo = (
(Name: '2OF5 Interleaved'; DigitsOnly: True),
(Name: '2OF5 Industrial'; DigitsOnly: True),
(Name: '2OF5 Matrix'; DigitsOnly: True),
(Name: 'Code 39'; DigitsOnly: False),
(Name: 'Code 39 Extended'; DigitsOnly: False),
(Name: 'Code 128A'; DigitsOnly: False),
(Name: 'Code 128B'; DigitsOnly: False),
(Name: 'Code 128C'; DigitsOnly: True),
(Name: 'Code 93'; DigitsOnly: False),
(Name: 'Code 93 Extended'; DigitsOnly: False),
(Name: 'MSI'; DigitsOnly: True),
(Name: 'PostNet'; DigitsOnly: True),
(Name: 'CodaBar'; DigitsOnly: False),
(Name: 'EAN8'; DigitsOnly: True),
(Name: 'EAN13'; DigitsOnly: True),
(Name: 'UPC A'; DigitsOnly: True),
(Name: 'UPC E0'; DigitsOnly: True),
(Name: 'UPC E1'; DigitsOnly: True),
(Name: 'UPC Supp2'; DigitsOnly: True),
(Name: 'UPC Supp5'; DigitsOnly: True),
(Name: 'EAN 128A'; DigitsOnly: False),
(Name: 'EAN 128B'; DigitsOnly: False),
(Name: 'EAN 128C'; DigitsOnly: True));
// UTILS
function CheckSumModule10(const AData: string): string;
var
I, InverseI, Sum: Integer;
begin
Sum := 0;
InverseI := Length(AData);
for I := 1 to Length(AData) do
begin
if (InverseI mod 2) = 0 then
Inc(Sum, StrToInt(AData[I]) * 1)
else
Inc(Sum, StrToInt(AData[I]) * 3);
Dec(InverseI);
end;
if (Sum mod 10) = 0 then
Result := AData + '0'
else
Result := AData + IntToStr(10 - (Sum mod 10));
end;
// converts a string from '321' to the internal representation '715'
// i need this function because some pattern tables have a different
// format :
// '00111'
// converts to '05161'
function Convert(const Str: string): string;
var
I, V: Integer;
begin
Result := '';
for I := 1 to Length(Str) do
begin
V := Ord(Str[I]) - 1;
if Odd(I) then
Inc(V, 5);
Result := Result + Char(V);
end;
end;
function PadZ(const AText: string; AWidth: Integer): string;
begin
Result := AText;
while Length(Result) < AWidth do
Result := '0' + Result;
end;
function EvenZ(const AText: string): string;
begin
Result := AText;
if Odd(Length(Result)) then
Result := '0' + Result;
end;
{ TRLCustomBarcode }
constructor TRLCustomBarcode.Create(AOwner: TComponent);
var
SelfSize: TPoint;
begin
FShowText := boNone;
FBarColor := clBlack;
FOrientation := boLeftToRight;
FRatio := 2;
FModule := 1;
FBarcodeType := bcCode2of5Interleaved;
FCheckSum := False;
FCheckSumMethod := cmModule10;
FInvalidCode := icEmptyRect;
FMargins := TRLMargins.Create(Self);
inherited;
CalcSize(SelfSize);
Width := SelfSize.X;
Height := 34;
AutoSizeDir := [asWidthDir];
AutoSize := True;
with FMargins do
begin
LeftMargin := 1;
TopMargin := 0;
RightMargin := 1;
BottomMargin := 0;
end;
end;
destructor TRLCustomBarcode.Destroy;
begin
FreeObj(FMargins);
inherited;
end;
function TRLCustomBarcode.IsRatio: Boolean;
begin
Result := (FRatio <> 2);
end;
// margens em pixels
function TRLCustomBarcode.CalcMarginalPixels: TRect;
begin
Result.Left := Round(ScreenPPI * FMargins.LeftMargin / InchAsMM);
Result.Top := Round(ScreenPPI * FMargins.TopMargin / InchAsMM);
Result.Right := Round(ScreenPPI * FMargins.RightMargin / InchAsMM);
Result.Bottom := Round(ScreenPPI * FMargins.BottomMargin / InchAsMM);
end;
procedure TRLCustomBarcode.CalcSize(var ASize: TPoint);
var
ImageWidth, BorderWidth: Integer;
MarginalPixels: TRect;
SizeAxis: ^Integer;
begin
ASize := Point(Width, Height);
if not AutoSize then
Exit;
ImageWidth := GetImageWidth(GetBarData(Caption)) + 1;
if FOrientation = boLeftToRight then
SizeAxis := @ASize.X
else
SizeAxis := @ASize.Y;
SizeAxis^ := ImageWidth;
MarginalPixels := CalcMarginalPixels;
Inc(SizeAxis^, MarginalPixels.Left + MarginalPixels.Right);
// adicional das bordas
BorderWidth := Self.Borders.Width;
if BorderWidth > 0 then
begin
Inc(BorderWidth);
if Self.Borders.CanDrawLeft then
Inc(SizeAxis^, BorderWidth);
if Self.Borders.CanDrawRight then
Inc(SizeAxis^, BorderWidth);
end;
end;
function TRLCustomBarcode.CreateBitmap(const AText: string; AWidth, AHeight: Integer): TBitmap;
var
BarWidth: Integer;
LineType: TRLBarcodeLineType;
BarData, S: string;
PaintRect: TRect;
MarginalRect: TRect;
FooRect: TRect;
I: Integer;
StrWidth, StrHeight: Integer;
begin
Result := NewBitmap(AWidth, AHeight);
try
BarData := GetBarData(AText);
// desenha o código de barras
PaintRect := Rect(0, 0, AWidth, AHeight);
MarginalRect := PaintRect;
with Result.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := Self.Color;
FillRect(PaintRect);
Pen.Style := psSolid;
Pen.Width := 1;
// examine the pattern string
if FShowText <> boNone then
begin
Font.Assign(Self.Font);
// reserva uma linha no topo para o tipo
if FShowText in [boType, boBoth] then
Inc(MarginalRect.Top, TextHeight(' '));
// reserva meia linha em baixo para o código (postnet é um linha)
if FShowText in [boCode, boBoth] then
if FBarcodeType = bcPostNet then
Dec(MarginalRect.Bottom, TextHeight(' '))
else
Dec(MarginalRect.Bottom, TextHeight(' ') div 2);
end;
// centraliza a imagem das barras
MarginalRect.Right := MarginalRect.Left + GetImageWidth(BarData);
case Alignment of
taCenter: OffsetRect(MarginalRect, (RectWidth(PaintRect) - RectWidth(MarginalRect)) div 2, 0);
taRightJustify: OffsetRect(MarginalRect, RectWidth(PaintRect) - RectWidth(MarginalRect), 0);
end;
// desenha as barras
if (FInvalid and (FInvalidCode = icEmptyRect)) or (Trim(AText) = '') then
else
begin
FooRect := MarginalRect;
for I := 1 to Length(BarData) do
begin
GetBarInfo(BarData[I], BarWidth, LineType);
// determina a cor da barra
if LineType in [blNotFilled, blHalfFilled] then
Brush.Color := Self.BarColor
else
Brush.Color := Self.Color;
if LineType = blHalfFilled then
FooRect.Top := MarginalRect.Bottom - (MarginalRect.Bottom - MarginalRect.Top) * 2 div 5
else
FooRect.Top := MarginalRect.Top;
FooRect.Right := FooRect.Left + BarWidth;
// draw the rectangle
FillRect(FooRect);
// step it
Inc(FooRect.Left, BarWidth);
end;
if FInvalid and (InvalidCode = icCrossOut) then
begin
Pen.Width := 4;
Pen.Color := clRed;
MoveTo(MarginalRect.Left + Pen.Width, MarginalRect.Top + Pen.Width);
LineTo(MarginalRect.Right - Pen.Width - 1, MarginalRect.Bottom - Pen.Width - 1);
MoveTo(MarginalRect.Right - Pen.Width - 1, MarginalRect.Top + Pen.Width);
LineTo(MarginalRect.Left + Pen.Width, MarginalRect.Bottom - Pen.Width - 1);
end;
end;
// desenha o texto
if FShowText <> boNone then
begin
Font.Assign(Self.Font);
Brush.Style := bsSolid;
Brush.Color := Self.Color;
if FShowText in [boType, boBoth] then
begin
S := GetTypeText;
StrWidth := TextWidth(S);
StrHeight := TextHeight(S + ' ');
FooRect.Left := (MarginalRect.Left + MarginalRect.Right - StrWidth) div 2;
FooRect.Top := PaintRect.Top;
FooRect.Right := FooRect.Left + StrWidth;
FooRect.Bottom := FooRect.Top + StrHeight;
FillRect(FooRect);
TextRect(FooRect, FooRect.Left, FooRect.Top, S);
end;
if FShowText in [boCode, boBoth] then
begin
S := Self.Caption;
StrWidth := TextWidth(S);
StrHeight := TextHeight(S + ' ');
FooRect.Left := (MarginalRect.Left + MarginalRect.Right - StrWidth) div 2;
FooRect.Top := PaintRect.Bottom - StrHeight;
FooRect.Right := FooRect.Left + StrWidth;
FooRect.Bottom := FooRect.Top + StrHeight;
FillRect(FooRect);
TextRect(FooRect, FooRect.Left, FooRect.Top, S);
end;
end;
end;
except
Result.Free;
raise;
end;
end;
procedure TRLCustomBarcode.Paint;
var
NormalImage, RotatedImage: TBitmap;
OrientationAngle: Double;
HorzOffset, VertOffset: Integer;
ImageWidth, ImageHeight: Integer;
SwapAux: Integer;
MarginalRect: TRect;
begin
CustomControlPaint;
MarginalRect := ReduceRect(GetClientRect, CalcMarginalPixels);
ImageWidth := RectWidth(MarginalRect);
ImageHeight := RectHeight(MarginalRect);
if FOrientation in [boBottomToTop, boTopToBottom] then
begin
SwapAux := ImageWidth;
ImageWidth := ImageHeight;
ImageHeight := SwapAux;
end;
if (ImageWidth > 0) and (ImageHeight > 0) then
begin
NormalImage := CreateBitmap(Caption, ImageWidth, ImageHeight);
try
case FOrientation of
boBottomToTop: OrientationAngle := 90;
boTopToBottom: OrientationAngle := -90;
else // boLeftToRight
OrientationAngle := 0;
end;
RotatedImage := RotatedBitmap(NormalImage, OrientationAngle);
try
case Alignment of
taCenter: HorzOffset := (MarginalRect.Left + MarginalRect.Right - RotatedImage.Width) div 2;
taRightJustify: HorzOffset := MarginalRect.Right - RotatedImage.Width;
else
HorzOffset := MarginalRect.Left;
end;
case Layout of
tlCenter: VertOffset := (MarginalRect.Top + MarginalRect.Bottom - RotatedImage.Height) div 2;
tlBottom: VertOffset := MarginalRect.Bottom - RotatedImage.Height;
else
VertOffset := MarginalRect.Top;
end;
Canvas.Draw(HorzOffset, VertOffset, RotatedImage);
finally
RotatedImage.Free;
end;
finally
NormalImage.Free;
end;
end;
end;
procedure TRLCustomBarcode.InternalPrint;
var
NormalImage, RotatedImage: TBitmap;
OrientationAngle: Double;
HorzOffset, VertOffset: Integer;
ImageWidth, ImageHeight: Integer;
SwapAux: Integer;
MarginalRect: TRect;
begin
inherited;
MarginalRect := ReduceRect(CalcPrintClientRect, CalcMarginalPixels);
ImageWidth := RectWidth(MarginalRect);
ImageHeight := RectHeight(MarginalRect);
if FOrientation in [boBottomToTop, boTopToBottom] then
begin
SwapAux := ImageWidth;
ImageWidth := ImageHeight;
ImageHeight := SwapAux;
end;
if (ImageWidth > 0) and (ImageHeight > 0) then
begin
NormalImage := CreateBitmap(Caption, ImageWidth, ImageHeight);
try
case FOrientation of
boBottomToTop: OrientationAngle := 90;
boTopToBottom: OrientationAngle := -90;
else // boLeftToRight
OrientationAngle := 0;
end;
RotatedImage := RotatedBitmap(NormalImage, OrientationAngle);
try
case Alignment of
taCenter: HorzOffset := (MarginalRect.Left + MarginalRect.Right - RotatedImage.Width) div 2;
taRightJustify: HorzOffset := MarginalRect.Right - RotatedImage.Width;
else
HorzOffset := MarginalRect.Left;
end;
case Layout of
tlCenter: VertOffset := (MarginalRect.Top + MarginalRect.Bottom - RotatedImage.Height) div 2;
tlBottom: VertOffset := MarginalRect.Bottom - RotatedImage.Height;
else
VertOffset := MarginalRect.Top;
end;
RequestParentSurface.Draw(HorzOffset, VertOffset, RotatedImage);
finally
RotatedImage.Free;
end;
finally
NormalImage.Free;
end;
end;
end;
procedure TRLCustomBarcode.SetBarColor(const Value: TColor);
begin
if FBarColor = Value then
Exit;
FBarColor := Value;
Invalidate;
end;
procedure TRLCustomBarcode.SetShowText(const Value: TRLBarcodeTextOption);
begin
if FShowText = Value then
Exit;
FShowText := Value;
Invalidate;
end;
procedure TRLCustomBarcode.SetBarcodeType(const Value: TRLBarcodeType);
begin
if FBarcodeType = Value then
Exit;
FBarcodeType := Value;
AdjustBounds;
Invalidate;
end;
procedure TRLCustomBarcode.SetRatio(const Value: Double);
begin
if FRatio = Value then
Exit;
FRatio := Value;
AdjustBounds;
Invalidate;
end;
procedure TRLCustomBarcode.SetOrientation(const Value: TRLBarcodeOrientation);
var
SwapAux: Integer;
begin
if FOrientation = Value then
Exit;
if (Value in [boLeftToRight]) <> (FOrientation in [boLeftToRight]) then
begin
SwapAux := Width;
Width := Height;
Height := SwapAux;
end;
FOrientation := Value;
AdjustBounds;
Invalidate;
end;
function TRLCustomBarcode.GetTypeText: string;
begin
Result := BarcodeTypeInfo[FBarcodeType].Name;
end;
procedure TRLCustomBarcode.SetModule(Value: Integer);
begin
if FModule = Value then
Exit;
if (Value < 1) or (Value >= 50) then
Exit;
FModule := Value;
AdjustBounds;
Invalidate;
end;
// calculate the width and the LineType of a sigle bar
procedure TRLCustomBarcode.GetBarInfo(AChar: Char; var ABarWidth: Integer;
var ALineType: TRLBarcodeLineType);
begin
{
Code Color Width Height