5,388
社区成员
发帖
与我相关
我的任务
分享
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;
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;
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;
function Get_Myimage: IPictureDisp; safecall;
procedure Set_Myimage(const Value: IPictureDisp); safecall;
property Myimage: IPictureDisp read Get_Myimage write Set_Myimage;
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;
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]
.....略
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;