在图书管理系统中，碰到许多重复条码、没有条码的情形，所以为了自己快速制作打印出二维条码（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.