capture.pas

该控件用于window截屏

{*********************************************************************}
{  Component of Capture                                               }
{  Copyright (C) 2004 by                                              }
{  Xi'an Electronic Engineering Research Institute(XEERI)             }
{  Version 1.0                                                        }
{  Write By Qixh                                                      }
{*********************************************************************}
unit Capture;

interface

uses
  windows,ExtCtrls,StrUtils,JPEG, ComCtrls,graphics, SysUtils,shlobj,Classes,Forms;
type
  TCapture = class(TComponent)
  private
    FSavePath:String;
    FFileName:String;
    FX0,FY0,FX1,FY1:integer;
    FPixelFormat:TPixelFormat;
    procedure SetFold(SavePath:string);
    procedure SetFileName(FileName:string);
    procedure SetX0(const Value: integer);
    procedure SetX1(const Value: integer);
    procedure SetY0(const Value: integer);
    procedure SetY1(const Value: integer);
    procedure SetPixelFormat(const Value: TPixelFormat);
    { Private declarations }
  protected
    { Protected declarations }
  public
    BMPToJPGZIPRate:integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Capture;
    { Public declarations }
  published
    property SavePath:string read FSavePath write SetFold;
    property FileName:string read FFileName write SetFileName;
    Property X0:integer read FX0 write SetX0;
    Property Y0:integer read FY0 write SetY0;
    Property X1:integer read FX1 write SetX1;
    Property Y1:integer read FY1 write SetY1;
    property PixelFormat:TPixelFormat read FPixelFormat write SetPixelFormat;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('QixhComponent', [TCapture]);
end;

{ TCapture }
procedure TCapture.SetFold(SavePath:string);
begin
  if SavePath='' then SavePath:='C:\';
  if FSavePath=SavePath then exit;
  FSavePath:=SavePath;
end;

procedure TCapture.SetFileName(FileName:string);
begin
  if FileName='' then FileName:='Screen.JPG';
  if FFileName=FileName then exit;
  FFileName:=FileName;
end;

constructor TCapture.Create(AOwner: TComponent);
begin
  inherited;
  FSavePath:='C:\';
  FFileName:='Screen.JPG';
  FX0:=0;
  FY0:=0;
  FX1:=Screen.Width;
  FY1:=Screen.Height;
  FPixelFormat:= pf24bit;
  BMPToJPGZIPRate:=50;
end;

destructor TCapture.Destroy;
begin
  inherited;
end;

procedure TCapture.Capture;
var
  ScreenDC:HDC;
  newbitmap:TBitmap;
  newJPEG : TJPEGImage;
  SS:string;
begin
  newbitmap:=tbitmap.Create;
  newbitmap.PixelFormat:=FPixelFormat;
  try
    newbitmap.Width:=abs(FX1-FX0);
    newbitmap.Height:=abs(FY1-FY0);
    ScreenDC:=GetDC(0);
    try
     bitblt(newBitmap.Canvas.Handle,0,0,FX1-FX0,
            FY1-FY0,screendc,FX0,FY0,srccopy);
    finally
      releasedc(0,screendc);
    end;
    ss:=FSavePath;
    if not AnsiEndsText('\',ss) then ss:=ss+'\';
    if not DirectoryExists(ss) then
    MKdir(ss);

    if AnsiEndsText('bmp',FFileName) then
      newbitmap.SaveToFile(ss+FFileName);
    if AnsiEndsText('jpg',FFileName) then
    begin
      newJPEG:=TJPEGImage.Create;
      with newJPEG do
      begin
        assign(newbitmap);
        CompressionQuality:=BMPToJPGZIPRate; //压缩比例
        Compress;
        SaveToFile(ss+FFileName);
        Free;
      end;
    end;
  finally
    newbitmap.Free;
  end;
end;

procedure TCapture.SetX0(const Value: integer);
begin
  FX0 := Value;
end;

procedure TCapture.SetX1(const Value: integer);
begin
  FX1 := Value;
end;

procedure TCapture.SetY0(const Value: integer);
begin
  FY0 := Value;
end;

procedure TCapture.SetY1(const Value: integer);
begin
  FY1 := Value;
end;

procedure TCapture.SetPixelFormat(const Value: TPixelFormat);
begin
  FPixelFormat := Value;
end;

end.