main.pas

自己写的一个关于斑马条码打印机配置源码

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons,printers, jpeg,IniFiles,WinSpool;

type
  TForm1 = class(TForm)
    Panel3: TPanel;
    Label5: TLabel;
    StatusBar1: TStatusBar;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    GroupBox3: TGroupBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Label1: TLabel;
    ComboBox1: TComboBox;
    LabeledEdit7: TLabeledEdit;
    LabeledEdit8: TLabeledEdit;
    Button1: TButton;
    PrintDialog1: TPrintDialog;
    Image2: TImage;
    Image1: TImage;
    lbledit_cur_print: TLabeledEdit;
    BitBtn5: TBitBtn;
    LabeledEdit5: TLabeledEdit;
    GroupBox4: TGroupBox;
    RichEdit1: TRichEdit;
    LabeledEdit6: TLabeledEdit;
    LabeledEdit13: TLabeledEdit;
    LabeledEdit14: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    LabeledEdit4: TLabeledEdit;
    procedure BitBtn4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
function GETFONTHEX(chnstr: string; fontname: string; orient: integer; height: integer; width: integer; bold: integer; italic: integer; hexbuf: string): integer; stdcall; external 'fnthex32.dll';
function PrtChnStr(x, y: integer; fontname: string; height, xmf, ymf: integer; chnstr: string): string;

var
  Form1: TForm1;
  tsc_host,LabelWidth, LabelHeight, Speed, Density, Sensor, Vertical,Offset,bar_x,bar_y,bar_h,bar_c,bar_font:pchar;

procedure openport(PrinterName:pchar);stdcall;far; external 'tsclib.dll';
procedure closeport; external 'tsclib.dll';
procedure sendcommand(Command:pchar);stdcall;far;external 'tsclib.dll';
procedure setup(LabelWidth, LabelHeight, Speed, Density, Sensor, Vertical,Offset:pchar);stdcall; far; external 'tsclib.dll';
procedure downloadpcx(Filename,ImageName:pchar);stdcall;far;external 'tsclib.dll';
procedure barcode(X, Y, CodeType, Height, Readable, Rotation, Narrow,Wide, Code :pchar); stdcall; far; external 'tsclib.dll';
procedure printerfont(X, Y, FontName, Rotation, Xmul, Ymul, Content:pchar);stdcall;far; external 'tsclib.dll';
procedure clearbuffer; external 'tsclib.dll';
procedure printlabel(NumberOfSet, NumberOfCopoy:pchar);stdcall; far;external 'tsclib.dll';
procedure formfeed;external 'tsclib.dll';
procedure nobackfeed; external 'tsclib.dll'
procedure windowsfont (X, Y, FontHeight, Rotation, FontStyle,FontUnderline : integer; FaceName,TextContect:pchar);stdcall;far;external 'tsclib.dll';

implementation

{$R *.dfm}
function PrtChnStr(x, y: integer; fontname: string; height, xmf, ymf: integer; chnstr: string): string;
var
  buf, ret: string;
  count: integer;
begin
  result := '';
  setlength(buf, 21 * 1024);
  count := GETFONTHEX(chnstr, fontname, 0, height, 0, 1, 0, buf);
  if count > 0 then
  begin
    ret := Copy(buf, 1, count);
    result := ret + '^FO' + inttostr(x) + ',' + inttostr(y) + '^XGOUTSTR01,' + inttostr(xmf) + ',' + inttostr(ymf) + '^FS';
  end;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  application.Terminate;
end;

