unit barra; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, AxCtrls, OleCtrls, ExtCtrls, ClipBrd, Printers, DbOleCtl, AXBARCODELib_TLB, Buttons, DBCtrls, Db, DBTables, checa, Spin; type TForm1 = class(TForm) Label1: TLabel; Source: TEdit; Label2: TLabel; CodeType: TComboBox; Label3: TLabel; dHeight: TEdit; dWidth: TEdit; Button1: TButton; Button2: TButton; Label4: TLabel; Widlabel: TLabel; Button3: TButton; Image1: TImage; Button4: TButton; Units: TLabel; RadioButton1: TRadioButton; RadioButton2: TRadioButton; Button5: TButton; Button6: TButton; FontDialog1: TFontDialog; Button7: TButton; SaveDialog1: TSaveDialog; Axbarcode1: TAxbarcode; EditClave: TEdit; TablaInventario: TTable; DataSource1: TDataSource; DBNavigator1: TDBNavigator; DBText1: TDBText; BitBtn1: TBitBtn; ImagenBarra: TImage; Label5: TLabel; Label6: TLabel; Colu: TSpinEdit; Reng: TSpinEdit; Label7: TLabel; Label8: TLabel; Num_Eti: TSpinEdit; BitBtn2: TBitBtn; Impresora: TPrintDialog; procedure FormCreate(Sender: TObject); procedure DoBarcode(); procedure SourceChange(Sender: TObject); procedure CodeTypeChange(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure dWidthChange(Sender: TObject); procedure dHeightChange(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure RadioButton1Click(Sender: TObject); procedure RadioButton2Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Button7Click(Sender: TObject); procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn); procedure BitBtn1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure EditClaveChange(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; pScalex: Integer; pScaley: integer; iScalex: Integer; iScaley: integer; font1: TFont; SRect: TRect; pic: TPicture; implementation {$R *.DFM} procedure dibujabitmap(x,y,x2,y2,nombre,describe:String); var mapa,mapa2: TPicture; rectangulo,rec2:TRect; a,b,c,d:integer; // foto:Timage; begin if (x<>'') and(y<>'')and FileExists(nombre) then begin {MuestraMensaje('imprime el bitam '+nombre);} mapa := TPicture.Create; // mapa2 := TPicture.Create; mapa.Bitmap.LoadFromFile(nombre); //Form1.ImagenBarra.Picture.LoadFromFile(nombre); a:=Trunc(StrToFloat(x)); b:=Trunc(StrToFloat(y)); c:=Trunc(StrToFloat(x2)); d:=Trunc(StrToFloat(y2)); rectangulo.Left:=a; rectangulo.Top:=b; rectangulo.Right:=c; rectangulo.Bottom:=d; rec2.Left:=0; rec2.Top:=0; rec2.Right:=mapa.Bitmap.Width; rec2.Bottom:=Trunc(mapa.Bitmap.Height/4); { with Form1.ImagenBarra.Canvas do CopyRect (Rect (0, 0, mapa.Bitmap.Width, Trunc(mapa.Bitmap.Height/4)), mapa.Bitmap.Canvas, Rect (0, 0, mapa.Bitmap.Width, Trunc(mapa.Bitmap.Height/4))); } // mapa2.Bitmap.Canvas.CopyRect(rec2,mapa.Bitmap.Canvas,rec2); Printer.Canvas.StretchDraw(rectangulo,mapa.Graphic); Printer.Canvas.TextOut(rectangulo.Left+10,rectangulo.Bottom-(Printer.Canvas.Font.Size)+5,describe); mapa.Bitmap.FreeImage; mapa.Free; // mapa2.Bitmap.FreeImage; // mapa2.Free; end end; procedure TForm1.FormCreate(Sender: TObject); var ii: integer; jj: integer; Stemp: string; arch:TextFile; dire,linea:string; begin GetDir(0,dire); if fileExists(dire+'\barras.cnf') then begin AssignFile(arch,dire+'\barras.cnf'); Reset(arch); readln(arch,linea); Colu.Text:=linea; readln(arch,linea); Reng.Text:=linea; CloseFile(arch); end; TablaInventario.DatabaseName:=ruta(8); TablaInventario.Open; Source.Text:=TablaInventario.FieldByName('clpro_i').AsString; ImagenBarra.Picture:=Axbarcode1.Picture; //********* ii:=GetDeviceCaps((Printer.Handle),LOGPIXELSX); pScalex:=(1000*ii) div 254; {100 * pixels per mm} ii:=GetDeviceCaps((Printer.Handle),LOGPIXELSX); pScaley:=(1000*ii) div 254; {100 * pixels per mm} ii:=Screen.PixelsPerInch; iScalex:=(1000*ii) div 254; {100 * pixels per mm} iScaley:=iScalex; {100 * pixels per mm} SRect.Left:=0; SRect.Top:=0; Stemp:=Axbarcode1.GetTypeNameB(0); ii:=0; repeat begin CodeType.Items.Add(Stemp); ii:=ii+1; Stemp:=Axbarcode1.GetTypeNameB(ii); jj:=Length(Stemp); end; until (jj<2); CodeType.ItemIndex:=8; end; procedure TForm1.DoBarcode(); var ii: integer; jj: integer; Stemp: string; ft: single; begin {redraw the barcode image} pic.Free; pic:=TPicture.Create; Image1.Picture:=NIL; Val(dHeight.Text,ii,jj); if (jj=0) then Axbarcode1.ImageHeight:=ii; Val(dWidth.Text,ii,jj); if (jj=0) then begin if (RadioButton2.Checked) then begin if (ii>8) then begin Axbarcode1.Xunit:=ii; Axbarcode1.ImageWidth:=ii; end; end else begin Axbarcode1.Xunit:=0 ; Axbarcode1.ImageWidth:=ii; end ; end; Axbarcode1.CodeType:=CodeType.ItemIndex; Stemp:=Source.Text; if (Length(Stemp)>0) then begin Axbarcode1.Caption:=Stemp; pic:=Axbarcode1.Picture; if (Axbarcode1.ErrorCode=0)then begin ft:=Axbarcode1.ImageWidth; ii:=Trunc((ft*iScalex)/ 100.0); ft:=Axbarcode1.ImageHeight; jj:=Trunc((ft*iScaley) /100.0); SRect.Right:=SRect.Left+ii; SRect.Bottom:=SRect.Top+jj; Image1.Canvas.StretchDraw(SRect,pic.Graphic); end ; Form1.Invalidate; end; end; procedure TForm1.SourceChange(Sender: TObject); begin try //DoBarcode(); {redraw the barcode image} except end; end; procedure TForm1.CodeTypeChange(Sender: TObject); begin DoBarcode(); {redraw the barcode image} end; procedure TForm1.Button1Click(Sender: TObject); begin DoBarcode(); {redraw the barcode image} {copy metafile to clipboard } Axbarcode1.CopyImage(); end; procedure TForm1.Button2Click(Sender: TObject); begin //DoBarcode(); {redraw the barcode image} {copy bitmap to clipboard } Axbarcode1.CopyBitmap(); end; procedure TForm1.dWidthChange(Sender: TObject); begin DoBarcode(); {redraw the barcode image} end; procedure TForm1.dHeightChange(Sender: TObject); begin DoBarcode(); {redraw the barcode image} end; procedure TForm1.Button3Click(Sender: TObject); begin Print ; {Print the whole form} end; procedure TForm1.Button4Click(Sender: TObject); var ii: integer; jj: integer; Rect: TRect; pic2: TPicture; ft: single; begin DoBarcode(); {recreate the barcode image} pic2:=Axbarcode1.Picture; {set the target rectangle for drawing on the printer} {change from mm to pixels} ft:=Axbarcode1.ImageWidth; ii:=Trunc((ft*pScalex)/ 100.0); ft:=Axbarcode1.ImageHeight; jj:=Trunc((ft*pScaley) /100.0); Rect.Left:=200; Rect.Top:=200; Rect.Right:=Rect.Left+ii; Rect.Bottom:=Rect.Top+jj; Printer.BeginDoc; Printer.Canvas.StretchDraw(Rect,pic2.Graphic); Printer.EndDoc; DoBarcode(); {redraw the barcode image on form} end; procedure TForm1.RadioButton1Click(Sender: TObject); begin {use image width specification instead of X unit size} Widlabel.Caption:='Width'; Units.Caption:='mm.'; DoBarcode(); {redraw the barcode image on form} end; procedure TForm1.RadioButton2Click(Sender: TObject); begin {use X unit size specification instead of width} Widlabel.Caption:='X unit size'; Units.Caption:='mils'; DoBarcode(); {redraw the barcode image on form} end; procedure TForm1.Button5Click(Sender: TObject); begin {set Change font dialog} font1.Free; font1:=TFont.Create; font1.Size:=Axbarcode1.FontSize; font1.Name:=Axbarcode1.FontName; font1.Style:=[]; if ( Axbarcode1.FontBold) then font1.Style:=font1.Style + [fsBold]; if ( Axbarcode1.FontItalic) then font1.Style:=font1.Style + [fsItalic]; FontDialog1.Font.Assign(font1); {display dialog} if (FontDialog1.Execute) then begin {reset font properties if OK pressed} font1.Assign(FontDialog1.Font); Axbarcode1.FontName:=font1.Name; Axbarcode1.FontSize:=font1.Size; if (fsBold in font1.Style) then Axbarcode1.FontBold:=true else Axbarcode1.FontBold:=false; if (fsItalic in font1.Style) then Axbarcode1.FontItalic:=true else Axbarcode1.FontItalic:=false end ; DoBarcode(); {redraw the barcode image} end; procedure TForm1.Button6Click(Sender: TObject); {Save image dialog} var ps: PChar; begin SaveDialog1.Options := [ofOverwritePrompt]; SaveDialog1.Filter := ' Metafiles (*.wmf)|*.wmf|Bitmap files (*.bmp)|*.bmp|Paintbrush (*.pcx)|*.pcx|All files (*.*)|*.*'; SaveDialog1.FilterIndex := 1; { start the dialog showing wmf files } SaveDialog1.DefaultExt:='wmf'; if SaveDialog1.Execute then begin {let the component save the image if Save pressed} ps:=PChar(SaveDialog1.FileName); Axbarcode1.SaveImage(ps); end; end; procedure TForm1.Button7Click(Sender: TObject); begin {close the application} Application.Terminate; end; procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn); begin Source.Text:=TablaInventario.FieldByName('clpro_i').AsString; Axbarcode1.Caption :=Source.Text; ImagenBarra.Picture:=NIL; ImagenBarra.Picture:=Axbarcode1.Picture; end; procedure TForm1.BitBtn1Click(Sender: TObject); var dire:string; BitMap :TBitMap; ps: PChar; i,j:integer; facx,facy,sepa:integer; cuenta:integer; begin // BitMap := TBitMap.create; GetDir(0,dire); ps:=PChar(dire+'\barra.bmp'); Axbarcode1.SaveImage(ps); cuenta:=0; //BitMap.LoadFromFile(ps); //ImagenBarra.Picture.Bitmap:=BitMap; //BitMap.Free; //ImagenBarra.Canvas.CopyRect(Rect(0,0,100,10),BitMap.Canvas,Rect(0,0,100,10)); //BitMap.Free; Printer.BeginDoc; facx:=Trunc(Printer.PageWidth/colu.Value); facy:=Trunc(Printer.PageHeight/Reng.Value); sepa:=Trunc(Printer.PageWidth/50); for i:=0 to colu.Value-1 do for j:=0 to Reng.Value-1 do begin dibujabitmap(IntToStr((i*facx)+sepa),IntToStr((j*facy)+sepa), IntToStr(((i+1)*facx)-sepa),IntToStr(((j+1)*facy)-sepa),ps,TablaInventario.FieldByName('dscpr_i').AsString); cuenta:=cuenta+1; if cuenta>= Num_Eti.Value then begin Printer.EndDoc; exit; end; end; Printer.EndDoc; //ImagenBarra.Picture.SaveToFile(dire+'\barra.bmp'); //ImagenBarra.Picture.Bitmap.SaveToFile(dire+'\barra2.bmp'); //Axbarcode1.CopyBitmap(); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var arch:TextFile; dire,linea:string; begin GetDir(0,dire); AssignFile(arch,dire+'\barras.cnf'); ReWrite(arch); Writeln(arch,Colu.Text); Writeln(arch,Reng.Text); CloseFile(arch); end; procedure TForm1.EditClaveChange(Sender: TObject); begin try TablaInventario.FindNearest([EditClave.Text]); Source.Text:=TablaInventario.FieldByName('clpro_i').AsString; Axbarcode1.Caption :=Source.Text; except ShowMessage('Valor no Válido...'); end; end; procedure TForm1.BitBtn2Click(Sender: TObject); begin if Impresora.Execute then begin end; end; procedure TForm1.FormShow(Sender: TObject); var arch:TextFile; dire:string; begin DoBarcode(); {redraw the barcode image} GetDir(0,dire); if FileExists(dire+'\barra.dat') then begin Assignfile(arch,dire+'\barra.dat'); Reset(arch); Readln(arch,dire); try EditClave.Text:=dire; TablaInventario.FindNearest([dire]); Source.Text:=TablaInventario.FieldByName('clpro_i').AsString; Axbarcode1.Caption :=Source.Text; except ShowMessage('Valor no Válido...'); end; CloseFile(arch); end;//fielexists end; end.