You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -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(
|
||||
' <polygon fill="%s" points="%.3fmm,%.3fmm %.3fmm,%.3fmm %.3fmm,%.3fmm %.3fmm,%.3fmm %.3fmm,%.3fmm %.3fmm,%.3fmm" />',
|
||||
[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(
|
||||
' <circle cx="%.3fmm" cy="%.3fmm" r="%.3fmm" stroke-width="%.3fmm" stroke="%s" fill="none" />', [
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user