procedure TForm1.Button1Click(Sender: TObject);
var 
pDevice : pChar; 
pDriver : pChar; 
pPort : pChar; 
hDMode : THandle; 
begin
  if PrintDialog1.Execute then
  begin
    GetMem(pDevice,cchDeviceName);
    GetMem(pDriver,MAX_PATH);
    GetMem(pPort,MAX_PATH);
    Printer.GetPrinter(pDevice,pDriver,pPort,hDMode);
    if lStrLen(pDriver) = 0 then
    begin
      GetProfileString('Devices',pDevice,'',pDriver,MAX_PATH);
      pDriver[pos(',',pDriver) - 1] := #0;
    end;
    if lStrLen(pPort) = 0 then
    begin
      GetProfileString('Devices',pDevice,'',pPort,MAX_PATH);
      lStrCpy(pPort,@pPort[lStrLen(pPort) + 2]);
    end;
    //Memo1.Lines.Add('Device := ' + StrPas(pDevice));
    //Memo1.Lines.Add('Driver := ' + StrPas(pDriver));
    //Memo1.Lines.Add('Port := ' + StrPas(pPort));
    lbledit_cur_print.text:=strpas(pdevice);
    FreeMem(pDevice,cchDeviceName);
    FreeMem(pDriver,MAX_PATH);
    FreeMem(pPort,MAX_PATH);
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
   ini:TINIFILE;

begin
  if not fileexists('Fnthex32.dll') then
  begin
    messagebox(0,'无法打印汉字，重新安装打印配置程序。','农垦农产品质量追溯软件Ver2008',mb_ok+MB_ICONERROR);
    exit;
  end;
    if not fileexists('bcpsetup.ini') then
    begin
      messagebox(0,'条码打印配置文件不存在，请使用本程序配置打印参数，并保存打印配置文件！','农垦农产品质量追溯软件Ver2008',mb_ok+MB_ICONERROR);
    end
    else
    begin
      //读取bcpsetup.ini的配置文件信息
      ini:=TIniFile.Create(ExtractFilePath(Paramstr(0))+'bcpsetup.ini');
      tsc_host:=PCHAR(ini.ReadString('CONFIG','HOSTNAME','Zebra  ZM400 200 dpi (ZPL)'));

      lbledit_cur_print.Text:=tsc_host;

      ini.Free;
    end;

end;
procedure WriteRawStringToPrinter(PrinterName:String; S:String);

 var

   Handle: THandle;

   N: DWORD;

   DocInfo1: TDocInfo1;

 begin

   if not OpenPrinter(PChar(PrinterName), Handle, nil) then

     begin

      ShowMessage('error ' + IntToStr(GetLastError));

      Exit;

     end;

   with DocInfo1 do begin

   pDocName := PChar('test doc');

     pOutputFile := nil;

     pDataType := 'RAW';

   end;

   StartDocPrinter(Handle, 1, @DocInfo1);

   StartPagePrinter(Handle);

   WritePrinter(Handle, PChar(S), Length(S), N);

   EndPagePrinter(Handle);

   EndDocPrinter(Handle);

   ClosePrinter(Handle);

 end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
  f:textfile;
begin
  if copy(richedit1.Lines.Text,1,3)<>'^XA' then
  begin
    //showmessage('请先点击左边按钮，生成ZPL机器指令！');
    messagebox(0,'请先点击左边按钮，生成ZPL机器指令！','农垦农产品质量追溯软件Ver2008',mb_ok+MB_ICONERROR);
    exit;
  end;
  //生成ZPL机器指令
  BitBtn5Click(sender);
  //获得当前的配置信息
  tsc_host:=pchar(lbledit_cur_print.Text);

  //开始打印
  WriteRawStringToPrinter(tsc_host, richedit1.Lines.Text);
  richedit1.Lines.SaveToFile('debug.zpl');
  messagebox(0,'打印结束','农垦农产品质量追溯软件Ver2008',mb_ok+MB_ICONINFORMATION);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  ini:tinifile;
