fpc/packages/fcl-image/examples/createbarcode.lpr
michael 8cd2ebf94b * Add barcode drawing routines
git-svn-id: trunk@37305 -
2017-09-23 20:20:50 +00:00

156 lines
3.3 KiB
ObjectPascal

program createbarcode;
{$mode objfpc}
{$H+}
uses
Classes, SysUtils, CustApp, fpbarcode, fpimgbarcode, fpimage,
fpwritepng, fpwritebmp,fpwritejpeg,FPWritePNM,fpwritexpm;
type
{ TCreateBarcodeApplication }
TCreateBarcodeApplication = class(TCustomApplication)
Private
FWidth : Cardinal;
FHeight : Cardinal;
FUnit : Cardinal;
FWeight : Double;
FText : string;
FFileName : String;
FEncoding : TBarcodeEncoding;
flist : Boolean;
protected
procedure DoRun; override;
Procedure ListEncodings;
Procedure CreateBarCode;
public
constructor Create(TheOwner: TComponent); override;
procedure WriteHelp(S: String); virtual;
Procedure AnalyzeParams;
end;
{ TCreateBarcodeApplication }
procedure TCreateBarcodeApplication.DoRun;
begin
AnalyzeParams;
if FList then
ListEncodings
else
CreateBarCode;
Terminate;
end;
procedure TCreateBarcodeApplication.ListEncodings;
Var
E : TBarcodeEncoding;
S : String;
begin
Writeln('Known encodings : ');
For E in TBarcodeEncoding do
begin
Str(E,S);
Delete(S,1,2);
Writeln(S:16,': ',BarcodeEncodingNames[E]);
end;
end;
procedure TCreateBarcodeApplication.CreateBarCode;
Var
Img : TFPCustomImage;
begin
Img:=TFPCompactImgGray16Bit.Create(FWidth,FHeight);
try
DrawBarCode(Img,FText,FEncoding,FUnit,FWeight);
Writeln('Writing to file : ',FFilename);
Img.SaveToFile(FFileName);
finally
Img.Free;
end;
end;
constructor TCreateBarcodeApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
procedure TCreateBarcodeApplication.WriteHelp(S : String);
begin
if (S<>'') then
Writeln('Error : ',S);
writeln('Usage: ', ExeName, ' -h');
Free;
Halt(Ord(S<>''));
end;
procedure TCreateBarcodeApplication.AnalyzeParams;
Var
S,ES : String;
E : TBarcodeEncoding;
B : Boolean;
begin
S:=CheckOptions('hw:h:t:o:lu:i:e:', ['help','width:','height:','text:','encoding','output:','list','unit:','weight:']);
if (S<>'') or HasOption('h', 'help') then
WriteHelp(S);
if HasOption('h','height') then
FHeight:=StrToInt(GetOptionValue('h','height'));
if HasOption('w','width') then
FWidth:=StrToInt(GetOptionValue('w','width'));
if HasOption('u','unit') then
FUnit:=StrToInt(GetOptionValue('u','unit'));
if HasOption('i','weight') then
FWeight:=StrToFloat(GetOptionValue('i','weight'));
FText:=GetOptionValue('t','text');
FFileName:=GetOptionValue('o','output');
S:=GetOptionValue('e','encoding');
FList:=HasOption('l','list');
if FList then
exit;
// Sanitize
if (S='') then
WriteHelp('Need barcode encoding');
if FText='' then
WriteHelp('Need a text');
E:=Low(TBarCodeEncoding);
B:=False;
While (Not B) and (E<=High(TBarcodeEncoding)) do
begin
Str(E,ES);
delete(ES,1,2);
B:=SameText(S,ES);
if B then
FEncoding:=E;
E:=Succ(E);
end;
if not B then
WriteHelp('Invalid barcode encoding: '+S);
if FWidth=0 then
FWidth:=200;
if Fheight=0 then
FHeight:=30;
if FUnit=0 then
FUnit:=1;
if FWeight=0 then
FWeight:=2.0;
end;
var
Application: TCreateBarcodeApplication;
begin
Application:=TCreateBarcodeApplication.Create(nil);
Application.Title:='Create Barcodes';
Application.Run;
Application.Free;
end.