ASP控制打印的问题(100分)

能给个这样的Com组件或ActiveX的源码吗，Delphi的，谢谢

由于组件是公司产品的组成部分，有版权的，所以不能给出完成的组件，就把主要实现
代码贴出来。可以自己新建一个ActiveX，然后把这些代码加进去就可以了。
unit IEprtUnit;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, IEprinter_TLB, StdVcl,Windows,IniFiles;
type
TWebprinter = class(TAutoObject, IWebprinter)
protected
//输出属性isinit,0代表初始化成功，1表示失败
function Get_isinit: Integer;
safecall;
//设置属性isinit
procedure Set_isinit(Value: Integer);
safecall;
procedure prtstart(pagewidth, pageheight, pagerorientation,
copys: OleVariant);
safecall;
//用来使打印机换页。
procedure prtnewpage;
safecall;
//结束打印任务
procedure prtend;
safecall;
//用来在页面上绘制一条线。(x1,y1)为起始点.(x2,y2)为终止点
procedure prtdrawline(x1, y1, x2, y2: OleVariant);
safecall;
procedure prtsetfont(fontname, fontsize, fontstyle: OleVariant);
safecall;
procedure prttextout(X, Y, printstring, Charspline: OleVariant);
safecall;
procedure prtRectout(x1, y1, x2, y2, Style: OleVariant);
safecall;
//输出属性Errmag，其中包含了错误信息
function Get_Errmsg: OleVariant;
safecall;
//设定Errmsg
procedure Set_Errmsg(Value: OleVariant);
safecall;
procedure ReadCfg(out Move_X, Move_Y: OleVariant);
safecall;
procedure WriteCfg(Move_X, Move_Y: OleVariant);
safecall;
{ Protected declarations }
end;

implementation
uses ComServ,Printers, Graphics,SysUtils;
//初始化打印机，设定纸张大小
function initprintpaper( paperwidth:integer;
paperheight:integer;
paperorientation:shortint;
Copys:integer):boolean;
var
device:array [0..255] of char;
driver:array [0..(max_path-1)] of char;
port:array [0..32] of char;
hdmode:thandle;
pdmodedevmode;
begin
result:=False;
//设置打印机段
printer.getprinter(device,driver,port,hdmode);
if hdmode<>0 then
begin
try
pdmode:=globallock(hdmode);
if pdmode<>nil then
begin
//设定打印的方向为纵向或横向
if paperorientation=1 then
pdmode^.dmorientation:=dmorient_landscape //纵向
else
pdmode^.dmorientation:=dmorient_portrait;
//横向
//设置拷贝份数为1份
pdmode^.dmcopies:=Copys;
//以毫米为单位的纸张大小.
pdmode^.dmpaperlength:= paperheight*10;
pdmode^.dmpaperwidth:=paperwidth*10;
//设置纸张类型为用户自定义.
pdmode^.dmpapersize:=dmpaper_user;
end;
globalunlock(hdmode);
printer.setprinter(device,driver,port,hdmode);
result:=true;
except
result:=false;
end;
end;
end;

//将实际横向打印尺寸转化为打印机分辨率尺寸
function mmtoprintpixelx(inputx:real):integer;
var
pddix:integer;
begin
pddix:=getdevicecaps(printer.handle,logpixelsx);
result:=trunc(inputx*10/253.8*pddix+0.5);
end;

//将实际纵向打印尺寸转化为打印机分辨率尺寸
function mmtoprintpixely(inputy:real):integer;
var
pddiy:integer;
begin
pddiy:=getdevicecaps(printer.handle,logpixelsy);
result:=trunc(inputy*10/253.8*pddiy+0.5);
end;

function TWebprinter.Get_isinit: Integer;
begin

end;

procedure TWebprinter.Set_isinit(Value: Integer);
begin

end;

//用来初始化打印机。如果初始化成功，则将属性isinit置为真，反之则为假。
procedure TWebprinter.prtstart(pagewidth, pageheight, pagerorientation,copys: OleVariant);
begin
// if get_isinit<>0 then
Showmessage('打印机忙，请稍候......');
if not initprintpaper(pagewidth,pageheight,pagerorientation,Copys) then
begin
set_isinit(1);
Set_Errmsg('打印机初始化（选取打印机、纸张设置、开始打印状态）失败!');
//showmessage('打印机纸张设置失败！');
end
else
begin
printer.begin
Doc;
set_isinit(0);
Set_Errmsg('');
//showmessage('打印机设置成功！');
end;
end;

//用来使打印机换页。
procedure TWebprinter.prtnewpage;
begin
printer.NewPage;
end;

