快速远程屏幕传输Indy10版

//主要思路是guanyueguan(BCB_DG)http://iamgyg.blog.163.com的高速屏传代码

这是其中主要的代码

unit UntMonitorThread;

interface

uses
IdTCPClient, Classes, windows,Graphics,ZLibEx,IdGlobal;

const
DEF_STEP = 19;
OFF_SET = 24;

type
PCapCmd = ^TCapCmd;
TCapCmd = packed record
    Cmd:    Byte;
    Size:   Integer;
    Width: Word;
    Height: Word;
end;

    PCtlCmd = ^TCtlCmd;
TCtlCmd = packed record
    Cmd: Byte;
    X, Y: Word;
end;

TStripMonitorThread = class(TThread)
private
    FScrStream: TMemoryStream;
    FSendStream: TMemoryStream;
    FFullBmp, FLineBmp, FRectBmp: TBitmap;
    FWidth, FHeight, FLine: Integer;
    FRect: TRect;
    FDC: HDC;
    FSocket: TIdTCPClient;
    FCmd: TCapCmd;
    FPixelFormat: TPixelFormat;
    FIncSize: Byte;
    first:boolean;
    //
    function CheckScr: Boolean;
    function GetFirst: Boolean;
    function GetNext: Boolean;
    function Compress: Boolean;
    function SendInfo: Boolean;
    function SendData: Boolean;
    procedure CopyRect(rt: TRect);
    procedure SetPixelFormat(Value: TPixelFormat);

protected
    procedure Execute; override;
public
    constructor Create;
    destructor Destroy; override;
    property Socket: TIdTCPClient read FSocket;
    property PixelFormat: TPixelFormat read FPixelFormat write SetPixelFormat;
end;

implementation

uses Unit1,DisposalCmdUnit;

constructor TstripMonitorThread.Create;
begin
inherited Create(true);

FSocket:=TIdTCPClient.Create(nil);
//Fsocket.IOHandler.RecvBufferSize:= 4096;
// Fsocket.IOHandler.SendBufferSize:= 4096;
//Fsocket.ReadTimeout:=15000;
FScrStream   := TMemoryStream.Create;
FSendStream := TMemoryStream.Create;
FFullBmp := TBitmap.Create;
FLineBmp := TBitmap.Create;
FRectBmp := TBitmap.Create;
FWidth   := 0;
FHeight := 0;
FIncSize := 4;
//case ThisPicPixFmt of //转换的像素颜色位 1 2 4 8 16 24 32
FPixelFormat := pf8bit;
   // 5: FPixelFormat := pf32bit;
// else
   // FPixelFormat := pf32bit;
// end;
FreeOnTerminate := True; //主动释放，不是自动释放
Suspended := False; //立即执行
ScreenOver:=True;
end;

destructor TStripMonitorThread.Destroy;
begin
FSocket.Free;
ScreenOver:=false;
FScrStream.Free;
FSendStream.Free;
FRectBmp.Free;
FFullBmp.Free;
FLineBmp.Free;
inherited destroy;
end;

procedure TStripMonitorThread.Execute;
var
CmdBuf: array[0..SizeOf(TCtlCmd) - 1] of Byte;
pt: TPoint;
Request:string;
buf:TidBytes;
begin
   if form1.ConRpcport(FSocket) then
   begin
     try
       FSocket.IOHandler.Write('002'+EOL);
     except
       FSocket.Free;
       Exit;
     end;
     Request:=FSocket.IOHandler.ReadLn(EOL);
   end;
   if CheckScr then First :=true;
   try
     repeat
      FSocket.IOHandler.ReadBytes(buf, SizeOf(TCtlCmd));
      BytesToRaw(buf,CmdBuf,sizeof(TCtlCmd));
      if TCtlCmd(CmdBuf).Cmd in [1..5] then
      begin
        pt := Point(TCtlCmd(CmdBuf).X, TCtlCmd(CmdBuf).Y);
        SetCursorPos(pt.X, pt.Y);
        SetCapture(WindowFromPoint(pt));
      end;
      case TCtlCmd(CmdBuf).Cmd of
        8: if First then GetFirst else GetNext;
        0: PixelFormat := TPixelFormat(TCtlCmd(CmdBuf).X);
        1: ;//mouse move
        2: mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
        3: mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
        4: mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
        5: mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);
        6: keybd_event(Byte(TCtlCmd(CmdBuf).X), MapVirtualKey(Byte(TCtlCmd(CmdBuf).X), 0), 0, 0);
        7: keybd_event(Byte(TCtlCmd(CmdBuf).X), MapVirtualKey(Byte(TCtlCmd(CmdBuf).X), 0), KEYEVENTF_KEYUP, 0);
      end;
     until FSocket.Connected=False;
   except
   end;
   FSocket.Disconnect;
