• Delphi中BitBlt函数实现屏幕对象抓图


    uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;
    function CaptureScreenRect( ARect: TRect ): TBitmap;
    var
    ScreenDC: HDC;
    begin
    Result := TBitmap.Create;
    with Result, ARect do
    begin
    Width := Right - Left;
    Height := Bottom - Top;
    ScreenDC := GetDC( 0 );
    try
    BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC,
    Left, Top, SRCCOPY );
    finally
    ReleaseDC( 0, ScreenDC );
    end;
    end;
    end;
    思路是这样的
    parameter 是一个 TRect, 也就是一个 4 方形,你可以设定,是这样的
    TRect defines a rectangle.
    Unit
    Types
    Delphi syntax:
    type
    TRect = packed record
    case Integer of
    0: (Left, Top, Right, Bottom: Integer);
    1: (TopLeft, BottomRight: TPoint);
    end;
    返回一个 Bitmap 也就是图像拉
    创建一个新的 bitmap instance
    HDC 是一个 device context (DC),也就可以利用 BitBlt 把windows 图像转到 bitmap 里了。
    完整代码在这里,朋友可以直接调用
    unit ScrnCap;
    interface
    uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;
    function CaptureScreenRect( ARect: TRect ): TBitmap;
    function CaptureScreen: TBitmap;
    function CaptureClientImage( Control: TControl ): TBitmap;
    function CaptureControlImage( Control: TControl ): TBitmap;
    function CaptureWindowImage( Wnd: HWND ): TBitmap;
    implementation
    {==============================================================================}
    { Use this to capture a rectangle on the screen... }
    function CaptureScreenRect( ARect: TRect ): TBitmap;
    {==============================================================================}
    var
    ScreenDC: HDC;
    begin
    Result := TBitmap.Create;
    with Result, ARect do
    begin
    Width := Right - Left;
    Height := Bottom - Top;
    ScreenDC := GetDC( 0 );
    try
    BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC,
    Left, Top, SRCCOPY );
    finally
    ReleaseDC( 0, ScreenDC );
    end;
    end;
    end;
    {==============================================================================}
    { Use this to capture the entire screen... }
    function CaptureScreen: TBitmap;
    {==============================================================================}
    begin
    with Screen do
    Result := CaptureScreenRect( Rect( 0, 0, Width, Height ));
    end;
    {==============================================================================}
    { Use this to capture just the client area of a form or control... }
    function CaptureClientImage( Control: TControl ): TBitmap;
    {==============================================================================}
    begin
    with Control, Control.ClientOrigin do
    Result := CaptureScreenRect( Bounds( X, Y, ClientWidth,
    ClientHeight ));
    end;
    {==============================================================================}
    { Use this to capture an entire form or control... }
    function CaptureControlImage( Control: TControl ): TBitmap;
    {==============================================================================}
    begin
    with Control do
    if Parent = nil then
    Result := CaptureScreenRect( Bounds( Left, Top, Width,
    Height ))
    else
    with Parent.ClientToScreen( Point( Left, Top )) do
    Result := CaptureScreenRect( Bounds( X, Y, Width,
    Height ));
    end;
    {==============================================================================}
    { Use this to capture an entire form or control paased as an API hWnd... }
    function CaptureWindowImage( Wnd: HWND ): TBitmap;
    {==============================================================================}
    var
    R: TRect;
    begin
    GetWindowRect(Wnd, R);
    Result := CaptureScreenRect(R);
    end;
    end.

  • 相关阅读:
    windows系统Redis客户端连接远程服务器
    Linux安装JDK1.8示例
    Nexus OrientDB数据库变为只读 storage is switched to 'read only' mode
    在SQL中有时候我们需要查看现在正在SQL Server执行的命令
    注册asp.net 到 iis时出错中的一种的 解决办法
    python 装饰器
    python 类调用实例的方法
    linux 命令大全
    python多态
    python扩展字典的功能
  • 原文地址:https://www.cnblogs.com/Closeyes/p/3234704.html
Copyright © 2020-2023  润新知