关于COM中IPictureDisp和Tbitmap的传递和转换?

Question

COM控件中封装了视频功能，当接收到视频数据后，会将视频数据画到一个Tbitmap上,然后产生一个事件，将Tbitmap传递出去。
当然COM并不支持Tbitmap类型的参数，比较类似的是IPictureDisp，请教大家如何进行转换的接收?
100分奉上。

Answer 1

关键要看你如何传,你也可以用字节数据传.
IPictureDisp是一个Dispatch,适用于远程操作,而不是传输.

Answer 2

Uses
  AxCtrls;var
bmp: TBitmap;
Picture:TPicture;
PictureAdapter :TPictureAdapter;MyPicDisp:IPictureDisp;begin
  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile(FileName);//当然也可以直接由TPicture来Load
    Picture := TPicture.Create;
    try
      Picture.Assign(bmp);
      GetOlePicture(Picture,MyPicDisp);//这里由TPicture得到IPictureDisp
    finally
      Picture.Free;
    end;
  finally
    bmp.Free;
  end;
end;

Answer 3

  Itestimage = interface(IDispatch)
    ['{DBE43759-A55C-4B11-951D-A5466BC0642D}']
    function Get_image: IPictureDisp; safecall;
    procedure Set_image(const Value: IPictureDisp); safecall;
    property image: IPictureDisp read Get_image write Set_image;function Ttestimage.Get_image: IPictureDisp;
var
  picture:Tpicture;
  BitMap:TBitMap;
var
  DeskWnd,   DeskDC:LongWord;
begin
  picture:=Tpicture.Create;
  DeskWnd:=GetDesktopWindow();
  DeskDC:=GetDC(DeskWnd);
  BitMap:=TBitMap.Create;
  try
      BitMap.Width:=Screen.Width;
      BitMap.Height:=Screen.Height;
      Bitblt(BitMap.Canvas.Handle,0,0,Screen.Width,Screen.Height,
                    DeskDC,0,0,SRCCOPY);
      Picture.Assign(Bitmap);
      GetOlePicture(Picture,Result);//
  finally
    ReleaseDC(DeskWnd,DeskDC);
    picture.Free;
  end;
end;
调用procedure TForm1.Button1Click(Sender: TObject);
begin
  SetOlePicture(Image1.Picture,Fobject.image);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Fobject:= CreateComObject(CLASS_testimage) as ItestimageDisp;
end;运行时不出错，但是图片出不来，而且在执行
SetOlePicture(Image1.Picture,Fobject.image);
这句时，会弹出cpu调式的单元7C92120F C3               ret 
7C921210 8BFF             mov edi,edi
ntdll.DbgUserBreakPoint:
7C921212 CC               int 3
7C921213 C3               ret 
7C921214 8BFF             mov edi,edi
7C921216 8B442404         mov eax,[esp+$04]
7C92121A CC               int 3
7C92121B C20400           ret $0004
ntdll.NtCurrentTeb:
7C92121E 64A118000000     mov eax, fs:[$00000018]
.....略当然在这一句之前Picture.Assign(Bitmap)我能确定这个图是有的，因为我用ole转换成流的方式传递图片,调用者能显示出来,只是我认为用Ole转换成流(发送和接需要jpeg压缩,不用jpeg压缩image加载图片会失败)，比较占用资源(因为我要传输的可是视频数据，每秒不低于15帧),不可取。

Answer 4

其实我想要的效果很简单，就是把com中的TBitmap参数传给调用者，同时要考虑每秒15帧以上的频率。

Answer 5

那你就不能使用IPictureDisp,而应该用IPicture.

Answer 6

com中的参数类型,我能找到的最接近的有两种Ipicture*,picture*
但选中后，在TestIntf_TLB自动生成的代码还是IPictureDisp
    
    function Get_Myimage: IPictureDisp; safecall;
    procedure Set_Myimage(const Value: IPictureDisp); safecall;
    property Myimage: IPictureDisp read Get_Myimage write Set_Myimage;上面的代码，明明我选的是picture*类型，晕倒...

