Delphi開發ASP COM組件顯示圖片

來源:互聯網
上載者:User

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

相關文章

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.