begin
  //获得当前的配置信息
  tsc_host:=pchar(lbledit_cur_print.Text);

  ini:=TIniFile.Create(ExtractFilePath(Paramstr(0))+'bcpsetup.ini');
  ini.WriteString('CONFIG','HOSTNAME',tsc_host);
  ini.WriteString('CONFIG','TEXT_X',labelededit6.Text);
  ini.WriteString('CONFIG','TEXT_Y',labelededit13.Text);
  ini.WriteString('CONFIG','BAR_X',labelededit7.Text);
  ini.WriteString('CONFIG','BAR_Y',labelededit8.Text);
  ini.WriteString('CONFIG','TEXT_XOFFSET',labelededit4.Text);
  ini.WriteString('CONFIG','TEXT_YOFFSET',labelededit3.Text);
  ini.WriteString('CONFIG','BAR_HEIGHT',labelededit5.Text);
  ini.WriteString('CONFIG','OFFSET1',labelededit14.Text);


  ini.Free;
  messagebox(0,'配置文件保存成功！','农垦农产品质量追溯软件Ver2008',mb_ok+MB_ICONINFORMATION);
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
  prtstr, code: string;
  text_x,text_y,bar_x,bar_y,text_xoffset,text_yoffset,offset1,bar_height:integer;
begin
  //初始化打印标签的变量
  offset1:=strtoint(labelededit14.Text);//右列标签相对左列标签的偏移,根据标签尺寸，基本不变化
  text_x:=strtoint(labelededit6.Text);//文本左坐标
  text_y:=strtoint(labelededit13.Text);//文本左坐标
  bar_x:=strtoint(labelededit7.Text);//条码左坐标
  bar_y:=strtoint(labelededit8.Text);//条码左坐标
  text_xoffset:=strtoint(labelededit4.Text);//第二列文本左坐标偏移
  text_yoffset:=strtoint(labelededit3.Text);//第二行文本下坐标偏移
  bar_height:=strtoint(labelededit5.Text);//条码高度



  if ComboBox1.Text = 'Code 11' then
    code := '^B1'
  else if ComboBox1.Text = 'Code 39' then
    code := '^B3'
  else if ComboBox1.Text = 'Code 49' then
    code := '^B4'
  else if ComboBox1.Text = 'Code 93' then
    code := '^BA'
  else if ComboBox1.Text = '128码' then
    code := '^BC'
  else if ComboBox1.Text = 'EAN-8' then
    code := '^B8';

  prtstr := '^XA^IA6^XZ^FS^XA^FS^MD10^BY1,3^LH20,23^FS';
  //左边列数据
  prtstr := prtstr + '^FO' + inttostr(bar_x)+','+inttostr(bar_y) +'^AC'+ code + ',' + inttostr(bar_height)+'^FD' + trim(LabeledEdit1.Text) + '^FS';
  prtstr := prtstr + PrtChnStr(text_x, text_y, '宋体', 16, 1, 2, '农户:0101888');
  prtstr := prtstr + PrtChnStr(text_x+text_xoffset, text_y, '宋体', 16, 1, 2, '等级:XXXL');
  prtstr := prtstr + PrtChnStr(text_x, text_y+text_yoffset, '宋体', 16, 1, 2, '质检员:3389');
  prtstr := prtstr + PrtChnStr(text_x+text_xoffset, text_y+text_yoffset, '宋体', 16, 1, 2, '生产日期:08-08-15');


  //右边列数据
  prtstr := prtstr + '^FO' + inttostr(bar_x+offset1)+','+inttostr(bar_y) +'^AC'+ code + ',' + inttostr(bar_height)+'^FD' + trim(LabeledEdit1.Text) + '^FS';
  prtstr := prtstr + PrtChnStr(text_x+offset1, text_y, '宋体', 16, 1, 2, '农户:0101777');
  prtstr := prtstr + PrtChnStr(text_x+text_xoffset+offset1, text_y, '宋体', 16, 1, 2, '等级:XL');
  prtstr := prtstr + PrtChnStr(text_x+offset1, text_y+text_yoffset, '宋体', 16, 1, 2, '质检员:5643');
  prtstr := prtstr + PrtChnStr(text_x+text_xoffset+offset1, text_y+text_yoffset, '宋体', 16, 1, 2, '生产日期:08-08-10');


  prtstr := prtstr + '^PQ1^FS'; //打印1份
  prtstr := prtstr + '^PRC^FS^XZ^FS^XA^EG^XZ'; //打印结束

  richedit1.Lines.Clear;
  richedit1.Lines.Add(prtstr);

end;

end.