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
%>