//结束打印任务
procedure TWebprinter.prtend;
begin
printer.EndDoc;
end;

//用来在页面上绘制一条线。(x1,y1)为起始点.(x2,y2)为终止点
procedure TWebprinter.prtdrawline(x1, y1, x2, y2: OleVariant);
begin
with printerdo
begin
Canvas.MoveTo(mmtoprintpixelx(x1), mmtoprintpixely(y1));
Canvas.LineTo(mmtoprintpixelx(x2), mmtoprintpixely(y2));
end;

end;

//用来设置打印的字体名及大小
procedure TWebprinter.prtsetfont(fontname, fontsize, fontstyle: OleVariant);
var
i:byte;
begin
i:=FontStyle;
with printerdo
begin
Canvas.Font.name:=fontname;
Canvas.font.size := fontsize;
Canvas.font.Style:=[];
if (i and 1)=1 then
Canvas.font.Style:=Canvas.font.Style+[fsBold];
if (i and 2)=1 then
Canvas.font.Style:=Canvas.font.Style+[fsItalic];
if (i and 4)=1 then
Canvas.font.Style:=Canvas.font.Style+[fsUnderline];
if (i and 8)=1 then
Canvas.font.Style:=Canvas.font.Style+[fsStrikeOut];
end;
end;

function MyCopyleft(InputStr:string;CopyLen:integer;Var RightStr:string):string;
var
i,j,k:Integer;
begin
k:=Length(InputStr);
j:=0;
if K<=(CopyLen*2) then
//如果每行容纳的字符数大于实际的字符串长度则直接返回该字符串
begin
Result:=InputStr;
RightStr:='';
Exit;
end;
for i:=1 to CopyLen*2do
//计算在指定长度内ASC码大于127的字符数，用来防止将一个汉字分成两半
if ord(InputStr)>127 then
j:=j+1;
i:=CopyLen*2;
if (j mod 2)=1 then
i:=i-1;//如果指定长度内ASC码大于127的字符数为奇数，则说明有一个汉字一半位于指定位置之前，舍去之
Result:=Copy(InputStr,1,i);
RightStr:=Copy(InputStr,i+1,k-i);
end;

//在指定位置输出文字,完成在制定位置换行的功能
procedure TWebprinter.prttextout(X, Y, printstring,Charspline: OleVariant);
var
tmp,tmp1,tmp2:string;
i,j,k,LineHeight:integer;
tmpx,tmpy:Integer;
begin
Tmp:=PrintString;
i:=CharspLine;
j:=0;
k:=Length(tmp);
if i=0 then
i:=k+1;
LineHeight:=printer.Canvas.TextHeight('大富翁');//得到行高
tmpx:=mmtoprintpixelx(x);
//得到横向打印起点打印机坐标
tmpy:=mmtoprintpixely;
//得到纵向打印起点打印机坐标
with printerdo
begin
while k>0do
begin
tmp1:=MyCopyleft(tmp,i,tmp2);
//每次取出字符串左边的i个字符，自动防止取到半个汉字
tmp :=tmp2;
//同时返回被截取左边的剩余字符串
k:=Length(tmp);
j:=j+1;
Canvas.TextOut(tmpx,tmpy+LineHeight*j,tmp1);
end;
end;
end;

//输出矩形框
procedure TWebprinter.prtRectout(x1, y1, x2, y2, Style: OleVariant);
var
tmp:string;
begin
tmp:=Style;
with printerdo
begin
if tmp='psSolid' then
Canvas.Pen.Style:=psSolid;
if tmp='psClear' then
Canvas.Pen.Style:=psClear;
if tmp='psDot' then
Canvas.Pen.Style:=psDot;
if tmp='psDashDot' then
Canvas.Pen.Style:=psDashDot;
if tmp='psDashDotDot' then
Canvas.Pen.Style:=psDashDotDot;
Canvas.Rectangle(mmtoprintpixelx(x1),mmtoprintpixely(y1),mmtoprintpixelx(x2),mmtoprintpixely(y2) );
end;
end;

function TWebprinter.Get_Errmsg: OleVariant;
begin

end;

procedure TWebprinter.Set_Errmsg(Value: OleVariant);
begin

end;

procedure TWebprinter.ReadCfg(out Move_X, Move_Y: OleVariant);
var
prncfg:tinifile;
//本地配置文件
tmp:string;
tmpi:real;
begin
//获得用户本机存储的配置
prncfg:=tinifile.Create('IEprint.ini');
//打开配置文件，如果不存在则创建之
tmp:= prncfg.ReadString('PrintSet', 'Move_X', 'Error');//读取X方向原点位移
if tmp<>'Error' then
begin
tmpi:=StrToFloat(tmp);
//如果读取成功则设置X偏移
Move_X:=tmpi;
end
else
begin
Move_X:=0;
end;
tmp:= prncfg.ReadString('PrintSet', 'Move_Y', 'Error');
if tmp<>'Error' then
begin
tmpi:=StrToFloat(tmp);
Move_Y:=tmpi;
end
else
begin
Move_Y:=0;
end;
prncfg.Free;
end;