Answer 7

传递HBitmap句柄过去吧！
然后通过该句柄就可以还原成位图了
给你一个函数做参考！不过是我写的转换成流的
procedure SaveHBmpToStream(const bmpHandle: HBITMAP;Stream: TStream);
var
  ds: TDIBSection;
  BmpFileHeader:  TBitmapFileHeader;
  NumberOfColors,BitCount: Integer;
  Bm: tagBITMAP;
  Bytes: integer;
begin
  if Stream = nil then
    raise Exception.Create('Stream无效');
  Stream.Size := 0;
  Bytes := GetObject(bmpHandle,SizeOf(ds),@ds); //获得有关DIBSECTION结构中的点阵图资讯
  if Bytes = 0 then
    raise Exception.Create('无效的位图文件');
  Bytes := GetObject(bmpHandle,SizeOf(bm),@Bm);//获得tagBITMAP结构
  if Bytes = 0 then
    raise Exception.Create('无效的位图文件');
  try
    NumberOfColors := ds.dsBmih.biClrUsed;//获得调色板中实际使用的颜色数
    BitCount := ds.dsBmih.biBitCount;//位图位数
    if (NumberOfColors = 0) and (BitCount <= 8) then
       NumberOfColors := 1 shl BitCount;
    With BmpFileHeader do
    begin
      bfType := $4D42;  // 'BM'位图标记
      bfReserved1 := 0;
      bfReserved2 := 0;
      bfOffBits := SizeOf(TBitmapFileHeader)       +
                   SizeOf(TBitmapInfoHeader)       +
                   NumberOfColors*SizeOf(TRGBQuad); //获得信息头大小
      bfSize := bfOffBits + ds.dsBmih.biSizeImage; //获得文件大小
    end;
    Stream.Write(BmpFileHeader,sizeof(BITMAPFILEHEADER));
    Stream.Write(ds.dsBmih,sizeof(TBITMAPINFOHEADER));
    stream.Write(Bm.bmBits^, ds.dsBmih.biSizeImage);
    Stream.Seek(0,soFromBeginning);
    Ini.WriteString('成功','SaveHBmpToStream','调用procedure SaveHBmpToStream(const bmpHandle: HBITMAP;Stream: TStream);成功');
  except
    on E: Exception do
      MessageBox(application.Handle,PChar(E.Message),'错误',16);
  end;
end;

Answer 8

procedure SaveHBmpToStream(const bmpHandle: HBITMAP;Stream: TStream);
var
  ds: TDIBSection;
  BmpFileHeader:  TBitmapFileHeader;
  NumberOfColors,BitCount: Integer;
  Bm: tagBITMAP;
  Bytes: integer;
begin
  if Stream = nil then
    raise Exception.Create('Stream无效');
  Stream.Size := 0;
  Bytes := GetObject(bmpHandle,SizeOf(ds),@ds); //获得有关DIBSECTION结构中的点阵图资讯
  if Bytes = 0 then
    raise Exception.Create('无效的位图文件');
  Bytes := GetObject(bmpHandle,SizeOf(bm),@Bm);//获得tagBITMAP结构
  if Bytes = 0 then
    raise Exception.Create('无效的位图文件');
  try
    NumberOfColors := ds.dsBmih.biClrUsed;//获得调色板中实际使用的颜色数
    BitCount := ds.dsBmih.biBitCount;//位图位数
    if (NumberOfColors = 0) and (BitCount <= 8) then
       NumberOfColors := 1 shl BitCount;
    With BmpFileHeader do
    begin
      bfType := $4D42;  // 'BM'位图标记
      bfReserved1 := 0;
      bfReserved2 := 0;
      bfOffBits := SizeOf(TBitmapFileHeader)       +
                   SizeOf(TBitmapInfoHeader)       +
                   NumberOfColors*SizeOf(TRGBQuad); //获得信息头大小
      bfSize := bfOffBits + ds.dsBmih.biSizeImage; //获得文件大小
    end;
    Stream.Write(BmpFileHeader,sizeof(BITMAPFILEHEADER));
    Stream.Write(ds.dsBmih,sizeof(TBITMAPINFOHEADER));
    stream.Write(Bm.bmBits^, ds.dsBmih.biSizeImage);
    Stream.Seek(0,soFromBeginning);
    TStream);成功');
  except
    on E: Exception do
      MessageBox(application.Handle,PChar(E.Message),'错误',16);
  end;
