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

posted @ 2007-10-31 00:28  Max Woods  阅读(515)  评论(0编辑  收藏  举报