新手问题

Question

各位DELPHI的高手
    我刚刚接触DELPHI ,用DELPHI 编了一个DLL库,为VB调用.
    在本人开发的电脑上调用正常,但到的别的电脑就出现程序挂了.
    在DLL文件中我用到了Tbitmap 对象, 并且在DLL中有向打印机"lpt1"口输出指令打印.    请高手帮帮忙看一下.帮我解决

Answer 1

是不是选中了Build with runtime packages，那样的话，需要将用到的bpl文件拷贝到目标机器上。

Answer 2

我没有选取中这个选取项哦，这个要用那个BPL文件

Answer 3

难道求助真的这么难呀，还是自已想办法解决吧，delphi 方面为什么访问的人这么少

Answer 4

这个时候你最好把出现的错误信息描述一下，这样别人才能够帮助你呀。简单的一句我的程序在别的电脑上挂了，即使是牛如borland自己的开发人员也没法帮你啊

Answer 5

NightCloud:
   在VB中调用的时候,主要是指在目标机的时候,程序无响应呀,没有任何错误提示.
当然,在开发的电脑上运行调用都正常.
  我在想是不是需要什么DELPHI的哪些环境文件支持呀

Answer 6

你在别的机器注册一下这个dll看看

Answer 7

真的不能注册，
提示：TEC.DLL WAS LOADED,but the dllregisterserver entry point was not found.
为何，各位大哥，有没有样本工程呀，
我也是没有办法，用这个DELPHI 实现这个功能。
以下是我的代码:
主工程中的：
uses
   windows,
   Unit1 in 'Unit1.pas';{$R *.res}
procedure DLLEntryPoint(dwReason:DWord);
 begin
   case dwReason of
      DLL_PROCESS_ATTACH: MESSAGEBEEP(0);
      DLL_PROCESS_DETACH: MESSAGEBEEP(0);
      DLL_THREAD_ATTACH: MESSAGEBEEP(0);
      DLL_THREAD_DETACH:MESSAGEBEEP(0);
   END;
 end;
 exports
  //  Getgrpdata name 'getgd' ,
    printlabel name 'printlab';
begin
     Dllproc:=@DLLEntryPoint;
     DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Answer 8

这是单元中的代码，unit Unit1;interface
  uses
  SysUtils,
  windows,
  Graphics;  function Getgrpdata(x :word; y :word; data :string; fontname :string; size :word):string  ;
  function fixstr(x:integer; len :integer):string;
  //procedure Tshow(s:string); stdCall ;
  function PrintLabel(Ptype:string;Pnd:string;Pweight:string; Pbtu:string;PHz:string;Pupc:string;Printsts:integer;Pfeedsts:integer;Pnum:integer):integer;stdcall;
  function  barprint39(x:integer ; y:integer ;data:string;sts:integer):string;
  function  barprintUpc(x:integer ; y:integer ;data:string):string;
  // function  UpcCt(data:string):string;
implementationfunction  barprintUpc(x:integer ; y:integer ;data:string):string;
 var
  strcmm: string;
  //f:textfile;
 begin
 strcmm :='XB02;'+ fixstr(x,4)+','+fixstr(y,4)+',';
 strcmm:=strcmm + 'K,' ;  //K ：表示为UPC码
 strcmm:=strcmm+'3,' ;         //自动校验位 无
 strcmm:=strcmm+'06,';   // moudle width
 strcmm:=strcmm+'0,';  //平行打印
 strcmm :=strcmm+'0179,';       //  条形码高度
 strcmm:=strcmm+'+0000000000,020,1,00';
  strcmm:=strcmm+'='+data ;
  result:='{'+strcmm+'|}' ;
end;
 function PrintLabel(Ptype:string;Pnd:string;Pweight:string; Pbtu:string;PHz:string;Pupc:string;Printsts:integer;Pfeedsts:integer;Pnum:integer):integer;export;
  var
   str:string;
   f1:textfile;
  begin
  try
   begin
    assignfile(f1,'lpt1');
    rewrite(f1);
    str:='{AY;+01,0|}'    ;
    str:=str +'{D1231,0999,1199|}' ;
    str:= str+  '{C|}'    ;
    str:=str+'{XR;0000,0000,0999,1199,A|}'    ;
    str:=str+ '{AX;-000,-000,+00|}'  ;
    write(f1,str);
    str:=Getgrpdata(8,35,'MODEL No.','Arial',30);
    write(f1,str);
    str:=Getgrpdata(87,72,ptype, 'Arial',100);
    write(f1,str);
    //划线
    str:=str+'{XR;0000,0415,0962,0418,A|}' ;
   str:=str+'{XR;0000,0415,0962,0418,B|}'    ;
   str:=str+'{XR;0000,0715,0962,0718,A|}' ;
   str:=str+'{XR;0000,0715,0962,0718,B|}';
   str:=str+'{XR;0000,1015,0962,1018,A|}';
   str:=str+'{XR;0000,1015,0962,1018,B|}}'  ;
   str:=str+'{XR;0636,0715,0639,1018,A|}';
   str:=str+'{XR;0636,0715,0639,1018,B|}';
    write(f1,str);
