368 lines
10 KiB
ObjectPascal
368 lines
10 KiB
ObjectPascal
|
|
||
|
|
{******************************************}
|
||
|
|
{ }
|
||
|
|
{ FastReport VCL }
|
||
|
|
{ ZipCode Object }
|
||
|
|
{ }
|
||
|
|
{ Copyright (c) 1998-2021 }
|
||
|
|
{ by Fast Reports Inc. }
|
||
|
|
{ }
|
||
|
|
{******************************************}
|
||
|
|
|
||
|
|
unit frxZipCode;
|
||
|
|
|
||
|
|
{$I frx.inc}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, Graphics, Types,
|
||
|
|
frxClass
|
||
|
|
{$IFDEF DELPHI16}
|
||
|
|
, Vcl.Controls
|
||
|
|
{$ENDIF};
|
||
|
|
|
||
|
|
type
|
||
|
|
TZipCodeKind = (zcCustom, zcInternational, zcRF, zcSample);
|
||
|
|
{$IFDEF DELPHI16}
|
||
|
|
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
|
||
|
|
{$ENDIF}
|
||
|
|
TfrxZipCodeObject = class(TComponent); // fake component
|
||
|
|
|
||
|
|
TfrxZipCodeView = class(TfrxView)
|
||
|
|
private
|
||
|
|
FmmDigitWidth: Extended;
|
||
|
|
FmmDigitHeight: Extended;
|
||
|
|
FmmSpacing: Extended;
|
||
|
|
FmmLineWidth: Extended;
|
||
|
|
FShowMarkers: Boolean;
|
||
|
|
FShowGrid: Boolean;
|
||
|
|
FExpression: String;
|
||
|
|
FText: String;
|
||
|
|
FDigitCount: Integer;
|
||
|
|
FKind: TZipCodeKind;
|
||
|
|
FColor: TColor;
|
||
|
|
procedure SetKind(const Value: TZipCodeKind);
|
||
|
|
procedure SetmmDigitWidth(const Value: Extended);
|
||
|
|
procedure SetmmDigitHeight(const Value: Extended);
|
||
|
|
procedure SetmmLineWidth(const Value: Extended);
|
||
|
|
procedure SetmmSpacing(const Value: Extended);
|
||
|
|
procedure SetDigitCount(const Value: Integer);
|
||
|
|
procedure SetShowMarkers(const Value: Boolean);
|
||
|
|
procedure SetShowGrid(const Value: Boolean);
|
||
|
|
procedure SetText(const Value: String);
|
||
|
|
protected
|
||
|
|
FMarker: Integer; // if ShowMarkers then FMarker := 1 else FMarker := 0;
|
||
|
|
F1mm: TfrxPoint;
|
||
|
|
FSpacing: Extended;
|
||
|
|
FMarkerHeight: Extended;
|
||
|
|
FMarkerWidth: Extended;
|
||
|
|
FGridPoint: TfrxPoint;
|
||
|
|
FGridStep: TfrxPoint;
|
||
|
|
FDigitLeftTop: TfrxPoint;
|
||
|
|
FDigitWidth: Extended;
|
||
|
|
FDigitHeight: Extended;
|
||
|
|
FDigitPenThickness: Extended;
|
||
|
|
procedure DrawSegment(Canvas: TCanvas; Number: Integer);
|
||
|
|
procedure PaintPolyline(Canvas: TCanvas; const Ps: array of TPoint);
|
||
|
|
public
|
||
|
|
constructor Create(AOwner: TComponent); override;
|
||
|
|
procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
|
||
|
|
procedure GetData; override;
|
||
|
|
published
|
||
|
|
property FillType;
|
||
|
|
property Fill;
|
||
|
|
property Cursor;
|
||
|
|
|
||
|
|
property DataField;
|
||
|
|
property DataSet;
|
||
|
|
property DataSetName;
|
||
|
|
property Expression: String read FExpression write FExpression;
|
||
|
|
property Text: String read FText write SetText;
|
||
|
|
|
||
|
|
property Kind: TZipCodeKind read FKind write SetKind;
|
||
|
|
property mmDigitWidth: Extended read FmmDigitWidth write SetmmDigitWidth;
|
||
|
|
property mmDigitHeight: Extended read FmmDigitHeight write SetmmDigitHeight;
|
||
|
|
property mmLineWidth: Extended read FmmLineWidth write SetmmLineWidth;
|
||
|
|
property mmSpacing: Extended read FmmSpacing write SetmmSpacing;
|
||
|
|
property DigitCount: Integer read FDigitCount write SetDigitCount;
|
||
|
|
property ShowMarkers: Boolean read FShowMarkers write SetShowMarkers;
|
||
|
|
property ShowGrid: Boolean read FShowGrid write SetShowGrid;
|
||
|
|
property Color: TColor read FColor write FColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
Variants,
|
||
|
|
frxDsgnIntf, frxRes, frxUtils, frxZipCodeInPlaceEditor;
|
||
|
|
|
||
|
|
const
|
||
|
|
mmPointDiameter = 0.25;
|
||
|
|
mmMarkerOverhang = 1;
|
||
|
|
mmMarkerHeight = 2;
|
||
|
|
|
||
|
|
{ Utilities }
|
||
|
|
|
||
|
|
function p(X, Y: Integer): TPoint;
|
||
|
|
begin
|
||
|
|
Result := Point(X, Y);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TfrxZipCodeView }
|
||
|
|
|
||
|
|
constructor TfrxZipCodeView.Create(AOwner: TComponent);
|
||
|
|
begin
|
||
|
|
inherited;
|
||
|
|
|
||
|
|
Kind := zcRF;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
|
||
|
|
OffsetY: Extended);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
F1mm := frxPoint(fr01cm * ScaleX, fr01cm * ScaleY);
|
||
|
|
FSpacing := mmSpacing * F1mm.X;
|
||
|
|
FMarkerHeight := mmMarkerHeight * F1mm.Y;
|
||
|
|
FMarkerWidth := (mmDigitWidth + 2 * mmMarkerOverhang) * F1mm.X;
|
||
|
|
FGridPoint := frxPoint(0.25 * F1mm.X, 0.25 * F1mm.Y);
|
||
|
|
FGridStep := frxPoint(mmDigitWidth / 5 * F1mm.X, mmDigitHeight / 10 * F1mm.Y);
|
||
|
|
FDigitWidth := mmDigitWidth * F1mm.X;
|
||
|
|
FDigitHeight := mmDigitHeight * F1mm.Y;
|
||
|
|
FDigitPenThickness := mmLineWidth * (F1mm.X + F1mm.Y) / 2;
|
||
|
|
|
||
|
|
if ShowMarkers then FMarker := 1 else FMarker := 0;
|
||
|
|
Width := (DigitCount + FMarker) * FSpacing / ScaleX;
|
||
|
|
Height := (FDigitHeight + FMarker * 2 * FMarkerHeight + FDigitPenThickness / 2) / ScaleY + 1;
|
||
|
|
|
||
|
|
inherited;
|
||
|
|
|
||
|
|
Canvas.Pen.Color := Color;
|
||
|
|
Canvas.Brush.Color := Color;
|
||
|
|
Canvas.Brush.Style := bsSolid;
|
||
|
|
for i := 0 to DigitCount + FMarker - 1 do
|
||
|
|
DrawSegment(Canvas, i);
|
||
|
|
if FHighlighted then
|
||
|
|
TransparentFillRect(FCanvas.Handle, FX, FY, FX1, FY1, clSkyBlue);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.DrawSegment(Canvas: TCanvas; Number: Integer);
|
||
|
|
var
|
||
|
|
iX, iY, x1, y1, x2, y2, Index: Integer;
|
||
|
|
MarkerX: Extended;
|
||
|
|
Digit: Char;
|
||
|
|
FirstMarker: boolean;
|
||
|
|
begin
|
||
|
|
MarkerX := FX + Round(Number * FSpacing);
|
||
|
|
FDigitLeftTop := frxPoint(MarkerX + 1 * F1mm.X,
|
||
|
|
FY + Round(FMarker * 2 * FMarkerHeight));
|
||
|
|
Canvas.Pen.Width := 1;
|
||
|
|
if ShowMarkers then
|
||
|
|
begin
|
||
|
|
Canvas.Rectangle(Round(MarkerX), FY,
|
||
|
|
Round(MarkerX + FMarkerWidth), Round(FY + FMarkerHeight));
|
||
|
|
|
||
|
|
if Number = 0 then
|
||
|
|
Canvas.Rectangle(Round(MarkerX), Round(FY + FMarkerHeight + F1mm.X),
|
||
|
|
Round(MarkerX + FMarkerWidth), Round(FY + FMarkerHeight + 2 * F1mm.Y));
|
||
|
|
end;
|
||
|
|
|
||
|
|
FirstMarker := ShowMarkers and (Number = 0);
|
||
|
|
|
||
|
|
if not FirstMarker and ShowGrid then
|
||
|
|
for iX := 0 to 5 do
|
||
|
|
for iY := 0 to 10 do
|
||
|
|
if (iX mod 5 = 0) or (iY mod 5 = 0) or ((iX + iY) mod 5 = 0)then
|
||
|
|
begin
|
||
|
|
x1 := Round(FDigitLeftTop.X + iX * FGridStep.X - FGridPoint.X / 2);
|
||
|
|
y1 := Round(FDigitLeftTop.Y + iY * FGridStep.Y - FGridPoint.Y / 2);
|
||
|
|
x2 := x1 + Round(FGridPoint.X);
|
||
|
|
y2 := y1 + Round(FGridPoint.Y);
|
||
|
|
Canvas.Ellipse(x1, y1, x2 + 1, y2 + 1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Index := Number + 1 - FMarker;
|
||
|
|
Canvas.Pen.Width := Round(FDigitPenThickness);
|
||
|
|
if not FirstMarker and (Index <= Length(Text)) then
|
||
|
|
begin
|
||
|
|
Digit := Text[Index];
|
||
|
|
case Digit of
|
||
|
|
'0': PaintPolyline(Canvas,
|
||
|
|
[p(0, 0), p(1, 0), p(1, 2), p(0, 2), p(0, 0)]);
|
||
|
|
'1': PaintPolyline(Canvas,
|
||
|
|
[p(0, 1), p(1, 0), p(1, 2)]);
|
||
|
|
'2': PaintPolyline(Canvas,
|
||
|
|
[p(0, 0), p(1, 0), p(1, 1), p(0, 2), p(1, 2)]);
|
||
|
|
'3': PaintPolyline(Canvas,
|
||
|
|
[p(0, 0), p(1, 0), p(0, 1), p(1, 1), p(0, 2)]);
|
||
|
|
'4': PaintPolyline(Canvas,
|
||
|
|
[p(0, 0), p(0, 1), p(1, 1), p(1, 0), p(1, 2)]);
|
||
|
|
'5': PaintPolyline(Canvas,
|
||
|
|
[p(1, 0), p(0, 0), p(0, 1), p(1, 1), p(1, 2), p(0, 2)]);
|
||
|
|
'6': PaintPolyline(Canvas,
|
||
|
|
[p(1, 0), p(0, 1), p(0, 2), p(1, 2), p(1, 1), p(0, 1)]);
|
||
|
|
'7': PaintPolyline(Canvas,
|
||
|
|
[p(0, 0), p(1, 0), p(0, 1), p(0, 2)]);
|
||
|
|
'8': PaintPolyline(Canvas,
|
||
|
|
[p(0, 0), p(1, 0), p(1, 2), p(0, 2), p(0, 0), p(0, 1), p(1, 1)]);
|
||
|
|
'9': PaintPolyline(Canvas,
|
||
|
|
[p(0, 2), p(1, 1), p(1, 0), p(0, 0), p(0, 1), p(1, 1)]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.GetData;
|
||
|
|
begin
|
||
|
|
inherited;
|
||
|
|
|
||
|
|
if IsDataField then
|
||
|
|
FText := VarToStr(DataSet.Value[DataField])
|
||
|
|
else if FExpression <> '' then
|
||
|
|
FText := VarToStr(Report.Calc(FExpression));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.PaintPolyline(Canvas: TCanvas; const Ps: array of TPoint);
|
||
|
|
var
|
||
|
|
Points: array of TPoint;
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
SetLength(Points, Length(Ps));
|
||
|
|
|
||
|
|
for i := Low(Ps) to High(Ps) do
|
||
|
|
Points[i] := Point(Round(FDigitLeftTop.X + Ps[i].X * FDigitWidth),
|
||
|
|
Round(FDigitLeftTop.Y + Ps[i].Y * FDigitHeight / 2));
|
||
|
|
Canvas.Polyline(Points);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetDigitCount(const Value: Integer);
|
||
|
|
begin
|
||
|
|
if FDigitCount <> Value then
|
||
|
|
begin
|
||
|
|
FDigitCount := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetKind(const Value: TZipCodeKind);
|
||
|
|
begin
|
||
|
|
if Kind <> Value then
|
||
|
|
begin
|
||
|
|
FKind := Value;
|
||
|
|
case Kind of
|
||
|
|
zcInternational:
|
||
|
|
begin
|
||
|
|
mmDigitWidth := 5;
|
||
|
|
mmDigitHeight := 10;
|
||
|
|
mmLineWidth := 1;
|
||
|
|
mmSpacing := 9;
|
||
|
|
DigitCount := 3;
|
||
|
|
ShowMarkers := True;
|
||
|
|
ShowGrid := False;
|
||
|
|
Text := '555';
|
||
|
|
end;
|
||
|
|
zcRF:
|
||
|
|
begin
|
||
|
|
mmDigitWidth := 5;
|
||
|
|
mmDigitHeight := 10;
|
||
|
|
mmLineWidth := 0.625;
|
||
|
|
mmSpacing := 9;
|
||
|
|
DigitCount := 6;
|
||
|
|
ShowMarkers := True;
|
||
|
|
ShowGrid := True;
|
||
|
|
end;
|
||
|
|
zcSample:
|
||
|
|
begin
|
||
|
|
mmDigitWidth := 4;
|
||
|
|
mmDigitHeight := 8;
|
||
|
|
mmLineWidth := 0.5;
|
||
|
|
mmSpacing := 7;
|
||
|
|
DigitCount := 10;
|
||
|
|
ShowMarkers := False;
|
||
|
|
ShowGrid := True;
|
||
|
|
Text := '0123456789';
|
||
|
|
end;
|
||
|
|
else // zcCustom:
|
||
|
|
{ Do nothing }
|
||
|
|
end;
|
||
|
|
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetmmDigitHeight(const Value: Extended);
|
||
|
|
begin
|
||
|
|
if FmmDigitHeight <> Value then
|
||
|
|
begin
|
||
|
|
FmmDigitHeight := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetmmDigitWidth(const Value: Extended);
|
||
|
|
begin
|
||
|
|
if FmmDigitWidth <> Value then
|
||
|
|
begin
|
||
|
|
FmmDigitWidth := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetmmLineWidth(const Value: Extended);
|
||
|
|
begin
|
||
|
|
if FmmLineWidth <> Value then
|
||
|
|
begin
|
||
|
|
FmmLineWidth := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetmmSpacing(const Value: Extended);
|
||
|
|
begin
|
||
|
|
if FmmSpacing <> Value then
|
||
|
|
begin
|
||
|
|
FmmSpacing := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetShowGrid(const Value: Boolean);
|
||
|
|
begin
|
||
|
|
if FShowGrid <> Value then
|
||
|
|
begin
|
||
|
|
FShowGrid := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetShowMarkers(const Value: Boolean);
|
||
|
|
begin
|
||
|
|
if FShowMarkers <> Value then
|
||
|
|
begin
|
||
|
|
FShowMarkers := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxZipCodeView.SetText(const Value: String);
|
||
|
|
begin
|
||
|
|
if FText <> Value then
|
||
|
|
begin
|
||
|
|
FText := Value;
|
||
|
|
FKind := zcCustom;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$IFDEF DELPHI16}
|
||
|
|
StartClassGroup(TControl);
|
||
|
|
ActivateClassGroup(TControl);
|
||
|
|
GroupDescendentsWith(TfrxZipCodeObject, TControl);
|
||
|
|
{$ENDIF}
|
||
|
|
frxObjects.RegisterObject1(TfrxZipCodeView, nil, frxResources.Get('obZipCode'), '', 0, 68);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
frxObjects.Unregister(TfrxZipCodeView);
|
||
|
|
|
||
|
|
end.
|