end;

function TStripMonitorThread.CheckScr: Boolean;
var
nWidth, nHeight: Integer;
begin
Result := False;
nWidth := GetSystemMetrics(SM_CXSCREEN);//取得屏幕长宽
nHeight := GetSystemMetrics(SM_CYSCREEN);
if (nWidth <> FWidth) or (nHeight <> FHeight) then
begin
    FWidth := nWidth;
    FHeight := nHeight;
    FFullBmp.Canvas.Lock;
    FLineBmp.Canvas.Lock;
    FRectBmp.Canvas.Lock;
    FFullBmp.Width := FWidth;
    FFullBmp.Height := FHeight;
    FLineBmp.Width := FWidth;
    FLineBmp.Height := 1;
    FFullBmp.PixelFormat := FPixelFormat;
    FLineBmp.PixelFormat := FPixelFormat;
    FRectBmp.PixelFormat := FPixelFormat;
    FFullBmp.Canvas.Unlock;
    FLineBmp.Canvas.Unlock;
    FRectBmp.Canvas.Unlock;
    FLine := 0;
    Result := True;
end;
end;
//压缩数据
function TStripMonitorThread.Compress: Boolean;
begin
Result := False;
try
    FSendStream.Clear;
    FScrStream.Position := 0;
    ZCompressStream(FScrStream, FSendStream);
    FSendStream.Position := 0;
    Result := True;
except
end;
end;

procedure TStripMonitorThread.CopyRect(rt: TRect);
begin
FFullBmp.Canvas.Lock;
FRectBmp.Canvas.Lock;
try
    FRectBmp.Width := rt.Right - rt.Left;//截取的图片宽与高
    FRectBmp.Height := rt.Bottom - rt.Top;
    BitBlt(FFullBmp.Canvas.Handle, rt.Left, rt.Top, FRectBmp.Width, FRectBmp.Height, FDC, rt.Left, rt.Top, SRCCOPY);
    BitBlt(FRectBmp.Canvas.Handle, 0, 0, FRectBmp.Width, FRectBmp.Height, FFullBmp.Canvas.Handle, rt.Left, rt.Top, SRCCOPY);
    FScrStream.WriteBuffer(FRect, SizeOf(TRect));
    FRectBmp.SaveToStream(FScrStream);
finally
    FFullBmp.Canvas.Unlock;
    FRectBmp.Canvas.Unlock;
end;
end;
//拷第一个图
function TStripMonitorThread.GetFirst: Boolean;
begin
Result := False;
FDC := GetDC(0);
FFullBmp.Canvas.Lock;
BitBlt(FFullBmp.Canvas.Handle, 0, 0, FWidth, FHeight, FDC, 0, 0, SRCCOPY);//
FFullBmp.Canvas.Unlock;
ReleaseDC(0, FDC);
SetRect(FRect, 0, 0, FWidth, FHeight);//赋值FRect
FScrStream.Clear;
FScrStream.WriteBuffer(FRect, SizeOf(TRect)); //把FRect读入流
FFullBmp.SaveToStream(FScrStream); //把图片也读入流中
if Compress and SendInfo then Result := SendData;   //压缩并且发送数据
First :=not Result;
end;

