Delphi开发ASP COM组件显示图片

约定不等于承诺〃 2021-11-30 01:22 279阅读 0赞

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

转载于:https://www.cnblogs.com/MaxWoods/archive/2007/10/31/943712.html