pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

lazbarcodes: MaxiCode improvements. Still issues with svg and eps output. Symbol.Primary not yet implemented.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8225 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-03-23 22:24:49 +00:00
parent 13fef13a53
commit 32bc4f0f30
4 changed files with 85 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
components/lazbarcodes/demo/LazBarcodeDemo.lpi
View File

@ -59,11 +59,6 @@
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>

11
components/lazbarcodes/src/lbc_maxicode.pas
View File

@ -1,3 +1,13 @@
{ lbc_maxicode.pas - Handles the MaxiCode symbology
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W. Pamler
}
unit lbc_MaxiCode;
{$IFDEF FPC}
@ -843,7 +853,6 @@ begin
bit_pattern[3] := (maxi_codeword[block-1] and $04) shr 2;
bit_pattern[4] := (maxi_codeword[block-1] and $02) shr 1;
bit_pattern[5] := (maxi_codeword[block-1] and $01);
if bit_pattern[bit] <> 0 then
set_module(ASymbol, i, j);
end;

78
components/lazbarcodes/src/ubarcodes.pas
View File

@ -218,7 +218,7 @@ type
procedure Render(AWidth, AHeight: Integer); virtual;
procedure RenderBearerBars(AWidth, AHeight, ABorder: Integer; var ALastLine: PZintRenderline);
procedure RenderBox(AWidth, AHeight, ABorder: Integer; var ALastLine: PZintRenderLine);
procedure RenderSymbol(xLeft, yTop, ASymbolHeight, {%H-}ATextHeight, AFactor: Integer); virtual;
procedure RenderSymbol(xLeft, yTop, ASymbolWidth, ASymbolHeight, {%H-}ATextHeight, AFactor: Integer); virtual;
procedure RenderText(ASymbolWidth, ASymbolStart, ATextPos: Integer); virtual;
property AddCheckSum: Boolean read FAddCheckSum write SetAddCheckSum default true;
property DisplayCheckSum: Boolean read FDisplayCheckSum write SetDisplayCheckSum default false;
@ -352,7 +352,7 @@ type
function GetRightText: String;
function GetSampleText: String; override;
function InternalGenerate: Integer; override;
procedure RenderSymbol(xLeft, yTop, AHeight, ATextHeight, AFactor: Integer); override;
procedure RenderSymbol(xLeft, yTop, ASymbolWidth, ASymbolHeight, ATextHeight, AFactor: Integer); override;
procedure RenderText(ASymbolWidth, ASymbolStart, ATextPos: Integer); override;
procedure SetRecommendedSymbolSizeParams; override;
function UPC_EAN_Flag: Integer;
@ -621,7 +621,7 @@ type
procedure DrawBarcode(ADrawer: TBasicBarcodeDrawer; AFactor: Double); override;
class function GetControlClassDefaultSize: TSize; override;
function InternalGenerate: Integer; override;
procedure RenderSymbol(xLeft, yTop, {%H-}ASymbolHeight, {%H-}ATextHeight, AFactor: Integer); override;
procedure RenderSymbol(xLeft, yTop, ASymbolWidth, ASymbolHeight, {%H-}ATextHeight, AFactor: Integer); override;
procedure SetRecommendedSymbolSizeParams; override;
public
constructor Create(AOwner: TComponent); override;
@ -1622,7 +1622,7 @@ begin
end;
// Render bars and spaces
RenderSymbol(x, border, hsymbol, htext, factor);
RenderSymbol(x, border, wsymbol, hsymbol, htext, factor);
// Render the human-readable text
if FShowHumanReadableText then
@ -1684,10 +1684,12 @@ end;
{ Renders bars and spaces.
- xLeft, yTop: left/top corner of the first bar
- ASymbolWidth: width of the entire symbol (without border and whitespace)
- ASymbolHeight: height of the entire symbol (without text)
- ATextHeight: height of the human-readable text. Needed by EAN code bar extensions.
- AFactor: current scaling factor with respect to pixels }
procedure TSimpleBarcode.RenderSymbol(xLeft, yTop, ASymbolHeight, ATextHeight, AFactor: Integer);
procedure TSimpleBarcode.RenderSymbol(xLeft, yTop, ASymbolWidth, ASymbolHeight,
ATextHeight, AFactor: Integer);
var
i: Integer; // general loop variable
x, y: Integer; // coordinates of the left/top corner of the currently rendered bar.
@ -2218,7 +2220,8 @@ end;
{ Is overridden to handle the bar extensions of most of the UPC/EAN codes, i.e.
some bars are drawn longer than the others.}
procedure TBarcodeEAN.RenderSymbol(xLeft, yTop, AHeight, ATextHeight, AFactor: Integer);
procedure TBarcodeEAN.RenderSymbol(xLeft, yTop, ASymbolWidth, ASymbolHeight,
ATextHeight, AFactor: Integer);
var
i, n: Integer;
line: PZintRenderLine;
@ -3193,8 +3196,8 @@ end;
{ TBarcodeMaxiCode }
const
H_HEXAGON = 2.0/sqrt(3.0);
W_HEXAGON = 1.0;
W_HEXAGON = 2.0;
H_HEXAGON = 4.0/sqrt(3.0);
constructor TBarcodeMaxiCode.Create(AOwner: TComponent);
begin
@ -3236,7 +3239,7 @@ procedure TBarcodeMaxiCode.CalcSize(AFactor: Integer;
begin
// +2 for an empty hexagon around the symbol
ASymbolWidth := round(W_HEXAGON * (FSymbol^.Width + 2) * AFactor);
ASymbolHeight := round(H_HEXAGON * (FSymbol^.Rows + 2) * AFactor);
ASymbolHeight := round(H_HEXAGON * 0.75 * (FSymbol^.Rows + 1.5) * AFactor);
// No human-readable text
ATextWidth := 0;
@ -3267,8 +3270,10 @@ end;
procedure TBarcodeMaxiCode.DrawBarcode(ADrawer: TBasicBarcodeDrawer; AFactor: Double);
var
ring: PZintRenderRing;
hexagon: PZintRenderHexagon;
wx: Double;
rInner, rOuter: Double;
begin
// Prepare drawer
if FBackgroundColor = clDefault then
@ -3290,6 +3295,16 @@ begin
else
wx := AFactor * FScale;
// Draw the rings
ring := FSymbol^.Rendered^.rings;
while Assigned(ring) do
begin
rInner := ring^.radius - ring^.line_width/2;
rOuter := ring^.radius + ring^.line_width/2;
ADrawer.DrawRing(ring^.x, ring^.y, rOuter, rInner);
ring := ring^.Next;
end;
// Draw the hexagons
hexagon := FSymbol^.Rendered^.hexagons;
while Assigned(hexagon) do begin
@ -3315,17 +3330,47 @@ begin
Result := maxicode(FSymbol, @FText[1], Length(FText));
end;
procedure TBarcodeMaxiCode.RenderSymbol(xLeft, yTop, ASymbolHeight, {%H-}ATextHeight, AFactor: Integer);
(*
function TBarcodeMaxiCode.InternalGenerate: Integer;
var
txt: array of byte;
begin
FSymbol^.option_1 := ord(FMode);
setLength(txt, Length(FText)+1);
Move(FText[1], txt[0], Length(txt));
txt[Length(txt)] := 0;
Result := maxicode(FSymbol, txt, Length(FText));
end;
*)
procedure TBarcodeMaxiCode.RenderSymbol(xLeft, yTop, ASymbolWidth, ASymbolHeight,
{%H-}ATextHeight, AFactor: Integer);
var
ring, last_ring: PZintRenderRing;
hexagon, last_hexagon: PZintRenderHexagon;
i, j: Integer;
x, y: Double;
xFactor, yFactor: Double;
xc, yc: Double;
xFactor, yFactor, linewidth: Double;
begin
xFactor := W_HEXAGON * AFactor;
yFactor := H_HEXAGON * AFactor * 0.75;
// Rings
xc := xLeft + ASymbolWidth / 2 - xFactor*0.5;
yc := yTop + ASymbolHeight / 2;
last_ring := nil;
// The radius coefficients are empirical values derived from Zint code
linewidth := 0.8816 * xFactor;
ring := render_plot_create_ring(xc, yc, 0.9659*xFactor, linewidth);
render_plot_add_ring(FSymbol, ring, @last_ring);
ring := render_plot_create_ring(xc, yc, 2.500*xFactor, linewidth);
render_plot_add_ring(FSymbol, ring, @last_ring);
ring := render_plot_create_ring(xc, yc, 4.0227*xFactor, linewidth);
render_plot_add_ring(FSymbol, ring, @last_ring);
// Hexagons
xFactor := H_HEXAGON * AFactor;
yFactor := W_HEXAGON * AFactor;
last_hexagon := nil;
for j := 0 to FSymbol^.Rows - 1 do
begin
@ -3333,9 +3378,10 @@ begin
for i := 0 to FSymbol^.Width - 1 do
if module_is_set(FSymbol, j, i) then
begin
x := xFactor * (i + 1) + xLeft;
if odd(i) then
x := x + xFactor * 0.5;
if odd(j) then
x := xFactor * (i + 2) + xLeft
else
x := xFactor * (i + 1.5) + xLeft;
hexagon := render_plot_create_hexagon(x, y);
render_plot_add_hexagon(FSymbol, hexagon, @last_hexagon);
end;

22
components/lazbarcodes/src/udrawers.pas
View File

@ -27,7 +27,7 @@ type
procedure EndDrawing; virtual; abstract;
procedure DrawBar(x1, y1, x2, y2: Double); virtual; abstract;
procedure DrawCenteredText(x, y: Double; const AText: String); virtual; abstract;
procedure DrawHexagon(x, y, r: Double); virtual; abstract;
procedure DrawHexagon(x, y, wx: Double); virtual; abstract;
procedure DrawRing(x, y, rOuter, rInner: Double); virtual; abstract;
property BackColor: TColor read FBackColor write FBackColor;
property BarColor: TColor read FBarColor write FBarColor;
@ -53,7 +53,7 @@ type
procedure EndDrawing; override;
procedure DrawBar(x1, y1, x2, y2: double); override;
procedure DrawCenteredText(x, y: double; const AText: String); override;
procedure DrawHexagon(x, y, r: Double); override;
procedure DrawHexagon(x, y, wx: Double); override;
procedure DrawRing(x, y, rOuter, rInner: Double); override;
end;
@ -83,7 +83,7 @@ type
procedure EndDrawing; override;
procedure DrawBar(x1, y1, x2, y2: double); override;
procedure DrawCenteredText(x, y: double; const AText: String); override;
procedure DrawHexagon(x, y, r: Double); override;
procedure DrawHexagon(x, y, wx: Double); override;
procedure DrawRing(x, y, rOuter, rInner: Double); override;
end;
@ -181,13 +181,13 @@ begin
FCanvas.TextOut(round(x - w/2), round(y), AText);
end;
procedure TCanvasBarcodeDrawer.DrawHexagon(x, y, r: Double);
procedure TCanvasBarcodeDrawer.DrawHexagon(x, y, wx: Double);
var
P: array[0..5] of TPoint;
i: Integer;
begin
for i := 0 to 5 do
P[i] := Point(round(x + HEXAGON[i].X*r), round(y + HEXAGON[i].Y*r));
P[i] := Point(round(x + HEXAGON[i].X * wx), round(y + HEXAGON[i].Y * wx));
FCanvas.Brush.Color := FBarColor;
FCanvas.Brush.Style := bsSolid;
FCanvas.Pen.Style := psClear;
@ -200,6 +200,8 @@ var
begin
FCanvas.Pen.Color := FBarColor;
FCanvas.Pen.Style := psSolid;
FCanvas.Brush.Style := bsClear;
if rOuter > rInner then
FCanvas.Pen.Width := round(rOuter - rInner)
else
@ -298,15 +300,15 @@ begin
));
end;
procedure TSvgBarcodeDrawer.DrawHexagon(x, y, r: Double);
procedure TSvgBarcodeDrawer.DrawHexagon(x, y, wx: Double);
var
P: array[0..5] of TDblPoint;
i: Integer;
begin
for i := 0 to 5 do
begin
P[i].X := x + HEXAGON[i].X*r;
P[i].Y := y + HEXAGON[i].Y*r;
P[i].X := x + HEXAGON[i].X * wx;
P[i].Y := y + HEXAGON[i].Y * wx;
end;
FList.Add(Format(
@ -421,8 +423,8 @@ var
begin
for i := 0 to 5 do
begin
P[i].X := x + HEXAGON[i].X*wx;
P[i].Y := y + HEXAGON[i].Y*wx;
P[i].X := x + HEXAGON[i].X * wx;
P[i].Y := y + HEXAGON[i].Y * wx;
end;
if FStoredColor <> FBarColor then