Delphi控件源码

开发平台：
Delphi

CopyScreenFrm.pas：源码内容
							unit CopyScreenFrm;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,Color,ChatingFrm, StdCtrls,JPeg,RealMessengerUnit,Global,
  AppEvnts;
type
  TScreenState = (msDefault,msDrag,msSelected);
  TCopyScreenForm = class(TForm)
    ImgScreen: TImage;
    PnlInfo: TPanel;
    LblRGB: TLabel;
    LblActionInfo: TLabel;
    LblCancelInfo: TLabel;
    ApplicationEvents1: TApplicationEvents;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PnlInfoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImgScreenMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImgScreenMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImgScreenMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure ImgScreenDblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    DX,DY,RectLeft,RectTop,RectBottom,RectRight:Integer;
    MouseIsDown,
    Trace:Boolean;
    ScreenState:TScreenState;
    procedure Cancel;
    procedure SendImg;
  public
    ParentForm:TChatingForm;
  end;
var
  CopyScreenForm: TCopyScreenForm;
implementation
{$R *.dfm}
procedure TCopyScreenForm.FormShow(Sender: TObject);
begin
    ScreenState:=msDefault;
    MouseIsDown:=False;
    Trace:=False;
    RectLeft:=-1;
    RectTop:=-1;
    RectBottom:=-1;
    RectRight:=-1;
    ImgScreen.Canvas.Pen.mode:=pmnot; //笔的模式为取反
    ImgScreen.canvas.pen.color:=clblack; //笔为黑色
    ImgScreen.canvas.pen.Width:=2;
    ImgScreen.canvas.brush.Style:=bsclear; //空白刷子end;
end;
procedure TCopyScreenForm.FormCreate(Sender: TObject);
begin
  Self.DoubleBuffered:=True;
end;
procedure TCopyScreenForm.Cancel;
begin
  if ScreenState=msDefault then
    Close
  else
  begin
    if Trace then ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
    Trace:=False;
    ScreenState:=msDefault;
    LblActionInfo.Caption:='按住鼠标左键不放选择截取范围';
    LblCancelInfo.Caption:='按鼠标右键退出';
    exit;
  end;
end;
procedure TCopyScreenForm.PnlInfoMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if PnlInfo.Left=8 then
    PnlInfo.Left:=Screen.Width-8-PnlInfo.Width
  else
    PnlInfo.Left:=8;
end;
procedure TCopyScreenForm.ImgScreenMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  R,G,B:Integer;
begin
  if (X>PnlInfo.Left) and (X<PnlInfo.Left+PnlInfo.Width) and (Y>PnlInfo.Top) and (Y<PnlInfo.Top+PnlInfo.Height) then
  begin
    PnlInfoMouseMove(Sender,Shift,X,Y);
  end;
  if (ScreenState=msSelected) then
  begin
    ImgScreen.Cursor:=crDefault;
    if (X>RectLeft) and (X<RectRight) and (Y>RectTop) and (Y<RectBottom) then
    begin
      ImgScreen.Cursor:=crSizeAll;
      if MouseIsDown then
      begin
        ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
        if (RectLeft+(X-DX)>=1) and (RectRight+(X-DX)<=Screen.Width) then
        begin
          RectLeft:=RectLeft+(X-DX);
          RectRight:=RectRight+(X-DX);
        end;
        if (RectTop+(Y-DY)>=1) and (RectBottom+(Y-DY)<=Screen.Height) then
        begin
          RectTop:=RectTop+(Y-DY);
          RectBottom:=RectBottom+(Y-DY);
        end;
        
        ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
        DX:=X;
        DY:=Y;
      end;
    end;
  end
  else
  begin
    ImgScreen.Cursor:=crCross;
  end;
  if (ScreenState=msDrag) and MouseIsDown then
  begin
    if Trace then ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
    RectRight:=X;
    RectBottom:=Y;
    ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
    Trace:=True;
  end;
  
  R:=getRvalue(ImgScreen.Canvas.Pixels[X, Y]);
  G:=getGvalue(ImgScreen.Canvas.Pixels[X, Y]);
  B:=getBvalue(ImgScreen.Canvas.Pixels[X, Y]);
  LblRGB.Caption:='当前像素RGB值（'+IntToStr(R)+'、'+IntToStr(G)+'、'+IntToStr(B)+'）';