//   ------------------
   str:=Getgrpdata(8,445,'SERIAL No.', 'Arial',30);
   write(f1,str);
    str:=barprint39(95,222,ptype,1)  ;
    write(f1,str);   str:=barprint39(149,491,pnd,2)  ;
   write(f1,str);
   str:=Getgrpdata(470,651,pnd,'Arial',30)  ;
   write(f1,str);
   if Printsts=1 then  //不打印UPC码
    begin
       str:=Getgrpdata(8,734,'UPC CODE', 'Arial',30);
       write(f1,str);
       str:=barprintUpc(95,788,Pupc);
       write(f1,str);
     end;
    str:=Getgrpdata(679,737,'WEIGHT', 'Arial',30);
    write(f1,str);    str:=Getgrpdata(741,845,Pweight, 'Arial',80);
    write(f1,str);     str:=Getgrpdata(844,897,'lbs', 'Arial',50);
     write(f1,str);     str:=Getgrpdata(43,1046,PBtu, 'Arial',100);
     write(f1,str);
     str:=Getgrpdata(680,1090,phz, 'Arial',60);
     write(f1,str);
     str:= '{XS;I,0001,0000C5100|}'  ;
     write(f1,str) ;
     closefile(f1);
     result:=pnum;
    end  ;
  except
    on e:EinOutError  do
      begin
     //  messagedlg('错误' +e.Message ,mtwarning,[mbok],0);
       result:=1001;
      end;
    else
       //  messagedlg('错误',mtwarning,[mbok],0);
        result:=1000;
 end;
end ; 
 function  barprint39(x:integer ; y:integer ;data:string;sts:integer):string;
 var
  strcmm: string;
 begin
 strcmm :='XB01;'+ fixstr(x,4)+','+fixstr(y,4)+',';
 strcmm:=strcmm   +'3,';       //设置条形码类型      code39 在TEC中为3
 strcmm :=strcmm+ '1,';                //设置校验位  1:表示无校验
 if sts=1 then   //表示打印第一个39码
    strcmm:=strcmm+'07,07,14,14,07,0,0170,+0000000000,0,00'
 else if sts=2 then
   strcmm:=strcmm+'06,06,12,12,06,0,0160,+0000000000,0,00'    ;
   strcmm:=strcmm+'='+data ;
   result:='{'+strcmm+'|}';
 end;function Getgrpdata(x :word; y :word; data :string; fontname :string;size :word):string;
var
    Bytelength,i,width,height :integer;
    S:string;
//    ch :char;
    hex :byte;
    P : PByteArray;       //保存ScanLine的数组
    text1 :string;
    HZ :Tbitmap;
    f:textfile;
begin    text1 := data;
    HZ := Tbitmap.create;
    HZ.Canvas.Font.name := fontname ;
    hz.Canvas.Font.Size :=size;
    HZ.Height := HZ.Canvas.TextHeight(Text1);
    HZ.width := HZ.Canvas.Textwidth(Text1);
    HZ.PixelFormat := pf8bit;
    HZ.Canvas.TextOut(0,0,text1);
 //   hz.SaveToFile('e:\1.bmp');
    width := HZ.width ;
    height := HZ.Height ;
    s:=' ';
    S := 'SG;'+ fixstr(x,4) +','+fixstr(y,4) +','+ fixstr(width,4)+','+ fixstr(height,4)+',1,';
    dec(height);
  for y := 0 to height do
    begin
        P := HZ.ScanLine[y];
        Hex := 0;
        for x := 0 to width -1 do
        begin
            if P[x] = 0 then hex := hex shl 1 +1
            else hex := hex shl 1;
            if x mod 8 = 7 then
            begin
                S := S  + chr(hex) ;
                hex := 0;
            end;
        end;
        ByteLength := (width -1) mod 8;
        if Bytelength <> 7 then
        begin
            for i := 1 to 8 - Bytelength do
                  hex  := hex shl 1 ;
            S := S  +chr(hex) ;
        end;
    end;
    HZ.Free ;
    result:='{'+s+'|}';
 end;
function fixstr(x:integer; len :integer):string;
var
    tmp:string;
    i :integer;
begin
    tmp := pchar(trim(inttostr(x)));
    for i := 1 to len do
        tmp := '0'+tmp;
    Result := copy(tmp,length(tmp)-len+1,len);
end ;end.

Answer 9

在这里关键是用到的TBITMAP 对象,其它的应该没有什么,就是一个直接向打印机输出指令.
 在VB中就是一个传递参数.然后由这个DLL文件负责在条形码打印机上打印出来.
 整个程序的功能就是,调用程序传递打印内容到这个DLL库,然后DLL根据参数,向打印机输入特别的指令,打印出指定的内容. 图形功能: Getgrpdata  主要是将图像转换成打印机可以识别的符号
 其它的几个函数只是生成指令串,然后由LABELPRINT 函数统一发送到LPT1口.
 
 存在的问题:1  不能注册,新手:不知道为什么 
            2: 在目标机导致调用程序无响应,

Answer 10

是不是另外一台机器上的打印机不是安装在lpt1上？我看了我的打印机设置，没有用lpt1

Answer 11

还有，如果你怀疑是tbitmap搞得鬼，你可以写个小程序测试一下。分步把问题可能发生的原因范围一点一点缩小

Answer 12

经过测试，情况如下：请各位高手帮助
1：在2000 系统下，基本正常，但曾经出现过错误：“File access denied” 是在错误捕捉主语句。
2：在98下能调用DLL，但当运行  write(f1,str);
   语句时，程序就会挂起,无响应， 无法向“LPT1口“输出指令 并且捕捉不到错误。
   在98与2000的打印机驱动一样。
为什么??