条码批量制作打印系统

在图书管理系统中，碰到许多重复条码、没有条码的情形，所以为了自己快速制作打印出二维条码（CODE39），所以编写了这个自定义条码制作打印工具。。。

工程文件

program pCodeMaker;

uses
  Forms,
  uCodeMaker in 'uCodeMaker.pas' {frmCode39},
  BuildCode in 'BuildCode.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmCode39, frmCode39);
  Application.Run;
end.

主单元文件

View Code

unit uCodeMaker;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, frxClass;

type
  TfrmCode39 = class(TForm)
    edtBegin: TEdit;
    btnMake: TButton;
    edtEnd: TEdit;
    UpDown2: TUpDown;
    Label1: TLabel;
    Label2: TLabel;
    btnPrint: TButton;
    Image1: TImage;
    Label3: TLabel;
    Memo1: TMemo;
    procedure btnMakeClick(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCode39: TfrmCode39;
  Imgs: array of TImage;
  //Img: TImage;
implementation

{$R *.dfm}

uses BuildCode, Printers;


procedure TfrmCode39.btnMakeClick(Sender: TObject);
var
  strCode, strHead, strTmp: string;
  xBegin, yBegin, k, j, step, ImgCounts: Integer;
  I, Len, Max: Cardinal;
begin
  Memo1.Hide;
  //初始化

  //Img.Hide;
  CodeEvaluate;//初始化二进制编码
  step := 0;
  xBegin := 10;
  yBegin := 10;
  Max := StrtoIntDef(edtEnd.Text,1);
  ImgCounts := Max div 36;
  if (Max mod 36) > 0 then ImgCounts := ImgCounts + 1;
  SetLength(Imgs, ImgCounts);
  for I := 0 to Length(Imgs)-1 do
  begin
    if not assigned(Imgs[i]) then
      Imgs[i] := TImage.Create(nil);
  end;

  Len := Length(Trim(edtBegin.Text));
  if Len > 9 then
  begin
    strTmp := Copy(Trim(edtBegin.Text),Len-8,9);
    strHead := Copy(Trim(edtBegin.Text),1,Len-9);
  end else
  begin
    strTmp := Trim(edtBegin.Text);
    strHead := '';
  end;
  for I := 0 to Length(Imgs)-1 do
  begin
    Imgs[i].Width := 800;
    Imgs[i].Height := 1200;
  end;

  j := 1;
  for I := 1 to Max do
  begin
    k := (I- 1) div 36;
    strTmp := Inttostr(StrtoInt(strTmp)+step);
    while Length(strTmp) < 9 do
    begin
      strTmp := '0'+strTmp;
    end;
    strCode := Trim(strHead + strTmp);
    if I <= 3 then BuildCodes(strCode, 0, 0,xBegin,yBegin, 60, 2, 1, 12, Image1);
    BuildCodes(strCode, 0, 0,xBegin,yBegin, 60, 2, 1, 12, Imgs[k]);
    step := 1;
    yBegin := yBegin + 90;
    if ((I mod 12)=0) and (I<>0) then
    begin
      xBegin := xBegin + 250;
      yBegin := 10;
      inc(j);
    end;
    //如果超过3 列,则重新产生
    if j>3 then
    begin
      j := 1;
      xBegin := 10;
      yBegin := 10;
    end;

  end;  //for



end;

procedure TfrmCode39.btnPrintClick(Sender: TObject);
var
  r: TRect;
  bit: TBitmap;
  xPrinter, yPrinter, x, y, rX,rY, i: integer;
begin
  bit := TBitmap.Create;
  try
    for I := 0 to Length(Imgs)-1 do
    begin
      Imgs[I].Picture.Graphic.SaveToFile(ExtractFilePath(Application.ExeName)+'tmp.bmp');
      bit.LoadFromFile(ExtractFilePath(Application.ExeName)+'tmp.bmp');

      //计算显示器分辨率与打印机分辨率的比率
      xPrinter := GetDeviceCaps(printer.Handle, LOGPIXELSX);
      yPrinter := GetDeviceCaps(printer.Handle, LOGPIXELSY);
      x := GetDeviceCaps(GetDC(Self.Handle), LOGPIXELSX);
      y := GetDeviceCaps(GetDC(Self.Handle), LOGPIXELSY);
      rX := xPrinter div x;
      rY := yPrinter div y;
      r := Rect(0,0,rX*Bit.Width,rY*Bit.Height);

      // 开始打印
      with Printer do
      begin
        begindoc;
          Canvas.CopyMode := cmSrcCopy;
          Canvas.CopyRect(r,bit.Canvas,Rect(0,0,Bit.Width,Bit.Height));
        enddoc;
      end;
    end;// for i

  finally
    if FileExists(ExtractFilePath(Application.ExeName)+'tmp.bmp') then
      DeleteFile(ExtractFilePath(Application.ExeName)+'tmp.bmp');
    bit.Free;
  end;

end;

procedure TfrmCode39.FormCreate(Sender: TObject);
begin
  //Img := TImage.Create(nil);
end;

procedure TfrmCode39.FormDestroy(Sender: TObject);
var
  i: integer;
begin
 // Img.Free;
  for I := 0 to Length(Imgs)-1 do
  begin
    Imgs[i].Free;
  end;
end;

end.

主单元窗体文件

View Code

object frmCode39: TfrmCode39
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  Caption = #26465#24418#30721#21046#20316#25171#21360
  ClientHeight = 286
  ClientWidth = 440
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 62
    Width = 60
    Height = 13
    Caption = #36215#22987#32534#30721#65306
    Color = clGreen
    ParentColor = False
  end
  object Label2: TLabel
    Left = 8
    Top = 109
    Width = 72
    Height = 13
    Caption = #36830#32493#29983#25104#25968#37327
    Color = clGreen
    ParentColor = False
  end
  object Image1: TImage
    Left = 208
    Top = 8
    Width = 225
    Height = 270
  end
  object Label3: TLabel
    Left = 16
    Top = 16
    Width = 172
    Height = 13
    Caption = #26412#31243#24207#20165#36866#29992#20110#21046#20316'CODE39'#26465#30721
    Color = clMoneyGreen
    ParentColor = False
  end
  object edtBegin: TEdit
    Left = 65
    Top = 59
    Width = 121
    Height = 21
    ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
    NumbersOnly = True
    TabOrder = 0
    Text = '9787000000001'
  end
  object btnMake: TButton
    Left = 8
    Top = 160
    Width = 75
    Height = 25
    Caption = #29983#25104#26465#24418#30721
    TabOrder = 1
    OnClick = btnMakeClick
  end
  object edtEnd: TEdit
    Left = 86
    Top = 106
    Width = 60
    Height = 21
    ImeName = #20013#25991' ('#31616#20307') - '#25628#29399#25340#38899#36755#20837#27861
    NumbersOnly = True
    TabOrder = 2
    Text = '1'
  end
  object UpDown2: TUpDown
    Left = 146
    Top = 106
    Width = 16
    Height = 21
    Associate = edtEnd
    Min = 1
    Position = 1
    TabOrder = 3
  end
  object btnPrint: TButton
    Left = 111
    Top = 160
    Width = 75
    Height = 25
    Caption = #25171#21360
    TabOrder = 4
    OnClick = btnPrintClick
  end
  object Memo1: TMemo
    Left = 208
    Top = 8
    Width = 224
    Height = 265
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clMedGray
    Font.Height = -27
    Font.Name = 'Tahoma'
    Font.Style = []
    ImeName = #20013#25991' ('#31616#20307') - '#19975#33021#20116#31508#20869#32622#36755#20837#27861
    Lines.Strings = (
      ''
      '           '#25928
      '        '
      '           '#26524
      ''
      '           '#22270)
    ParentFont = False
    TabOrder = 5
  end
end

二维码制作单元文件

View Code

{******************************************************************
** 文件名: BuildCode.pas
** 版　本: 1.0
** 创建人: zhjun
** 日　期: 2004.12.29
** 描　述: Code 39 条码输出模块
**-----------------------------------------------------------------
** 修改人: boltwolf
** 日　期:  2012.01.05
** 描　述: 添加了code39码的头识别，否则扫描仪无法识别
**-----------------------------------------------------------------
******************************************************************}
unit BuildCode;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;


  function BuildCodes(CodeStr:string;CodeType:integer;Corner:integer;xPos,yPos: integer;
           CHeight:integer;CWidth:integer;CWidthShort:integer;
           CTextOutSize:integer; var CodeCanvas:Timage):integer;

  procedure CodeEvaluate;
  function  CheckParameter(CodeStr:string;CodeType:integer;Corner:integer;xPos,yPos: integer;
           CHeight:integer;CWidth:integer;CWidthShort:integer;CTextOutSize:integer;
            var CodeCanvas:Timage):boolean;
  function ClearCanvas(var CodeCanvas:Timage):boolean;                                        

  function TypeCode39(CodeStr:string;Corner:integer;xPos,yPos: integer;CHeight,CWidth,CWidthShort:integer;
                   CTextOutSize:integer; var CodeCanvas:Timage):integer;


implementation

var
  CodeValue :array[0..43] of string;
  CodeValueA:array[0..43] of string;
  CodeOrder:string='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. *$/+%';

  place_X1,place_X2,place_Y1,place_Y2:integer;   //条码输出位置
  TextPlace_X,TextPlace_Y:integer;//字符输出位置
  CordWord_Place:integer;    //编码位置编号
  CordWord:string;           //单个字符
  i,j:integer;               //循环参数
  Code,CodeA:string;
  CodeStr:string;


function BuildCodes(CodeStr:string;CodeType:integer;Corner:integer;xPos,yPos: integer;
CHeight,CWidth,CWidthShort:integer;CTextOutSize:integer;var CodeCanvas:Timage):integer;
begin
  if not CheckParameter(CodeStr,CodeType,Corner,xPos,yPos,CHeight,CWidth,CWidthShort,CTextOutSize,CodeCanvas) then
   exit;

 // CodeEvaluate;//初始化二进制编码
 // ClearCanvas(CodeCanvas);  //清除画布
  
  Case CodeType of
  0:  TypeCode39(CodeStr,Corner,xPos,yPos,CHeight,CWidth,CWidthShort,CTextOutSize,CodeCanvas);
  end;

end;

function ClearCanvas(var CodeCanvas:Timage):boolean;
var
ClientRect:TRect;
begin
  ClientRect.Left:=0;
  ClientRect.Top:=0;
  ClientRect.Right:=CodeCanvas.Width;
  ClientRect.Bottom:=CodeCanvas.Height;
  with CodeCanvas.Canvas do
  begin
    Brush.Style:=bssolid;
    Brush.Color:=ClWhite;
    FillRect(ClientRect);
  end;
  result:=true;
end;

//创建
function TypeCode39(CodeStr:string;Corner:integer;xPos,yPos: integer;CHeight,CWidth,CWidthShort:integer;
                   CTextOutSize:integer;var CodeCanvas:Timage):integer;
begin
  place_X1:=xPos;
  place_Y1:=yPos;
  TextPlace_X:=Place_X1+Cwidth;
  TextPlace_Y:=CHeight+yPos;

  Codecanvas.Canvas.Pen.Color:=clblack;
  //画起始码*
  for j := 1 to 5 do
  begin
      //画黑线
    Codecanvas.Canvas.Pen.Mode:=pmBlack;
    Codecanvas.Canvas.Pen.Width := 1;
    Code:=copy(CodeValue[39],j,1);
    CodeA:=copy(CodeValueA[39],j,1);
    if Code='1' then
    begin
      Codecanvas.Canvas.Pen.Color:=clblack;
      Place_X2:=Place_X1+CWidth;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidth;
    end;
    if Code='0' then
    begin
      Codecanvas.Canvas.Pen.Color:=clblack;
      Place_X2:=Place_X1+CWidthShort;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidthShort;
    end;

    //画白线
    Codecanvas.Canvas.Pen.Mode:=pmWhite;
    Codecanvas.Canvas.Pen.Width := 1;
    if CodeA='1' then
    begin
      Codecanvas.Canvas.Pen.Color:=clwhite;
      Place_X2:=Place_X1+CWidth;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidth;
    end;
    if CodeA='0' then
    begin
      Codecanvas.Canvas.Pen.Color:=clwhite;
      Place_X2:=Place_X1+CWidthShort;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidthShort;
    end;
  end;//for j
  //开始循环
  for i := 1 to length(CodeStr) do
  begin
    Place_X1:=Place_X1+CWidthShort;
    //按顺序取单个字符
    CordWord:=copy(CodeStr,i,1);
    //获取字符的位置编号
    CordWord_Place:=Pos(CordWord,CodeOrder)-1;
    //按二进制编码顺序输出条码
    for j:= 1 to 5 do
    begin
      //画黑线
      Codecanvas.Canvas.Pen.Mode:=pmBlack;
      Codecanvas.Canvas.Pen.Width := 1;
      Code:=copy(CodeValue[CordWord_Place],j,1);
      CodeA:=copy(CodeValueA[CordWord_Place],j,1);
      if Code='1' then
      begin
        Codecanvas.Canvas.Pen.Color:=clblack;
        Place_X2:=Place_X1+CWidth;
        Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
        Place_X1:=Place_X1+CWidth;
      end;
      if Code='0' then
      begin
        Codecanvas.Canvas.Pen.Color:=clblack;
        Place_X2:=Place_X1+CWidthShort;
        Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
        Place_X1:=Place_X1+CWidthShort;
      end;

      //画白线
      Codecanvas.Canvas.Pen.Mode:=pmWhite;
      Codecanvas.Canvas.Pen.Width := 1;
      if CodeA='1' then
      begin
        Codecanvas.Canvas.Pen.Color:=clwhite;
        Place_X2:=Place_X1+CWidth;
        Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
        Place_X1:=Place_X1+CWidth;
      end;
      if CodeA='0' then
      begin
        Codecanvas.Canvas.Pen.Color:=clwhite;
        Place_X2:=Place_X1+CWidthShort;
        Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
        Place_X1:=Place_X1+CWidthShort;
      end;
    end; //for j
  end;  //for i

  //画终止*
  Place_X1:=Place_X1+CWidthShort;
  for j := 1 to 5 do
  begin
        //画黑线
    Codecanvas.Canvas.Pen.Mode:=pmBlack;
    Codecanvas.Canvas.Pen.Width := 1;
    Code:=copy(CodeValue[39],j,1);
    CodeA:=copy(CodeValueA[39],j,1);
    if Code='1' then
    begin
      Codecanvas.Canvas.Pen.Color:=clblack;
      Place_X2:=Place_X1+CWidth;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidth;
    end;
    if Code='0' then
    begin
      Codecanvas.Canvas.Pen.Color:=clblack;
      Place_X2:=Place_X1+CWidthShort;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidthShort;
    end;

    //画白线
    Codecanvas.Canvas.Pen.Mode:=pmWhite;
    Codecanvas.Canvas.Pen.Width := 1;
    if CodeA='1' then
    begin
      Codecanvas.Canvas.Pen.Color:=clwhite;
      Place_X2:=Place_X1+CWidth;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidth;
    end;
    if CodeA='0' then
    begin
      Codecanvas.Canvas.Pen.Color:=clwhite;
      Place_X2:=Place_X1+CWidthShort;
      Codecanvas.Canvas.Rectangle(Place_X1,Place_Y1,Place_X2,CHeight+Place_Y1);
      Place_X1:=Place_X1+CWidthShort;
    end;
  end;//for j


  Codecanvas.Canvas.TextWidth('ddddd');
  Codecanvas.Canvas.Font.Name:='宋体';
  Codecanvas.Canvas.Font.Size:=CTextOutSize;
  Codecanvas.Canvas.TextOut(TextPlace_X,TextPlace_Y,Codestr);
end;

function  CheckParameter(CodeStr:string;CodeType:integer;Corner:integer;xPos,yPos: integer;
       CHeight:integer;CWidth:integer;CWidthShort:integer; CTextOutSize:integer;
       var CodeCanvas:Timage):boolean;
begin
  result:=True;
  if COdeType<0 then
  begin
    Application.MessageBox('缺少参数！'+#13+'请求传递条码类型！', '系统提示',mb_OK or MB_ICONINFORMATION);
    result:=False;
    Exit;
  end;

  if CodeStr='' then
  begin
    Application.MessageBox('缺少参数！'+#13+'请求传递条码字符！', '系统提示',mb_OK or MB_ICONINFORMATION);
    result:=False;
    Exit;
  end;

  if Corner<0 then
    Corner:=0;
  if xPos<0 then
    xPos := 20;
  if yPos < 0 then
    yPos := 20;
  if CHeight<0 then
    CHeight:=100;
  if CWidth<0 then
    CWidth:=6;
  if CWidthShort<0 then
    CWidthShort:=2;
  if CTextOutSize<0 then
    CTextOutSize:=9;

end;

procedure CodeEvaluate;
begin
  CodeValue[0] :='00110';        // 0
  CodeValue[1] :='10001';        // 1
  CodeValue[2] :='01001';        // 2
  CodeValue[3] :='11000';        // 3
  CodeValue[4] :='00101';        // 4
  CodeValue[5] :='10100';        // 5
  CodeValue[6] :='01100';        // 6
  CodeValue[7] :='00011';        // 7
  CodeValue[8] :='10010';        // 8
  CodeValue[9] :='01010';        // 9
  CodeValue[10]:='10001';        // A
  CodeValue[11]:='01001';        // B
  CodeValue[12]:='11000';        // C
  CodeValue[13]:='00101';        // D
  CodeValue[14]:='10100';        // E
  CodeValue[15]:='01100';        // F
  CodeValue[16]:='00011';        // G
  CodeValue[17]:='10010';        // H
  CodeValue[18]:='01010';        // I
  CodeValue[19]:='00110';        // J
  CodeValue[20]:='10001';        // K
  CodeValue[21]:='01001';        // L
  CodeValue[22]:='11000';        // M
  CodeValue[23]:='00101';        // N
  CodeValue[24]:='10100';        // O
  CodeValue[25]:='01100';        // P
  CodeValue[26]:='00011';        // Q
  CodeValue[27]:='10010';        // R
  CodeValue[28]:='01010';        // S
  CodeValue[29]:='00110';        // T
  CodeValue[30]:='10001';        // U
  CodeValue[31]:='01001';        // V
  CodeValue[32]:='11000';        // W
  CodeValue[33]:='00101';        // X
  CodeValue[34]:='10100';        // Y
  CodeValue[35]:='01100';        // Z
  CodeValue[36]:='00011';        // -
  CodeValue[37]:='10010';        // .
  CodeValue[38]:='01010';        // 空格
  CodeValue[39]:='00110';        // *
  CodeValue[40]:='00000';        // $
  CodeValue[41]:='00000';        // /
  CodeValue[42]:='00000';        // +
  CodeValue[43]:='00000';        // %

  CodeValueA[0] :='0100';        // 0
  CodeValueA[1] :='0100';        // 1
  CodeValueA[2] :='0100';        // 2
  CodeValueA[3] :='0100';        // 3
  CodeValueA[4] :='0100';        // 4
  CodeValueA[5] :='0100';        // 5
  CodeValueA[6] :='0100';        // 6
  CodeValueA[7] :='0100';        // 7
  CodeValueA[8] :='0100';        // 8
  CodeValueA[9] :='0100';        // 9
  CodeValueA[10]:='0010';        // A
  CodeValueA[11]:='0010';        // B
  CodeValueA[12]:='0010';        // C
  CodeValueA[13]:='0010';        // D
  CodeValueA[14]:='0010';        // E
  CodeValueA[15]:='0010';        // F
  CodeValueA[16]:='0010';        // G
  CodeValueA[17]:='0010';        // H
  CodeValueA[18]:='0010';        // I
  CodeValueA[19]:='0010';        // J
  CodeValueA[20]:='0001';        // K
  CodeValueA[21]:='0001';        // L
  CodeValueA[22]:='0001';        // M
  CodeValueA[23]:='0001';        // N
  CodeValueA[24]:='0001';        // O
  CodeValueA[25]:='0001';        // P
  CodeValueA[26]:='0001';        // Q
  CodeValueA[27]:='0001';        // R
  CodeValueA[28]:='0001';        // S
  CodeValueA[29]:='0001';        // T
  CodeValueA[30]:='1000';        // U
  CodeValueA[31]:='1000';        // V
  CodeValueA[32]:='1000';        // W
  CodeValueA[33]:='1000';        // X
  CodeValueA[34]:='1000';        // Y
  CodeValueA[35]:='1000';        // Z
  CodeValueA[36]:='1000';        // -
  CodeValueA[37]:='1000';        // .
  CodeValueA[38]:='1000';        // 空格
  CodeValueA[39]:='1000';        // *
  CodeValueA[40]:='1110';        // $
  CodeValueA[41]:='1101';        // /
  CodeValueA[42]:='1011';        // +
  CodeValueA[43]:='0111';        // %
end;


end.

posted @ 2012-06-09 14:08 客栈老人阅读(647) 评论(0) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部

客栈老人

>>>>谦虚务实求知热心慷慨助人<<<<

条码批量制作打印系统

公告

客栈老人

>>>>谦虚务实求知 热心慷慨助人<<<<

条码批量制作打印系统

公告

>>>>谦虚务实求知热心慷慨助人<<<<