//后续屏幕
function TStripMonitorThread.GetNext: Boolean;
var
p1, p2: PDWORD;
i, j: Integer;
begin
Result := False;
FScrStream.Clear;
FDC := GetDC(0);
i := FLine;
while i < FHeight do
begin
    FLineBmp.Canvas.Lock;
    BitBlt(FLineBmp.Canvas.Handle, 0, 0, FWidth, 1, FDC, 0, i, SRCCOPY);//逐行
    FLineBmp.Canvas.Unlock;
    p1 := FFullBmp.ScanLine[i];
    p2 := FLineBmp.ScanLine[0];
    SetRect(FRect, -1, i - DEF_STEP, -1, i + DEF_STEP * 2);//初始化FRect
                 //Left    Top       Right     Bottom
    j := 0;
    while j < FWidth do
    begin
      if (p1^ <> p2^) then
      begin
        if (FRect.Right < 0) then FRect.Left := j - OFF_SET;
        FRect.Right := j + OFF_SET;
      end;
      Inc(p1);
      Inc(p2);
      Inc(j, FIncSize);
    end;
    if (FRect.Right > -1) then //如果屏幕有变化
    begin
      with FRect do
      begin
        Left   := Max(Left, 0);
        Top    := Max(Top, 0);
        Right := Min(Right, FWidth);
        Bottom := Min(Bottom, FHeight);
      end;
      CopyRect(FRect);
      Inc(i, DEF_STEP);
    end;
    Inc(i, DEF_STEP);
end;
ReleaseDC(0, FDC);
FLine := (FLine + 3) mod DEF_STEP; //?
if (FScrStream.Position > 0) and Compress then Result := SendData;

end;

function TStripMonitorThread.SendInfo: Boolean;
begin
try
    FCmd.Cmd := 1;   //发送第一副图
    FCmd.Size := 0;
    FCmd.Width := FWidth;    //传屏幕长宽
    FCmd.Height := FHeight;
    FSocket.IOHandler.Write(RawToBytes(FCmd, SizeOf(TCapCmd)));
    Result := True;
except
    Result := False;
end;
end;

function TStripMonitorThread.SendData: Boolean;
begin
try
    FCmd.Cmd := 2;
    FCmd.Size := FSendStream.Size;
    FSocket.IOHandler.Write(RawToBytes(FCmd, SizeOf(TCapCmd)));
    FSocket.IOHandler.Write(FSendStream,FCmd.Size,false);
    Result := True;
except
    Result := False;
end;
end;

procedure TStripMonitorThread.SetPixelFormat(Value: TPixelFormat);
begin
if (FPixelFormat <> Value) then
begin
    FPixelFormat := Value;
    case FPixelFormat of
      pf1bit: FIncSize := 32;
      pf4bit: FIncSize := 8;
      pf8bit: FIncSize := 4;
      pf16bit: FIncSize := 2;
      pf32bit: FIncSize := 1;
      else
        FPixelFormat := pf8bit;
        FIncSize := 4;
    end;
    FFullBmp.PixelFormat := FPixelFormat;
    FLineBmp.PixelFormat := FPixelFormat;
    FRectBmp.PixelFormat := FPixelFormat;
end;
end;

end.

 

//////////////////////////以下为主控制端///////////////////////////////////////////////

unit showpic;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, IdTCPServer,ComCtrls, ZLibEx,IdGlobal, Menus,
   ExtCtrls,RemoteScrUnit,IdContext, Buttons, StdCtrls;

type
Tshowpm = class;

PCapCmd = ^TCapCmd;
TCapCmd = packed record
    Cmd:    Byte;
    Size:   Integer;
    Width: Word;
    Height: Word;
end;

PCtlCmd = ^TCtlCmd;
TCtlCmd = packed record
    Cmd: Byte;
    X, Y: Word;
end;

PMyData = ^TMyData;
TMyData = packed record
    Socket: TIdContext;
    Form:   Tshowpm;
    //Item:   TListItem;
    Color: Byte;
end;
PPMyData = ^PMyData;

