Delphi开发ASP COM组件显示图片

Delphi单元如下：

unit CINNO.Debug;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

ComObj, ActiveX, Classes, Variants, VarConv, AspTlb, CINNO_TLB, Windows, StdVcl;

type

TDebug = class(TASPMTSObject, IDebug)

protected

procedure Debug; safecall;

end;

implementation

uses ComServ;

procedure TDebug.Debug;

var

Bitmap:TBitmap;

Jpeg:TJPEGImage;

bWidth,bHeight:Integer;

MS:TMemoryStream;

DataPointer:PByte;

OutputStream:Variant;

OutputStreamSize:Cardinal;

Counter:Integer;

begin

Response.ContentType:='image/jpeg';

Response.Flush;

//创建图片

bWidth:=Screen.Width;

bHeight:=Screen.Height;

Bitmap:=TBitmap.Create;

Bitmap.Width:=bWidth;

Bitmap.Height:=bHeight;

Bitmap.PixelFormat:=pf32bit;

//开始绘图

Bitmap.Canvas.Pen.Color:=clRed;

Bitmap.Canvas.Pen.Width:=3;

Bitmap.Canvas.Brush.Color:=clBlack;

Bitmap.Canvas.FillRect(Rect(0,0,bWidth-1,bHeight-1));

Bitmap.Canvas.Pen.Color:=clMoneyGreen;

Bitmap.Canvas.DrawFocusRect(Rect(0,0,bWidth-1,bHeight-1));

Bitmap.Canvas.MoveTo(0,0);

Bitmap.Canvas.Pen.Color:=clCream;

Bitmap.Canvas.LineTo(bWidth-1,bHeight-1);

Bitmap.Canvas.Font.Color:=clRed;

Bitmap.Canvas.Font.Size:=32;

Bitmap.Canvas.TextOut(800,600,DateTimeToStr(Now()));

Bitmap.Canvas.Pen.Color:=clWhite;

Bitmap.Canvas.Pen.Width:=5;

Bitmap.Canvas.Arc(100,100,200,200,500,500,800,800);

//转为Jpeg

Jpeg:=TJPEGImage.Create;

Jpeg.CompressionQuality:=90;

Jpeg.Assign(Bitmap);

//拷贝到安全数组

MS:=TMemoryStream.Create;

Jpeg.SaveToStream(MS);

DataPointer:=MS.Memory;

OutputStreamSize:=MS.Size;

OutputStream:=VarArrayCreate([1,OutputStreamSize],varByte);

for Counter := 1 to OutputStreamSize do

begin

VarArrayPut(OutputStream,Byte(DataPointer^),[Counter]);

Inc(DataPointer);

end;

//输出图片

Response.BinaryWrite(OutputStream);

Bitmap.Free;

Jpeg.Free;

MS.Free;

end;

initialization

TAutoObjectFactory.Create(ComServer, TDebug, Class_Debug,

ciMultiInstance, tmApartment);

end.

ASP代码如下：

<%@Language="VBS" CodePage="936"%>

<%

Option Explicit

Dim System,Debug

Set Debug=CreateObject("CINNO.Debug")

Debug.Debug

%>