procedure TWebprinter.WriteCfg(Move_X, Move_Y: OleVariant);
var
prncfg:tinifile;
//本地配置文件
tmpi:real;
begin
//写入用户本机存储的配置
prncfg:=tinifile.Create('IEprint.ini');
//打开配置文件，如果不存在则创建之
tmpi:=Move_X;
prncfg.WriteString('PrintSet', 'Move_X', FloatToStr(tmpi));
//配置文件X位移
tmpi:=Move_Y;
prncfg.WriteString('PrintSet', 'Move_Y', FloatToStr(tmpi));
//配置文件Y位移
prncfg.Free;
end;

initialization
TAutoObjectFactory.Create(ComServer, TWebprinter, Class_Webprinter,
ciMultiInstance, tmApartment);
end.

这年头怪人真多。

http://www.playicq.com/dispdoc.asp?id=312

这是我以前写的一篇帖子，再贴一遍。
基于web的打印是目前一个比较麻烦的问题，解决方法一般是用
active控件或者applet实现，这些方法都依赖于浏览器对安全
的限制。这里提出的方法是直接调用ie的打印接口window.print()
方法，实现客户端的打印。
ie的打印接口功能非常简单，仅仅是将当前页面或者当前帧的内容
简单的打印到打印机上，没用提供任何有用的用于打印控制的api。
要想控制，就只有在html标签上下功夫了。
先讲讲普通的打印，即不需要套打的情况。
首先，整个页面应该是基于frame结构的。一个主要的frame用于显示
给用户，另外后台隐藏一个帧，我将其命名为print_frame,
当用户要求打印时，刷新print_frame，将要打印的内容组织成html传给
print_frame，另外在该html中加入以下脚本：
<SCRIPT FOR=window EVENT=onload LANGUAGE=/"JScript/">
?? parent.print_frame.focus();
??window.print();
</SCRIPT>
当print_frame刷新完成后ie的打印对话框会自动跳出来要求选择打印格式
之类的东西，确定后ie会打印隐藏的打印帧的内容
（就是parent.print_frame.focus();这句确定的）；
这时，面临的关键问题就是页面元素的定位了，这没有别的办法，只有一次次的试
了。记住，用象素定位而不要用百分比定位（所有的元素应该在表格中，只需要设定
table的列宽和列高就可以定位了）。一个屏幕象素等于打印机的0.01英寸，如何定
位就靠自己去算了。
关于套打。
其实上面提到的打印的实现方法对于套打是同样的，将不需要打印的部分去掉，只要
处理好定位的问题就可以了。关键可能是预览和套打如何协调。
在前台的主页面上显示预览的画面给客户，当客户打印时将同样的html传到隐藏帧显然
是不能实现套打的。那么维护两段基本相同的代码吗？这似乎太笨拙了，我的处理方法
是专门写了一个修正html标签的函数来处理要传递给打印帧的html。该函数实现的
主要功能是首先，要修正table的线条属性，先搜索到‘border＝’的字符串，为保险起见，
我没有删除它，而是将其替换为‘oldborder＝’，然后在该位置再加入一个‘border＝0’
的属性设置。第二步，是处理有些字符在预览时需要显示而打印时不需要打印的，这需要在
显示预览的html中引入一个特殊的标记<preview></preview>，这个标记是我自己定义的，
ie并不支持，正因为ie不支持，所以，该标记对于预览的显示不会造成任何影响。在需要打印
时，修正函数搜索这两个标记，将它们之间的字符全部替换为等长的&amp;
n b s p ;
.至此，套打
的问题就已经没有什么需要解决的了。

再给个在ASP中调用的例子好吗？

各位大哥，虽然时间很久了，可是我被这个问题给弄得不能动了
实现方式同appcat思路相同，可是调用的时候出现错误
asp代码
<% @Language = "VBScript" %>
<html>
<%
sub testprtobject
dim prtobject
set prtobject=createobject("iprttest3.print")
prtobject.printtext
set prtobject=nothing
end sub
testprtobject()
%>
错误类型：
iprttest3.print (0x8000FFFF)
/print/print.asp, 第 7 行

appcat 可以qq联系吗？你的email？
qq:2373382
em:wsxmly@21cn.com