mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 15:19:05 +02:00
849 lines
20 KiB
ObjectPascal
849 lines
20 KiB
ObjectPascal
{*******************************************}
|
|
{ }
|
|
{ FastReport v2.3 }
|
|
{ Barcode Add-in object }
|
|
{ }
|
|
{ Copyright (c) 1998-99 by Tzyganenko A. }
|
|
{ }
|
|
|
|
// Barcode Component
|
|
// Version 1.3
|
|
// Copyright 1998-99 Andreas Schmidt and friends
|
|
|
|
// Freeware
|
|
|
|
// for use with Delphi 2/3/4
|
|
|
|
|
|
// this component is for private use only!
|
|
// i am not responsible for wrong barcodes
|
|
// Code128C not implemented
|
|
|
|
// bug-reports, enhancements:
|
|
// mailto:shmia@bizerba.de or
|
|
// a_j_schmidt@rocketmail.com
|
|
|
|
{ Fr_BarC: Guilbaud Olivier }
|
|
{ golivier@worldnet.fr }
|
|
{ Ported to FR2.3: Alexander Tzyganenko }
|
|
{ }
|
|
{*******************************************}
|
|
|
|
unit LR_BarC;
|
|
|
|
{$I lr_vers.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
LCLPlatformDef, InterfaceBase, Graphics, Controls, Forms, Dialogs,
|
|
Buttons, StdCtrls, Menus, Barcode, ExtCtrls, ButtonPanel,
|
|
LCLType, LR_Class
|
|
{$IFDEF LCLNOGUI}
|
|
,lr_ngcanvas
|
|
{$ENDIF}
|
|
;
|
|
|
|
|
|
{.$DEFINE BC_1_25} //For Barcode version 1.25 actually in debug
|
|
type
|
|
{$IFDEF BC_1_25}
|
|
TBarCode=Class(TAsBarCode);
|
|
{$ENDIF}
|
|
|
|
{ TfrBarCodeObject }
|
|
|
|
TfrBarCodeObject = class(TComponent) // fake component
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
end;
|
|
|
|
TfrBarCode = packed record
|
|
cCheckSum : Boolean;
|
|
cShowText : Boolean;
|
|
cCadr : Boolean;
|
|
cBarType : TBarcodeType;
|
|
cModul : Integer;
|
|
cRatio : Double;
|
|
cAngle : Double;
|
|
end;
|
|
|
|
{ TfrCustomBarCodeView }
|
|
|
|
TfrCustomBarCodeView = class(TfrView)
|
|
private
|
|
BarC: TBarCode;
|
|
FText: string;
|
|
|
|
function GetAngle: Double;
|
|
function GetBarType: TBarcodeType;
|
|
function GetCheckSum: Boolean;
|
|
function GetShowText: Boolean;
|
|
function GetZoom: Double;
|
|
procedure SetAngle(AValue: Double);
|
|
procedure SetBarType(const AValue: TBarcodeType);
|
|
procedure SetCheckSum(const AValue: Boolean);
|
|
procedure SetShowText(const AValue: Boolean);
|
|
procedure SetZoom(const AValue: Double);
|
|
function CreateBarcode: TLazreportBitmap;
|
|
function CreateLabelFont(aCanvas: TCanvas): TFont;
|
|
procedure DrawLabel(aCanvas: TCanvas; R: TRect);
|
|
public
|
|
Param: TfrBarCode;
|
|
|
|
constructor Create(AOwnerPage:TfrPage);override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function GenerateBitmap: TLazreportBitmap; virtual;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
procedure Draw(aCanvas: TCanvas); override;
|
|
procedure Print(Stream: TStream); override;
|
|
procedure DefinePopupMenu({%H-}Popup: TPopupMenu); override;
|
|
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
|
|
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
|
|
|
|
property CheckSum : Boolean read GetCheckSum write SetCheckSum;
|
|
property BarType : TBarcodeType read GetBarType write SetBarType;
|
|
property ShowText : Boolean read GetShowText write SetShowText;
|
|
property Zoom : Double read GetZoom write SetZoom;
|
|
property Angle: Double read GetAngle write SetAngle;
|
|
end;
|
|
|
|
TfrBarcodeView = class(TfrCustomBarcodeView)
|
|
published
|
|
property CheckSum;
|
|
property BarType;
|
|
property ShowText;
|
|
property Zoom;
|
|
property Angle;
|
|
property Memo;
|
|
property Frames;
|
|
property FrameColor;
|
|
property FrameStyle;
|
|
property FrameWidth;
|
|
property Restrictions;
|
|
end;
|
|
|
|
{$IFNDEF LCLNOGUI}
|
|
|
|
{ TfrBarCodeForm }
|
|
|
|
TfrBarCodeForm = class(TfrObjEditorForm)
|
|
ButtonPanel1: TButtonPanel;
|
|
edZoom: TEdit;
|
|
labZoom: TLabel;
|
|
M1: TEdit;
|
|
Label1: TLabel;
|
|
cbType: TComboBox;
|
|
Label2: TLabel;
|
|
Image1: TImage;
|
|
Panel1: TPanel;
|
|
DBBtn: TSpeedButton;
|
|
VarBtn: TSpeedButton;
|
|
GroupBox1: TGroupBox;
|
|
ckCheckSum: TCheckBox;
|
|
ckViewText: TCheckBox;
|
|
GroupBox2: TGroupBox;
|
|
RB1: TRadioButton;
|
|
RB2: TRadioButton;
|
|
RB3: TRadioButton;
|
|
RB4: TRadioButton;
|
|
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure VarBtnClick(Sender: TObject);
|
|
procedure DBBtnClick(Sender: TObject);
|
|
procedure bOkClick(Sender: TObject);
|
|
procedure FormActivate(Sender: TObject);
|
|
procedure edZoomKeyPress(Sender: TObject; var Key: char);
|
|
public
|
|
procedure ShowEditor(t: TfrView); override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
implementation
|
|
|
|
uses LR_Var, LR_Flds, LR_Const, LR_Utils;
|
|
|
|
{$IFNDEF LCLNOGUI}
|
|
{$R *.lfm}
|
|
|
|
var
|
|
frBarCodeForm: TfrBarCodeForm;
|
|
{$ENDIF}
|
|
|
|
const
|
|
cbDefaultText ='12345678';
|
|
bcNames: array[bcCode_2_5_interleaved..{$IFNDEF BC_1_25}bcCodeEAN13{$ELSE}bcCodeEAN128C{$ENDIF}, 0..1] of string =
|
|
(('2_5_interleaved', 'N'),
|
|
('2_5_industrial', 'N'),
|
|
('2_5_matrix', 'N'),
|
|
('Code39', 'A'),
|
|
('Code39 Extended', 'A'),
|
|
('Code128A', 'A'),
|
|
('Code128B', 'A'),
|
|
('Code128C', 'N'),
|
|
('Code93', 'A'),
|
|
('Code93 Extended', 'A'),
|
|
('MSI', 'N'),
|
|
('PostNet', 'N'),
|
|
('Codebar', 'A'),
|
|
('EAN8', 'N'),
|
|
('EAN13', 'N')
|
|
{$IFDEF BC_1_25}
|
|
,
|
|
('UPC A','N'),
|
|
('UPC E0','N'),
|
|
('UPC E1','N'),
|
|
('UPC SUPP 2','N'),
|
|
('UPC SUPP 5','N'),
|
|
('EAN128A','A'),
|
|
('EAN128B','A'),
|
|
('EAN128C','N')
|
|
{$ENDIF}
|
|
);
|
|
|
|
defaultFontSize = 10;
|
|
|
|
{$PUSH}
|
|
{$HINTS OFF}
|
|
{$NOTES OFF}
|
|
function isNumeric(St: String): Boolean;
|
|
var
|
|
{%H-}R: Double;
|
|
E: Integer;
|
|
begin
|
|
Val(St, R, E);
|
|
Result := (E = 0);
|
|
end;
|
|
{$POP}
|
|
|
|
function TfrCustomBarCodeView.GetBarType: TBarcodeType;
|
|
begin
|
|
Result:=Param.cBarType;
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.GetAngle: Double;
|
|
begin
|
|
Result := Param.cAngle;
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.GetCheckSum: Boolean;
|
|
begin
|
|
Result:=Param.cCheckSum;
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.GetShowText: Boolean;
|
|
begin
|
|
Result:=Param.cShowText;
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.GetZoom: Double;
|
|
begin
|
|
Result:=Param.cRatio;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SetAngle(AValue: Double);
|
|
begin
|
|
if (Param.cAngle<>AValue) and
|
|
((AValue=0.0) or (AValue=90.0) or (AValue=180.0) or (AValue=270.0)) then
|
|
begin
|
|
BeforeChange;
|
|
Param.cAngle:=AValue;
|
|
AfterChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SetBarType(const AValue: TBarcodeType);
|
|
begin
|
|
if Param.cBarType<>AValue then
|
|
begin
|
|
BeforeChange;
|
|
Param.cBarType:=aValue;
|
|
AfterChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SetCheckSum(const AValue: Boolean);
|
|
begin
|
|
if Param.cCheckSum<>AValue then
|
|
begin
|
|
BeforeChange;
|
|
Param.cCheckSum:=aValue;
|
|
AfterChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SetShowText(const AValue: Boolean);
|
|
begin
|
|
if Param.cShowText<>AValue then
|
|
begin
|
|
BeforeChange;
|
|
Param.cShowText:=aValue;
|
|
AfterChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SetZoom(const AValue: Double);
|
|
begin
|
|
if (Param.cRatio<>AValue) and
|
|
((AValue>=1.0)and(Avalue<=4.0)) then
|
|
begin
|
|
BeforeChange;
|
|
Param.cRatio:=aValue;
|
|
AfterChange;
|
|
end;
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.CreateBarcode: TLazreportBitmap;
|
|
begin
|
|
|
|
Result := nil;
|
|
if Trim(Memo.Text) = '' then
|
|
Exit;
|
|
|
|
{Assign Barcode text}
|
|
Memo1.Assign(Memo);
|
|
|
|
if (Memo1.Text <> '') and (pos('[',Memo1.Strings[0])=0) and
|
|
((bcNames[Param.cBarType, 1] = 'A') or IsNumeric(Memo1.Strings[0]) or
|
|
Barc.BarcodeTypeChecked(Param.cBarType) ) then
|
|
begin
|
|
BarC.Text := Memo1.Strings[0];
|
|
BarC.Checksum := Param.cCheckSum;
|
|
end
|
|
else
|
|
begin
|
|
BarC.Text := cbDefaultText;
|
|
BarC.Checksum := true;
|
|
end;
|
|
|
|
if Trim(BarC.Text)='0' then Exit;
|
|
|
|
{Barcode Properties}
|
|
BarC.Left:= 0;
|
|
BarC.Top := 0;
|
|
BarC.Typ := Param.cBarType;
|
|
BarC.Angle := Param.cAngle;
|
|
BarC.Ratio := 2; // param.cRatio <>2 renders some codes unreadable
|
|
BarC.Modul := 1; // param.cModul
|
|
{$IFDEF BC_1_25}
|
|
BarC.ShowTextPosition:=stpBottomCenter;
|
|
BarC.ShowText := bcoNone;
|
|
|
|
if FillColor=clNone then
|
|
BarC.Color:=clWhite
|
|
else
|
|
BarC.Color:=FillColor;
|
|
|
|
{$ELSE}
|
|
BarC.ShowText:=False;
|
|
{$ENDIF}
|
|
|
|
|
|
{Barcode width is determined by type of barcode and text. Update
|
|
object dimensions to suit barcode}
|
|
|
|
if (Param.cAngle = 90) or (Param.cAngle = 270) then
|
|
dy := BarC.Width
|
|
else
|
|
dx := BarC.Width;
|
|
|
|
|
|
if (Param.cAngle = 90) or (Param.cAngle = 270) then
|
|
BarC.Height := dx
|
|
else
|
|
BarC.Height := dy;
|
|
|
|
if (BarC.Typ=bcCodePostNet) and (Param.cAngle=0) then
|
|
begin
|
|
BarC.Top:=BarC.Height;
|
|
BarC.Height:=-BarC.Height;
|
|
end;
|
|
|
|
if Param.cAngle = 90 then
|
|
begin
|
|
BarC.Top:= Round(Height);
|
|
BarC.Left:=0;
|
|
end
|
|
else
|
|
if Param.cAngle = 180 then
|
|
begin
|
|
BarC.Top:= dy;
|
|
BarC.Left:= dx;
|
|
end
|
|
else
|
|
if Param.cAngle = 270 then
|
|
begin
|
|
BarC.Top:= 0;
|
|
BarC.Left:= dx;
|
|
end;
|
|
|
|
result := TLazreportBitmap.Create;
|
|
|
|
Result.Width:=dx;
|
|
Result.Height:=dy;
|
|
Result.Canvas.Brush.Style:=bsSolid;
|
|
Result.Canvas.Brush.Color:=clWhite;
|
|
Result.Canvas.FillRect(Rect(0,0,dx,dy));
|
|
|
|
try
|
|
BarC.DrawBarcode(Result.Canvas);
|
|
if BarC.Checksum then
|
|
FText := BarC.CodeText
|
|
else
|
|
FText := BarC.Text;
|
|
except on E: Exception do
|
|
FText := E.Message
|
|
end;
|
|
|
|
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.CreateLabelFont(aCanvas: TCanvas) :TFont;
|
|
begin
|
|
with aCanvas do
|
|
begin
|
|
Result := TFont.Create;
|
|
Result.Assign(aCanvas.Font);
|
|
Result.Color := clBlack;
|
|
Result.Name := 'Arial';
|
|
Result.Style := [];
|
|
Result.Size := -defaultFontSize;
|
|
|
|
if Param.cAngle = 90 then
|
|
Result.Orientation := 900
|
|
else
|
|
if Param.cAngle = 180 then
|
|
Result.Orientation := 1800
|
|
else
|
|
if Param.cAngle = 270 then
|
|
Result.Orientation := 2700
|
|
else
|
|
Result.Orientation := 0;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
procedure TfrCustomBarCodeView.DrawLabel(aCanvas: TCanvas; R: TRect);
|
|
var fs: integer;
|
|
begin
|
|
if Param.cShowText then
|
|
begin
|
|
with aCanvas do
|
|
begin
|
|
fs := Font.Height;
|
|
|
|
if Param.cAngle = 0 then
|
|
begin
|
|
Brush.Color:=clWhite;
|
|
Brush.Style:=bsSolid;
|
|
FillRect(Rect(R.Left,R.Top + dy-fs ,R.Right, R.Bottom));
|
|
TextOut(R.Left + (dx - TextWidth(FText)) div 2, R.Top + dy - fs, FText);
|
|
end
|
|
else
|
|
if Param.cAngle = 90 then
|
|
begin
|
|
Brush.Color:=clWhite;
|
|
Brush.Style:=bsSolid;
|
|
FillRect(Rect(R.Left + dx - fs,R.Top,R.Right, R.Bottom));
|
|
Font.Orientation := 900;
|
|
|
|
TextOut(R.Right - fs,R.Bottom - (dy - TextWidth(FText)) div 2, FText)
|
|
end
|
|
else
|
|
if Param.cAngle = 180 then
|
|
begin
|
|
Brush.Color:=clWhite;
|
|
Brush.Style:=bsSolid;
|
|
FillRect(Rect(R.Left,R.Top,R.Right,R.Top + fs));
|
|
Font.Orientation := 1800;
|
|
TextOut(R.left + (dx + TextWidth(FText)) div 2, R.Top + fs, FText);
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color:=clWhite;
|
|
Brush.Style:=bsSolid;
|
|
Font.Orientation := 2700;
|
|
FillRect(Rect(R.Left,R.Top,R.Left + fs,R.Bottom));
|
|
if (WidgetSet.LCLPlatform = lpGtk2) and IsPrinting then
|
|
TextOut(R.Left + fs, R.Top + (dy -TextWidth(FText)) div 2, FText)
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
constructor TfrCustomBarCodeView.Create(AOwnerPage: TfrPage);
|
|
begin
|
|
inherited Create(AOwnerPage);
|
|
|
|
BarC := TBarCode.Create(nil);
|
|
Param.cCheckSum := True;
|
|
Param.cShowText := True;
|
|
Param.cCadr := False;
|
|
Param.cBarType := bcCode39;
|
|
Param.cModul := 2;
|
|
Param.cRatio := 1;
|
|
Param.cAngle := 0;
|
|
Memo.Add(cbDefaultText);
|
|
Typ := gtAddIn;
|
|
BaseName := 'Bar';
|
|
end;
|
|
|
|
destructor TfrCustomBarCodeView.Destroy;
|
|
begin
|
|
BarC.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.Assign(Source: TPersistent);
|
|
begin
|
|
inherited Assign(Source);
|
|
if Source is TfrCustomBarCodeView then
|
|
Param := TfrCustomBarCodeView(Source).Param;
|
|
end;
|
|
|
|
function TfrCustomBarCodeView.GenerateBitmap: TLazreportBitmap;
|
|
var
|
|
R: TRect;
|
|
barcodeFont: TFont;
|
|
oldFont: TFont;
|
|
begin
|
|
Result := CreateBarcode;
|
|
R := Rect(0,0, Result.Width,Result.Height);
|
|
barcodeFont := CreateLabelFont(Result.Canvas);
|
|
try
|
|
oldFont := Result.Canvas.Font;
|
|
Result.Canvas.Font := barcodeFont;
|
|
DrawLabel(Result.Canvas,r)
|
|
finally
|
|
Result.Canvas.Font := oldFont;
|
|
barcodeFont.Free
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.LoadFromStream(Stream:TStream);
|
|
begin
|
|
inherited LoadFromStream(Stream);
|
|
Stream.Read(Param, SizeOf(Param));
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SaveToStream(Stream:TStream);
|
|
begin
|
|
inherited SaveToStream(Stream);
|
|
Stream.Write(Param, SizeOf(Param));
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.Draw(aCanvas:TCanvas);
|
|
var
|
|
Bmp : TLazreportBitmap;
|
|
R: TRect;
|
|
fh: integer;
|
|
barcodeFont: TFont;
|
|
oldFont: TFont;
|
|
begin
|
|
BeginDraw(aCanvas);
|
|
|
|
Bmp := CreateBarcode;
|
|
if Bmp <> nil then
|
|
try
|
|
// dx/dy is calculated in CreateBarCode using as base
|
|
// barcdode type, angle, zoom and data
|
|
if (Param.cAngle = 90) or (Param.cAngle = 270) then
|
|
dy := round(dy * param.cRatio)
|
|
else
|
|
dx := round(dx * Param.cRatio);
|
|
CalcGaps;
|
|
ShowBackground;
|
|
if Param.cShowText then
|
|
begin
|
|
barcodeFont := CreateLabelFont(aCanvas);
|
|
try
|
|
oldFont := aCanvas.Font;
|
|
aCanvas.Font := barcodeFont;
|
|
if not IsPrinting then
|
|
begin
|
|
if (Param.cAngle = 90) or (Param.cAngle = 270) then
|
|
ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleX)
|
|
else
|
|
ACanvas.Font.Height := -Round(ACanvas.Font.Size * ACanvas.Font.PixelsPerInch / 72 * ScaleY);
|
|
fh := Round(aCanvas.Font.Height);
|
|
end
|
|
else
|
|
fh := aCanvas.Font.Height;
|
|
|
|
if (Param.cAngle = 90) then
|
|
R := Rect(DRect.Left,DRect.Top,
|
|
DRect.Right - fh,
|
|
DRect.Bottom)
|
|
else
|
|
if (Param.cAngle = 180) then
|
|
R := Rect(DRect.Left,DRect.Top + fh,
|
|
DRect.Right ,
|
|
DRect.Bottom)
|
|
else
|
|
if (Param.cAngle = 270) then
|
|
R := Rect(DRect.Left + fh,
|
|
DRect.Top,
|
|
DRect.Right,
|
|
DRect.Bottom)
|
|
else
|
|
R := Rect(DRect.Left,DRect.Top,
|
|
DRect.Right ,
|
|
DRect.Bottom - fh);
|
|
{$IFDEF LCLNOGUI}
|
|
TVirtualCanvas(aCanvas).StretchDraw(R,Bmp);
|
|
{$ELSE}
|
|
aCanvas.StretchDraw(R,Bmp);
|
|
{$ENDIF}
|
|
DrawLabel(aCanvas, DRect);
|
|
finally
|
|
aCanvas.Font := oldFont;
|
|
barcodeFont.Free
|
|
end;
|
|
end
|
|
else
|
|
{$IFDEF LCLNOGUI}
|
|
TVirtualCanvas(aCanvas).StretchDraw(DRect,Bmp);
|
|
{$ELSE}
|
|
aCanvas.StretchDraw(DRect,Bmp);
|
|
{$ENDIF}
|
|
|
|
ShowFrame;
|
|
|
|
finally
|
|
Bmp.Free;
|
|
RestoreCoord;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.Print(Stream: TStream);
|
|
begin
|
|
BeginDraw(Canvas);
|
|
Memo1.Assign(Memo);
|
|
CurReport.InternalOnEnterRect(Memo1, Self);
|
|
frInterpretator.DoScript(Script);
|
|
if not Visible then Exit;
|
|
|
|
if Memo1.Count > 0 then
|
|
if (Length(Memo1[0]) > 0) and (Pos('[',Memo1[0])<>0) then
|
|
Memo1[0] := frParser.Calc(Memo1[0]);
|
|
Stream.Write(Typ, 1);
|
|
frWriteString(Stream, ClassName);
|
|
SaveToStream(Stream);
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.DefinePopupMenu(Popup: TPopupMenu);
|
|
begin
|
|
// no specific items in popup menu
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.LoadFromXML(XML: TLrXMLConfig; const Path: String);
|
|
begin
|
|
inherited LoadFromXML(XML, Path);
|
|
|
|
RestoreProperty('BarType',XML.GetValue(Path+'BarCode/BarType',''));
|
|
RestoreProperty('ShowText',XML.GetValue(Path+'BarCode/ShowText',''));
|
|
RestoreProperty('CheckSum',XML.GetValue(Path+'BarCode/CheckSum',''));
|
|
RestoreProperty('Zoom',XML.GetValue(Path+'BarCode/Zoom','1'));
|
|
RestoreProperty('Angle',XML.GetValue(Path+'BarCode/Angle','0'));
|
|
end;
|
|
|
|
procedure TfrCustomBarCodeView.SaveToXML(XML: TLrXMLConfig; const Path: String);
|
|
begin
|
|
inherited SaveToXML(XML, Path);
|
|
|
|
XML.SetValue(Path+'BarCode/BarType', GetSaveProperty('BarType'));
|
|
XML.SetValue(Path+'BarCode/ShowText', GetSaveProperty('ShowText'));
|
|
XML.SetValue(Path+'BarCode/CheckSum', GetSaveProperty('CheckSum'));
|
|
XML.SetValue(Path+'BarCode/Zoom', GetSaveProperty('Zoom'));
|
|
XML.SetValue(Path+'BarCode/Angle', GetSaveProperty('Angle'));
|
|
end;
|
|
|
|
{$IFNDEF LCLNOGUI}
|
|
//--------------------------------------------------------------------------
|
|
procedure TfrBarCodeForm.FormCreate(Sender: TObject);
|
|
var
|
|
i: TBarcodeType;
|
|
begin
|
|
CbType.Items.Clear;
|
|
for i := bcCode_2_5_interleaved to {$IFNDEF BC_1_25}bcCodeEAN13{$ELSE}bcCodeEAN128C{$ENDIF} do
|
|
cbType.Items.Add(bcNames[i, 0]);
|
|
cbType.ItemIndex := 0;
|
|
|
|
Caption := sBarCodeFormTitle;
|
|
Label1.Caption := sBarCodeFormCode;
|
|
Label2.Caption := sBarCodeFormType;
|
|
GroupBox1.Caption := sBarCodeFormOpts;
|
|
ckCheckSum.Caption := sBarCodeFormChksum;
|
|
ckViewText.Caption := sBarCodeFormReadable;
|
|
DBBtn.Hint := sBarCodeFormDbFld;
|
|
VarBtn.Hint := sBarCodeFormVar;
|
|
GroupBox2.Caption := sBarCodeFormRotate;
|
|
labZoom.Caption:=sBarCodeZoom;
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.FormClose(Sender: TObject;
|
|
var CloseAction: TCloseAction);
|
|
begin
|
|
if ModalResult = mrOk then
|
|
bOkClick(nil);
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.FormActivate(Sender: TObject);
|
|
begin
|
|
M1.SetFocus;
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.edZoomKeyPress(Sender: TObject; var Key: char);
|
|
begin
|
|
If (Key>#31) and not (Key in ['0'..'9','.']) then {AJW}
|
|
Key:=#0;
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.ShowEditor(t:TfrView);
|
|
var
|
|
tmp:Double;
|
|
begin
|
|
if t.Memo.Count > 0 then
|
|
M1.Text := t.Memo.Strings[0];
|
|
with t as TfrBarCodeView do
|
|
begin
|
|
cbType.ItemIndex := ord(Param.cBarType);
|
|
ckCheckSum.checked := Param.cCheckSum;
|
|
ckViewText.Checked := Param.cShowText;
|
|
if Param.cAngle = 0 then
|
|
RB1.Checked := True
|
|
else if Param.cAngle = 90 then
|
|
RB2.Checked := True
|
|
else if Param.cAngle = 180 then
|
|
RB3.Checked := True
|
|
else
|
|
RB4.Checked := True;
|
|
edZoom.Text:=SysUtils.Format('%.1f',[Param.cRatio]);
|
|
|
|
if ShowModal = mrOk then
|
|
begin
|
|
Memo.Clear;
|
|
Memo.Add(M1.Text);
|
|
CheckSum := ckCheckSum.Checked;
|
|
ShowText := ckViewText.Checked;
|
|
BarType := TBarcodeType(cbType.ItemIndex);
|
|
tmp := StrToFloatDef(edZoom.Text,1);
|
|
if tmp<1.0 then
|
|
tmp:=1.0;
|
|
Zoom := tmp;
|
|
|
|
if RB1.Checked then
|
|
Angle := 0
|
|
else if RB2.Checked then
|
|
Angle := 90
|
|
else if RB3.Checked then
|
|
Angle := 180
|
|
else
|
|
Angle := 270;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.VarBtnClick(Sender: TObject);
|
|
begin
|
|
frVarForm := TfrVarForm.Create(nil);
|
|
with frVarForm do
|
|
if ShowModal = mrOk then
|
|
if SelectedItem <> '' then
|
|
M1.Text := '[' + SelectedItem + ']';
|
|
frVarForm.Free;
|
|
M1.SetFocus;
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.DBBtnClick(Sender: TObject);
|
|
begin
|
|
frFieldsForm := TfrFieldsForm.Create(nil);
|
|
with frFieldsForm do
|
|
if ShowModal = mrOk then
|
|
if DBField <> '' then
|
|
M1.Text := '[' + DBField + ']';
|
|
frFieldsForm.Free;
|
|
M1.SetFocus;
|
|
end;
|
|
|
|
procedure TfrBarCodeForm.bOkClick(Sender: TObject);
|
|
var
|
|
bc: TBarCode;
|
|
Bmp: TBitmap;
|
|
begin
|
|
Bmp := nil;
|
|
bc := TBarCode.Create(nil);
|
|
try
|
|
if Pos('[',M1.Text) <> 0 then
|
|
begin
|
|
bc.Text := cbDefaultText;
|
|
bc.checksum := true
|
|
end
|
|
else
|
|
begin
|
|
bc.Text := M1.Text;
|
|
bc.CheckSum := ckCheckSum.Checked;
|
|
end;
|
|
bc.Ratio := StrToFloatDef(edZoom.Text,1);
|
|
bc.Typ := TBarcodeType(cbType.ItemIndex);
|
|
Bmp := TBitmap.Create;
|
|
Bmp.Width := 16; Bmp.Height := 16;
|
|
try
|
|
Bmp.Canvas.Brush.Style:=bsSolid;
|
|
Bmp.Canvas.Brush.Color:=clWhite;
|
|
Bmp.Canvas.FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
|
|
|
|
bc.DrawBarcode(Bmp.Canvas);
|
|
except
|
|
MessageDlg(sBarcodeError,mtError,[mbOk],0);
|
|
ModalResult := 0;
|
|
end;
|
|
finally
|
|
Bmp.Free;
|
|
bc.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure InitializeBarcAddin;
|
|
begin
|
|
if not assigned(frBarCodeForm) {and not (csDesigning in ComponentState)} then
|
|
begin
|
|
frBarCodeForm := TfrBarCodeForm.Create(nil);
|
|
frSetAddinEditor(TfrBarcodeView, frBarcodeForm);
|
|
frSetAddinIcon(TfrBarcodeView, frBarCodeForm.Image1.Picture.Bitmap);
|
|
frSetAddinHint(TfrBarcodeView, sInsBarcode);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TfrBarCodeObject }
|
|
|
|
constructor TfrBarCodeObject.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
{$IFNDEF LCLNOGUI}
|
|
InitializeBarcAddin;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFNDEF LCLNOGUI}
|
|
initialization
|
|
frBarcodeForm := nil;
|
|
frRegisterObject(TfrBarCodeView, nil, '', nil, @InitializeBarcAddin);
|
|
|
|
finalization
|
|
if Assigned(frBarCodeForm) then
|
|
frBarCodeForm.Free;
|
|
{$ELSE}
|
|
initialization
|
|
frRegisterObject(TfrBarCodeView, nil, '', nil);
|
|
{$ENDIF}
|
|
|
|
end.
|