From 327b57d4819f2dc32abc88d61cc8390c44b77254 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 20 Mar 2022 22:29:13 +0000 Subject: [PATCH] LazBarcodes: Add drawing methods for hexagons and rings (not tested, yet). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8216 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/lazbarcodes/src/udrawers.pas | 160 ++++++++++++++++++++++-- 1 file changed, 148 insertions(+), 12 deletions(-) diff --git a/components/lazbarcodes/src/udrawers.pas b/components/lazbarcodes/src/udrawers.pas index a1f2257e6..3af0bdbc5 100644 --- a/components/lazbarcodes/src/udrawers.pas +++ b/components/lazbarcodes/src/udrawers.pas @@ -27,6 +27,8 @@ 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 DrawRing(x, y, rOuter, rInner: Double); virtual; abstract; property BackColor: TColor read FBackColor write FBackColor; property BarColor: TColor read FBarColor write FBarColor; property TextColor: TColor read FTextColor write FTextColor; @@ -51,6 +53,8 @@ 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 DrawRing(x, y, rOuter, rInner: Double); override; end; @@ -79,6 +83,8 @@ 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 DrawRing(x, y, rOuter, rInner: Double); override; end; { TEpsBarcodeDrawer } @@ -86,18 +92,35 @@ type TEpsBarcodeDrawer = class(TTextBarcodeDrawer) private FStoredColor: TColor; - procedure EpsColor(AColor: TColor; out R,G,B: Double); + procedure EpsColor(AColor: TColor; out cR,cG,cB: Double); public procedure BeginDrawing; override; 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 DrawRing(x, y, rOuter, rInner: Double); override; end; implementation -{ TBasicBarcodeDrawer } +type + TDblPoint = record + X, Y: Double; + end; + +const + HEXAGON: array[0..5] of TDblPoint = ( + (X: 1.0; Y: 0.0000000), + (X: 0.5; Y: 0.8660254), + (X:-0.5; Y: 0.8660254), + (X:-1.0; Y: 0.0000000), + (X:-0.5; Y:-0.8660254), + (X: 0.5; Y:-0.8660254) + ); + + { TBasicBarcodeDrawer } constructor TBasicBarcodeDrawer.Create(AWidth, AHeight: Double); begin @@ -125,6 +148,7 @@ end; // Fill the background procedure TCanvasBarcodeDrawer.BeginDrawing; begin + FCanvas.Pen.Style := psClear; FCanvas.Brush.Color := FBackColor; FCanvas.Brush.Style := bsSolid; FCanvas.FillRect(0, 0, round(FWidth), round(FHeight)); @@ -155,7 +179,35 @@ begin FCanvas.TextOut(round(x - w/2), round(y), AText); end; +procedure TCanvasBarcodeDrawer.DrawHexagon(x, y, r: 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)); + FCanvas.Brush.Color := FBarColor; + FCanvas.Brush.Style := bsSolid; + FCanvas.Pen.Style := psClear; + FCanvas.Polygon(P); +end; +procedure TCanvasBarcodeDrawer.DrawRing(x, y, rOuter, rInner: Double); +var + r: Double; +begin + FCanvas.Pen.Color := FBarColor; + FCanvas.Pen.Style := psSolid; + if rOuter > rInner then + FCanvas.Pen.Width := round(rOuter - rInner) + else + FCanvas.Pen.Width := round(rInner - rOuter); + + r := (rOuter + rInner) / 2; + FCanvas.Ellipse(round(x+r), round(y+r), round(x-r), round(y-r)); +end; + + { TTextBarcodeDrawer } constructor TTextBarcodeDrawer.Create(AWidth, AHeight: Double; const ATitle: String); @@ -244,6 +296,35 @@ begin )); end; +procedure TSvgBarcodeDrawer.DrawHexagon(x, y, r: 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; + end; + + FList.Add(Format( + ' ', + [SvgColor(FBarColor), P[0].X, P[0].Y, P[1].X, P[1].Y, P[2].X, P[2].Y, P[3].X, P[3].Y, P[4].X, P[4].Y, P[5].X, P[5].Y], + FFormatSettings + )); +end; + +procedure TSvgBarcodeDrawer.DrawRing(x, y, rOuter, rInner: Double); +var + r: Double; +begin + FList.Add(Format( + ' ', [ + x, y, (rOuter + rInner)/2, abs(rOuter - rInner), SvgColor(FBarColor)], + FFormatSettings + )); +end; + function TSvgBarcodeDrawer.SvgColor(AColor: TColor): String; type TRgb = packed record @@ -302,12 +383,12 @@ end; procedure TEpsBarcodeDrawer.DrawBar(x1, y1, x2, y2: Double); var - R, G, B: Double; + cR, cG, cB: Double; begin if FStoredColor <> FBarColor then begin - EpsColor(FBarColor, R,G,B); - FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [R, G, B], FFormatSettings)); + EpsColor(FBarColor, cR,cG,cB); + FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [cR, cG, cB], FFormatSettings)); FStoredColor := FBarColor; end; FList.Add(Format('%0:.2f %1:.2f moveto %0:.2f %2:.2f lineto %3:.2f setlinewidth stroke', @@ -316,20 +397,75 @@ end; procedure TEpsBarcodeDrawer.DrawCenteredText(x, y: Double; const AText: String); var - R, G, B: Double; + cR, cG, cB: Double; begin if FStoredColor <> FTextColor then begin - EpsColor(FTextColor, R,G,B); - FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [R, G, B], FFormatSettings)); + EpsColor(FTextColor, cR,cG,cB); + FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [cR, cG, cB], FFormatSettings)); FStoredColor := FTextColor; end; FList.Add(Format('%.2f %.2f moveto', [x, FHeight-y], FFormatSettings)); FList.Add(Format('(%s) dup stringwidth pop 2 div neg -%.2f rmoveto show', [AText, 1.0*FFontSize], FFormatSettings)); end; + +procedure TEpsBarcodeDrawer.DrawHexagon(x, y, r: Double); +var + P: array[0..5] of TDblPoint; + s: String; + i: Integer; + cR, cG, cB: Double; +begin + for i := 0 to 5 do + begin + P[i].X := x + HEXAGON[i].X*r; + P[i].Y := y + HEXAGON[i].Y*r; + end; + + if FStoredColor <> FBarColor then + begin + EpsColor(FBarColor, cR,cG,cB); + FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [cR, cG, cB], FFormatSettings)); + FStoredColor := FBarColor; + end; -procedure TEpsBarcodeDrawer.EpsColor(AColor: TColor; out R,G,B: Double); + FList.Add(Format( + 'newpath '+ + '%.2f %.2f moveto '+ + '%.2f %.2f lineto '+ + '%.2f %.2f lineto '+ + '%.2f %.2f lineto '+ + '%.2f %.2f lineto '+ + '%.2f %.2f lineto '+ + '0 setlinewidth '+ + 'closepath '+ + 'fill', + [P[0].X, P[0].Y, P[1].X, P[1].Y, P[2].X, P[2].Y, P[3].X, P[3].Y, P[4].X, P[4].Y, P[5].X, P[5].Y], + FFormatSettings + )); +end; + +procedure TEpsBarcodeDrawer.DrawRing(x, y, rOuter, rInner: Double); +var + r: Double; + cR, cG, cB: Double; +begin + if FStoredColor <> FBarColor then + begin + EpsColor(FBarColor, cR,cG,cB); + FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [cR, cG, cB], FFormatSettings)); + FStoredColor := FBarColor; + end; + + FList.Add(Format( + '%.2f setlinewidth %.2f %.2f %.2f 0 360 arc closepath', + [abs(rOuter-rInner), x, y, (rOuter + rInner) / 2], + FFormatSettings + )); +end; + +procedure TEpsBarcodeDrawer.EpsColor(AColor: TColor; out cR,cG,cB: Double); type TRgb = packed record R, G, B: Byte; @@ -337,9 +473,9 @@ type var rgb: TRgb absolute AColor; begin - R := rgb.R / 255; - G := rgb.G / 255; - B := rgb.B / 255; + cR := rgb.R / 255; + cG := rgb.G / 255; + cB := rgb.B / 255; end; end.