clnmain.pas

DELPHI实现的快速屏幕截图并发送源代码

unit clnMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScrSpy, Menus;

type
  TForm1 = class(TForm)
    ScreenPlayer1: TScreenPlayer;
    PopupMenu1: TPopupMenu;
    FullScreen1: TMenuItem;
    Restore1: TMenuItem;
    procedure ScreenPlayer1HeaderUpdate(Sender: TObject);
    procedure ScreenPlayer1ScreenBitmap(Sender: TObject;
      const Block: TScreenBlock);
    procedure FormCreate(Sender: TObject);
    procedure ScreenPlayer1FrameEnd(Sender: TObject;
      const FrameCount: Cardinal; const IsIFrame, HasBitmapEvent: Boolean);
    procedure FormResize(Sender: TObject);
    procedure FullScreen1Click(Sender: TObject);
    procedure Restore1Click(Sender: TObject);
  private
    { Private declarations }
    XRate, YRate: Extended;
    HasServer: Boolean;
    BMP: array of TBitmap;
    BMPBound: array of TRect;
    Updated: array of Boolean;
    Count: Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ScreenPlayer1HeaderUpdate(Sender: TObject);
Var
  i: Integer;
begin
  HasServer:= True;
  XRate:= ClientWidth / ScreenPlayer1.ScreenWidth;
  YRate:= ClientHeight / ScreenPlayer1.ScreenHeight;

  For i:=0 to Count-1 do
    BMP[i].Free;
  Count:= ScreenPlayer1.BlockCount;
  SetLength(BMP, Count);
  SetLength(Updated, Count);
  SetLength(BMPBound, Count);
  For i:=0 to Count-1 do
  Begin
    BMP[i]:= TBitmap.Create;
    BMP[i].HandleType:= bmDIB;
    BMP[i].Width:= ScreenPlayer1.ScreenWidth;
    BMP[i].Height:= ScreenPlayer1.ScreenHeight;
    BMP[i].PixelFormat:= ScreenPlayer1.PixelFormat;
  End;
end;

procedure TForm1.ScreenPlayer1ScreenBitmap(Sender: TObject;
  const Block: TScreenBlock);
begin
  BMP[Block.BlockIndex].Assign(Block.BMP);
  BMPBound[Block.BlockIndex]:= Block.Bound;
  Updated[Block.BlockIndex]:= True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  HasServer:= False;
  Count:= 0;
end;

procedure TForm1.ScreenPlayer1FrameEnd(Sender: TObject;
  const FrameCount: Cardinal; const IsIFrame, HasBitmapEvent: Boolean);
Var
  i: Integer;
  R: TRect;
begin
  If HasBitmapEvent then
  Begin
    For i:=0 to Count-1 do
      If Updated[i] then
      Begin
        R:= Rect(Round(BMPBound[i].Left*XRate), Round(BMPBound[i].Top*YRate), Round(BMPBound[i].Right*XRate), Round(BMPBound[i].Bottom*YRate));
        Canvas.StretchDraw(R, BMP[i]);
        Updated[i]:= False;
      End;
  End;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  If HasServer then
  Begin
    XRate:= ClientWidth / ScreenPlayer1.ScreenWidth;
    YRate:= ClientHeight / ScreenPlayer1.ScreenHeight;
  End;
end;

procedure TForm1.FullScreen1Click(Sender: TObject);
begin
  BorderStyle:= bsNone;
  WindowState:= wsMaximized;
end;

procedure TForm1.Restore1Click(Sender: TObject);
begin
  BorderStyle:= bsSizeable;
  WindowState:= wsNormal;
end;

end.