Tshowpm = class(TForm)
    Panel1: TPanel;
    StopButton: TSpeedButton;
    StartButton: TSpeedButton;
    ShubiaoButton: TSpeedButton;
    jianpanButton: TSpeedButton;
    SpeedButton5: TSpeedButton;
    winButton: TSpeedButton;
    ShiftButton: TSpeedButton;
    ctrlButton: TSpeedButton;
    altButton: TSpeedButton;
    escButton: TSpeedButton;
    tabButton: TSpeedButton;
    sba: TScrollBox;
    pba: TPaintBox;
    tmrA: TTimer;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pbaMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbaMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pbaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    //procedure pbaPaint(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StartButtonClick(Sender: TObject);
    procedure tmrATimer(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure pbaPaint(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
protected
    procedure CreateParams(var Params: TCreateParams); override;
private
    FRecBmp, FFullBmp: TBitmap;
    FRecStream: TMemoryStream;
    FScrStream: TMemoryStream;
    FButton: TMouseButton;
    FCCmd: TCtlCmd;
    FRect: TRect;
    FControl: Boolean;
    speed,Thetime,color:integer;
    //FData: Tshowpm;
    procedure SetSize(nWidth, nHeight: Word);
    procedure SendCmd(ACmd: TCtlCmd);
    procedure SendCmdA(ACmd: TCtlCmd);
    procedure showimage;
   // procedure CheckMenu(var Msg: TMessage); message WM_SYSCOMMAND;
public
    FSocket : TIdContext;
    procedure ReadData;
    //property Data: Tshowpm read FData write FData;
end;

var
showpm: Tshowpm;
Num,speed,averageSpeed,tm:Integer;
totalrev :Int64;
implementation

uses Unit1;
{$R *.dfm}

{ Tshowpm }

function FormatSize (size : Int64 ):string; //将字节转换成易读的单位
begin
if Size < 1024 then
Result := Format('%dByte',[Size])
else if (Size >= 1024) and (Size < (1024*1024)) then
Result := Format('%.2fKB',[Size / 1024])
else if (Size >= (1024*1024)) and (Size < (1024*1024*1024))then
Result := Format('%.2fMB',[Size / (1024*1024)])
else
Result := Format('%.2fGB',[Size / (1024*1024*1024)]);
end;

procedure Tshowpm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WndParent := 0;
end;

procedure Tshowpm.SendCmd(ACmd: TCtlCmd);
var
sby:TidBytes;
begin
if Assigned(FSocket) and (FSocket.Connection.Connected) and CurrentThread.Connection.Connected then
begin
    sBy:=RawTOBytes(ACmd,SizeOf(TCtlCmd));
    form1.ZhuDongCmdSend('013', '0', True);
    CurrentThread.Connection.IOHandler.Write(sBy);
end;
end;

procedure Tshowpm.SendCmdA(ACmd: TCtlCmd);
var
sby:TidBytes;
begin
if Assigned(FSocket) and FSocket.Connection.Connected then
begin
    sBy:=RawTOBytes(ACmd,SizeOf(TCtlCmd));
    FSocket.Connection.IOHandler.Write(sBy);
end;
end;

procedure Tshowpm.SetSize(nWidth, nHeight: Word);
begin
if (pbA.Width <> nWidth) or (pbA.Height <> nHeight) then
begin
    sbA.HorzScrollBar.Position:=0;//增加
    sbA.VertScrollBar.Position:=0;//增加
    pbA.Left   := 0;
    pbA.Top    := 0;
    pbA.Width := nWidth;
    pbA.Height := nHeight;
    //ClientWidth := nWidth;
    //ClientHeight := nHeight;
    FFullBmp.Width := nWidth;
    FFullBmp.Height := nHeight;
end;
end;

procedure Tshowpm.FormCreate(Sender: TObject);
begin
inherited;
sba.DoubleBuffered := True;
//FSysMenu := GetSystemMenu(Handle, False);
//AppendMenu(FSysMenu, MF_SEPARATOR, IDM_SEP, nil);
//AppendMenu(FSysMenu, MF_STRING,    IDM_CTRL, IDM_CTRLS);
FControl   := False;
//FView      := nil;
FRecBmp    := TBitmap.Create;
FFullBmp   := TBitmap.Create;
FRecStream := TMemoryStream.Create;
FScrStream := TMemoryStream.Create;
end;

procedure Tshowpm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
tmrA.Enabled := False;
timer1.Enabled := false;
jianpanButton.Down:=False;
ShubiaoButton.Down:=False;
StopButton.Down:=True;
if fsocket<>nil then
    FSocket.Connection.Disconnect;
//Fdata :=nil;
FRecBmp.Free;
FFullBmp.Free;
FRecStream.Free;
FScrStream.Free;
FRecBmp    := nil;
FFullBmp   := nil;
FRecStream := nil;
FScrStream := nil;
Action := caFree;
end;
procedure Tshowpm.showimage;
begin
   { if (pba.Width<>FFullBmp.Width)
    or (pba.Height <> FFullBmp.Height) then
    begin
      pba.Top:=0;
      pba.Left:=0;
      pba.Width := FFullBmp.Width;
      pba.Height := FFullBmp.Height;
    end;
    pbA.Canvas.Lock;
    FFullBmp.Canvas.Lock;
    pba.Canvas.Draw(0, 0, FFullBmp);
    FFullBmp.Canvas.Unlock;
    pbA.Canvas.Unlock; }
      try
    pbA.Canvas.Lock;
    FFullBmp.Canvas.Lock;
    //BitBlt(pbA.Canvas.Handle, 0, 0, FFullBmp.Width, FFullBmp.Height, FFullBmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(pbA.Canvas.Handle,
           sbA.HorzScrollBar.Position,
           sbA.VertScrollBar.Position,
           sbA.Width,
           sbA.Height,
           FFullBmp.Canvas.Handle,
           sbA.HorzScrollBar.Position,
           sbA.VertScrollBar.Position,
           SRCCOPY);
    FFullBmp.Canvas.Unlock;
    pbA.Canvas.Unlock;
except
end;
end;
procedure Tshowpm.ReadData;
var
CmdBuf: array[0..SizeOf(TCapCmd) - 1] of Byte;
Buffer: array[0..4095] of Byte;
i: Integer;
buf:TidBytes;
begin
tmrA.Enabled := True;
//FRecStream := TMemoryStream.Create;
//FScrStream := TMemoryStream.Create;
while (Fsocket.Connection.Connected) do
begin
    try
      FSocket.Connection.IOHandler.ReadBytes(buf,sizeof(TCapCmd));
      BytesToRaw(buf,CmdBuf,sizeof(TCapCmd));
      buf:=0;
      if TCapCmd(CmdBuf).Cmd = 1 then SetSize(TCapCmd(CmdBuf).Width, TCapCmd(CmdBuf).Height)
      else if TCapCmd(CmdBuf).Cmd = 2 then
      begin
        FRecStream.Clear;
        Inc(Num );
        i:= TCapCmd(CmdBuf).Size;
        StatusBar1.Panels[0].Text := Format('正在接受第%d帧,大小%dByte',[Num,i]);
        //try
          FSocket.Connection.IOHandler.ReadStream(FRecStream,TCapCmd(CmdBuf).Size,False);
        //except
         { if (Fsocket.Connection.Connected= false) then
          begin
           FRecStream.Free;
           FScrStream.Free;
           exit;
          end; }
        //end;
        FRecStream.Position := 0;
        FScrStream.Clear;
        ZDecompressStream(FRecStream, FScrStream);
        FScrStream.Position := 0;
        //FRecBmp    := TBitmap.Create;
        try
          while FScrStream.Position < FScrStream.Size do
          begin
            FScrStream.Read(FRect, SizeOf(TRect));//不断的读出发生变化的区块
            with FRecBmp do
            begin
              Width := FRect.Right - FRect.Left;
              Height := FRect.Bottom - FRect.Top;
              LoadFromStream(FScrStream);
            end;
            FFullBmp.Canvas.Lock;
            FRecBmp.Canvas.Lock;
            FFullBmp.Canvas.Draw(FRect.Left, FRect.Top, FRecBmp); //把变化的区块填入
            FRecBmp.Canvas.Unlock;
            FFullBmp.Canvas.Unlock;
          end;
          Inc(totalrev,i);
          Inc(speed );
        finally
          //FRecBmp.Free;
          Application.ProcessMessages;       //连续抓屏
        end;
        //showimage;
        pbaPaint(nil)
      end;
    except
      Fsocket.Connection.Disconnect;
    end;
end;
//until (Fsocket.Connection.Connected= false);
//FRecStream.free;
//FScrStream.free;
tmrA.Enabled := false;
end;

procedure Tshowpm.pbaMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ShubiaoButton.Down =true then
begin
    FButton := Button;
    FCCmd.X := X;
    FCCmd.Y := Y;
    if FButton = mbLeft then
      FCCmd.Cmd := 3
    else
      FCCmd.Cmd := 5;
    SendCmd(FCCmd);
end;
end;

procedure Tshowpm.pbaMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ShubiaoButton.Down =true then
begin
    FCCmd.Cmd := 1;
    FCCmd.X := X;
    FCCmd.Y := Y;
    SendCmd(FCCmd);
end;
end;

procedure Tshowpm.pbaMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ShubiaoButton.Down =true then
begin
    FButton := Button;
    FCCmd.X := X;
    FCCmd.Y := Y;
    if FButton = mbLeft then
      FCCmd.Cmd := 2
    else
      FCCmd.Cmd := 4;
    SendCmd(FCCmd);
end;
end;

procedure Tshowpm.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if jianpanButton.Down =true then
begin
FCCmd.Cmd := 7;
FCCmd.X := Key;
SendCmd(FCCmd);
end;
end;

procedure Tshowpm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if jianpanButton.Down =true then
begin
FCCmd.Cmd := 6;
FCCmd.X := Key;
SendCmd(FCCmd);
end;
end;

procedure Tshowpm.StartButtonClick(Sender: TObject);
begin
form1.ZhuDongCmdSend('013', '0', True);
timer1.Enabled := true;
Num := 0;
averageSpeed :=0;
tm:=0;
totalrev := 0;
end;

procedure Tshowpm.tmrATimer(Sender: TObject);
begin
tmrA.Enabled := False;
FCCmd.Cmd := 8;
SendCmdA(FCCmd);
tmrA.Enabled := True;
end;

procedure Tshowpm.StopButtonClick(Sender: TObject);
begin
form1.ZhuDongCmdSend('004', '0', True);
if assigned( Fsocket) then
    fsocket.Connection.Disconnect;
tmrA.Enabled := false;
timer1.Enabled := false;
end;

{procedure Tshowpm.SpeedButton5Click(Sender: TObject);
begin
RemoteScrFm.ShowModal;
if RemoteScrFm.Tag =0 then exit;
case RemoteScrFm.RadioGroup2.ItemIndex of
    0: color := 1;
    1: color := 2;
    2: color := 3;
    3: color := 5;
    4: color := 7;
    else
      color := 3;
end;
FCCmd.Cmd := 0;
FCCmd.X := color;
SendCmdA(FCCmd);
end;}
//测试用
procedure Tshowpm.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[1].Text := Format('当前:%d帧/s',[speed ]);
Inc(averageSpeed,speed);
Inc(tm);
StatusBar1.Panels[2].Text := Format('平均:%d帧/s',[averageSpeed div tm]);
speed := 0;
StatusBar1.Panels[3].Text := Format('平均速度:%s/s',[FormatSize(totalrev div tm )]);
StatusBar1.Panels[4].Text := '总共传输数据量:'+FormatSize(totalrev);
end;

procedure Tshowpm.SpeedButton5Click(Sender: TObject);
begin
RemoteScrFm.ShowModal;
if RemoteScrFm.Tag =0 then exit;
case RemoteScrFm.RadioGroup2.ItemIndex of
    0: color := 1;
    1: color := 2;
    2: color := 3;
    3: color := 5;
    4: color := 7;
    else
      color := 3;
end;
FCCmd.Cmd := 0;
FCCmd.X := color;
SendCmdA(FCCmd);
end;

procedure Tshowpm.pbaPaint(Sender: TObject);
begin
try
    pbA.Canvas.Lock;
    FFullBmp.Canvas.Lock;
    //BitBlt(pbA.Canvas.Handle, 0, 0, FFullBmp.Width, FFullBmp.Height, FFullBmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(pbA.Canvas.Handle,
           sbA.HorzScrollBar.Position,
           sbA.VertScrollBar.Position,
           sbA.Width,
           sbA.Height,
           FFullBmp.Canvas.Handle,
           sbA.HorzScrollBar.Position,
           sbA.VertScrollBar.Position,
           SRCCOPY);
    FFullBmp.Canvas.Unlock;
    pbA.Canvas.Unlock;
except
end;
end;

procedure Tshowpm.Edit1Change(Sender: TObject);
begin
tmrA.Interval :=strtoint(edit1.text);
end;

end.