end;
procedure TCopyScreenForm.ImgScreenMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbRight then
  begin
    Cancel;
    Exit;
  end;
  if (ScreenState=msSelected) and (ImgScreen.Cursor<>crDefault) then
  begin
    MouseIsDown:=True;
    DX:=X;
    DY:=Y;
  end;
  if ScreenState<>msDefault then exit;
  if Trace then ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
  MouseIsDown:=True;
  Trace:=False;
  ScreenState:=msDrag;
  RectLeft:=X;
  RectTop:=Y;
  RectRight:=X;
  RectBottom:=Y;
  LblActionInfo.Caption:='松开鼠标左键以确定最终截取范围';
  LblCancelInfo.Caption:='按鼠标右键取消当前选区';
end;
procedure TCopyScreenForm.ImgScreenMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    MouseIsDown:=False;
    if ScreenState=msDrag then
    begin
      LblActionInfo.Caption:='按空格/回车/双击左键发送当前选区的图像';
      LblCancelInfo.Caption:='按鼠标右键取消当前选区';
      ScreenState:=msSelected;
    end;
end;
procedure TCopyScreenForm.SendImg;
var
  newbitmap:TBitmap;
  newjpg:TJPegImage;
  TempInt:Integer;
  ScreenFileName:String;
  Receiver:Integer;
  ReceiverName:String;
begin
  if ScreenState=msSelected then
  begin
    if RectLeft>RectRight then
    begin
      TempInt:=RectLeft;
      RectLeft:=RectRight;
      RectRight:=TempInt;
    end;
    
    if RectTop>RectBottom then
    begin
      TempInt:=RectTop;
      RectTop:=RectBottom;
      RectBottom:=TempInt;
    end;
    //Dec(RectRight);
    //Dec(RectBottom);
    newbitmap:=Tbitmap.create;
    newbitmap.width:=RectRight-RectLeft;
    newbitmap.height:=RectBottom-RectTop;
    if Trace then ImgScreen.Canvas.Rectangle(RectLeft,RectTop,RectRight,RectBottom);
    newbitmap.Canvas.CopyRect(Rect(0, 0, newbitmap.width, newbitmap.height),ImgScreen.canvas,Rect (RectLeft, RectTop,RectRight,RectBottom)); //拷贝
    newjpg:=TJPegImage.Create;
    newjpg.Assign(newbitmap);
    newjpg.CompressionQuality:=90;
    newjpg.Compress;
    ScreenFileName:=ApplicationPath+'Screens'+IntToStr(Me.ID)+'SC'+IntToStr(GetTickCount)+'.JPG';
    if not DirectoryExists(ExtractFilePath(ScreenFileName)) then CreateDir(ExtractFilePath(ScreenFileName));
    newjpg.SaveToFile(ScreenFileName);
    newjpg.Free;
    newbitmap.free;
    Receiver    :=PEmployee(ParentForm.TVUserList.Items.GetFirstNode.Data).ID;
    ReceiverName:=PEmployee(ParentForm.TVUserList.Items.GetFirstNode.Data).Name;
    ScreenState:=msDefault;
    Close;
    TTransmitFile.Create(tfSend,Me.ID,Me.Name,Receiver,ReceiverName,ScreenFileName,ParentForm,'',0,'',0,0,'','',True);
  end;
end;
procedure TCopyScreenForm.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if Msg.wParam=27 then
  begin
    Cancel;
  end;
  if (Msg.wParam=32) or (Msg.wParam=13) then
  begin
    if ScreenState=msSelected then SendImg;
    Handled:=True;
  end;
end;
procedure TCopyScreenForm.ImgScreenDblClick(Sender: TObject);
begin
    if ScreenState=msSelected then SendImg;
end;
procedure TCopyScreenForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action:=caFree;
  ShowWindow(ParentForm.Handle,SW_SHOW);
  CopyScreenForm:=nil;
end;
end.

						