注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

BCB-DG's Blog

...

 
 
 

日志

 
 

API截屏的簡單演示  

2010-03-18 15:30:49|  分类: VNC |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
有寫BMP文件部分,未處理字節對齊與顏色表。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TfrmMain = class(TForm)
    tmr1: TTimer;
    img1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
    FStream: TMemoryStream;
  end;

var
  frmMain: TfrmMain;

implementation
{$R *.dfm}

procedure CapScreen(ms: TMemoryStream);
var
  bfh: TBitmapFileHeader;
  hBmp: HBITMAP;
  DC, CDC: HDC;
  bi: TBitmapInfo;
  pBuf: Pointer;
  n, W, H: DWORD;
begin
  W := GetSystemMetrics(SM_CXSCREEN);
  H := GetSystemMetrics(SM_CYSCREEN);
  //
  FillChar(bi, SizeOf(bi), #0);
  with bi.bmiHeader do
  begin
    biSize     := SizeOf(bi);
    biWidth    := W;
    biHeight   := H;
    biPlanes   := 1;
    biBitCount := 16; //no color table
    biCompression := BI_RGB;
  end;
  pBuf := GlobalAllocPtr(64, W * H * 4); //size ? align ?
  //
  DC   := GetDC(0);
  CDC  := CreateCompatibleDC(DC);
  hBmp := CreateCompatibleBitmap(DC, W, H);
  SelectObject(CDC, hBmp);
  BitBlt(CDC, 0, 0, W, H, DC, 0, 0, SRCCOPY);
  GetDIBits(CDC, hBmp, 0, H, pBuf, bi, DIB_RGB_COLORS);
  //
  n := W * H * 2; //align ?
  with bfh do
  begin
    bfType := $4D42;
    bfSize := SizeOf(bfh) + SizeOf(TBitmapInfoHeader) + n;
    bfOffBits := SizeOf(bfh) + SizeOf(TBitmapInfoHeader);
    bfReserved1 := 0;
    bfReserved2 := 0;
  end;
  ms.Clear;
  ms.Write(bfh, SizeOf(bfh));
  ms.Write(bi, SizeOf(TBitmapInfoHeader));
  ms.Write(pBuf^, n);
  ms.Position := 0;
  //
  ReleaseDC(0, DC);
  DeleteDC(CDC);
  DeleteObject(hBmp);
  GlobalFreePtr(pBuf);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FStream := TMemoryStream.Create;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FStream.Free;
end;

procedure TfrmMain.tmr1Timer(Sender: TObject);
begin
  CapScreen(FStream);
  img1.Picture.Bitmap.LoadFromStream(FStream);
end;

end.

  评论这张
 
阅读(1804)| 评论(2)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017