unit loteunit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,
DB, dbisamtb, StdCtrls, shellapi,Mask, strutils,DBCtrls, Grids, DBGrids, dbisamct,suchunit,tnpdf;
type
Tlote =
class(TForm)
Label1: TLabel;
Label10: TLabel;
DBISAMDBGrid1: TDBISAMDBGrid;
DBISAMQuery1: TDBISAMQuery;
DataSource1: TDataSource;
order: TDBEdit;
Artikel: TDBEdit;
PrintPDF1: TPrintPDF;
Button1: TButton;
procedure deletetmppdf();
procedure pdfCodeDrucken(x,y:integer;code:
string;textdrucken:boolean);
function startcode(pos,x,y:integer):integer;
procedure Balken(pos,a,x,y:integer);
procedure endcode(pos,x,y:integer);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
lote: Tlote;
abstand:integer=1;
suchform:Tsuchform;
pdf:TPrintPDF;
Feld :
array[0..9,0..4]
of integer=((0,0,1,1,0),(1,0,0,0,1),(0,1,0,0,1),(1,1,0,0,0),(0,0,1,0,1),(1,0,1,0,0),(0,1,1,0,0),(0,0,0,1,1),(1,0,0,1,0),(0,1,0,1,0));
implementation
{$R *.dfm}
function GetTempPathD:
string;
var
TmpDir: PChar;
begin
TmpDir := StrAlloc(255);
GetTempPath( 255,TmpDir);
Result :=
string(TmpDir);
if Result[Length(Result)] <> '
\'
then
Result := Result + '
\';
StrDispose(TmpDir);
end;
procedure Tlote.deletetmppdf();
var
SR: TSearchRec;
begin
if FindFirst(gettemppathd+'
tmp*.pdf', faAnyFile - faDirectory, SR) = 0
then
repeat
deletefile(gettemppathd+sr.
name);
until FindNext(SR) <> 0;
end;
procedure Tlote.Balken(pos,a,x,y:integer);
begin
printpdf1.LineWidth:=2*a+1;
printpdf1.DrawLine(x+a+pos*abstand,y,x+a+pos*abstand,y+20);
end;
procedure Tlote.endcode(pos,x,y:integer);
begin
Balken(pos,1,x,y);
pos:=pos+5;
Balken(pos,0,x,y);
pos:=pos+3;
Balken(pos,1,x,y);
end;
function Tlote.startcode(pos,x,y:integer):integer;
begin
pos:=pos+3;
Balken(pos,1,x,y);
pos:=pos+5;
Balken(pos,1,x,y);
pos:=pos+5;
Balken(pos,0,x,y);
pos:=pos+3;
startCode:=pos;
end;
procedure Tlote.pdfCodeDrucken(x,y:integer;code:
string;textdrucken:boolean);
var pos,i,b,n:integer;
begin
pos:=10;
pos:=startCode(pos,x,y);
for i:=1
to length(code)
do
begin
n:=StrToInt(MidStr(code,i,1));
for b:=0
to 4
do
begin
Balken(pos,Feld[n,b],x,y);
pos:=pos+3+(2*Feld[n,b]);
end;
end;
endCode(pos,x,y);
code:=midstr(code,1,7)+midstr(code,8,2);
if textdrucken
then printpdf1.TextOut(x+10,y+35,code);
end;
procedure Tlote.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
procedure Tlote.Button1Click(Sender: TObject);
begin
deletetmppdf;
printpdf1.FileName:=gettemppathd+'
tmppdf'+Inttostr(random(5000))+'
.pdf';
printpdf1.PageWidth:=1224;
printpdf1.PageHeight:=1725;
printpdf1.BeginDoc;
printpdf1.Font.
Name:=poTimesBoldItalic;
printpdf1.Font.Size:=60;
printpdf1.TextOut(450,60,'
Artigo: '+Artikel.text);
printpdf1.TextOut(800,60,'
N.P.: '+order.text);
pdfcodedrucken( 1050,40,order.Text,false);
printpdf1.LineWidth:=3;
printpdf1.DrawLine(0,220,1224,220);
printpdf1.EndDoc;
ShellExecute(Application.Handle,
'
open',
PChar(printpdf1.FileName),
Nil,
Nil, SW_NORMAL);
end;
end.