end;是转换成流的，就是数据提取，然后写，自己形成位图格式了。

Answer 9

在对端有没有从IPictureDisp到TPicture的还原?

Answer 10

function Ttestimage.Get_MyimageHandle: SYSINT;
var
  BitMap:TBitMap;
  DeskWnd,   DeskDC:LongWord;
begin
  DeskWnd:=GetDesktopWindow();
  DeskDC:=GetDC(DeskWnd);
  BitMap:=TBitMap.Create;
  try
      BitMap.Width:=Screen.Width;
      BitMap.Height:=Screen.Height;
      Bitblt(BitMap.Canvas.Handle,0,0,Screen.Width,Screen.Height,
                    DeskDC,0,0,SRCCOPY);
  finally
      ReleaseDC(DeskWnd,DeskDC);
  end;
  result:=BitMap.Handle;
end;调用代码：
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap.Handle:=Fobject.MyimageHandle;
end;解决方案如此简单，简单的不能接受，哈哈。
在此要感谢unsigned ,不得闲的热心帮助。最终是不得闲的思路让我考虑这个问题从复杂回归到简单。

Answer 11

有还原
SetOlePicture(Image1.Picture,Fobject.image);
这句就是，只不过会出现cpu调试窗口，并没有还原成功，但也不报错，我也不清楚为什么。

Answer 12

其实我还有一个写法，只是个人认为效率不高，贴出来给大家分享
MemoryStreamToOleVariant和OleVariantToMemoryStream这两个函数大家BAIDU一下就有了。function Ttestimage.Get_OleImage: OleVariant;
var
  BitMap:TBitMap;
  DeskWnd,   DeskDC:LongWord;
  MemoryStream: TMemoryStream;
begin
  DeskWnd:=GetDesktopWindow();
  DeskDC:=GetDC(DeskWnd);
  BitMap:=TBitMap.Create;
  try
    BitMap.Width:=Screen.Width;
    BitMap.Height:=Screen.Height;
    Bitblt(BitMap.Canvas.Handle,0,0,Screen.Width,Screen.Height,
                  DeskDC,0,0,SRCCOPY);
  finally
    ReleaseDC(DeskWnd,DeskDC);
  end;  MemoryStream := TMemoryStream.Create;
  try
    BitMap.SaveToStream(MemoryStream);
    Result := MemoryStreamToOleVariant(MemoryStream);
  finally
    MemoryStream.Free;
    BitMap.Free;
  end;
end;调用代码:
procedure TForm1.Button2Click(Sender: TObject);
var
  BinaryData : OleVariant;
  Stream: TMemoryStream;
  Jpeg :TJpegimage;
  BitMap:TBitMap;
begin
  BinaryData:=Fobject.OleImage;
  try
    Stream := OleVariantToMemoryStream(BinaryData);
    Stream.Position := 0;
    try
      BitMap:=TBitMap.Create;
      BitMap.LoadFromStream(Stream);
      try
        Jpeg :=TJpegimage.Create;
        Jpeg.Assign(BitMap);
        Jpeg.CompressionQuality := 100;
        Jpeg.Compress;
        Image1.Picture.Assign(Jpeg);
      finally
        Jpeg.Free;
      end;
    finally
      BitMap.Free;
    end;
  finally
    Stream.Free;
  end;
end;