抓屏到tbitmap,然后用zlip压缩。 (没有任何错误为什么无法执行呢???) ( 积分: 31 )

  • 主题发起人 主题发起人 winni
  • 开始时间 开始时间
W

winni

Unregistered / Unconfirmed
GUEST, unregistred user!
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Jpeg, ComCtrls, ExtCtrls,zlib;
........................
function CompressStream (aSource, aTarget: TStream): Single;
var
comprStream: TCompressionStream;
begin
comprStream := TCompressionStream.Create(
clFastest, aTarget);
try
comprStream.CopyFrom(aSource, aSource.Size);
Result := comprStream.CompressionRate;
finally
comprStream.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var b:tbitmap;n:tcanvas; h,h2:TmemoryStream;
begin
b:=tbitmap.Create ;
n:=tcanvas.Create ;
b.Width :=screen.Width; b.height :=screen.height;
n.Handle:=GetDC(0);
b.Canvas.CopyRect(n.ClipRect,n,n.ClipRect); //抓屏
h:=TmemoryStream.Create ;
h2:=TmemoryStream.Create ;
b.SaveToStream(h); //明明SaveToStream了,而h.size却等于0
CompressStream(h,h2);
h2.SaveToFile('j:/a.bmp');
h2.Free ;
h.Free ;
n.Free;
b.Free ;
end;
end.
提示流读取出错。
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Jpeg, ComCtrls, ExtCtrls,zlib;
........................
function CompressStream (aSource, aTarget: TStream): Single;
var
comprStream: TCompressionStream;
begin
comprStream := TCompressionStream.Create(
clFastest, aTarget);
try
comprStream.CopyFrom(aSource, aSource.Size);
Result := comprStream.CompressionRate;
finally
comprStream.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var b:tbitmap;n:tcanvas; h,h2:TmemoryStream;
begin
b:=tbitmap.Create ;
n:=tcanvas.Create ;
b.Width :=screen.Width; b.height :=screen.height;
n.Handle:=GetDC(0);
b.Canvas.CopyRect(n.ClipRect,n,n.ClipRect); //抓屏
h:=TmemoryStream.Create ;
h2:=TmemoryStream.Create ;
b.SaveToStream(h); //明明SaveToStream了,而h.size却等于0
CompressStream(h,h2);
h2.SaveToFile('j:/a.bmp');
h2.Free ;
h.Free ;
n.Free;
b.Free ;
end;
end.
提示流读取出错。
 
h.seek(0,0);
 
后退
顶部