bmp图像复制，剪切，粘贴等

实现了复制，剪切，粘贴等

 

uses

   Clipbrd;

 

private
       { Private declarations }
       StartX,StartY,EndX,EndY:Integer;
       MouseDown:Boolean;
       procedure DrawFrame;
       procedure DrawClipFrame;
       procedure RestoreImage;
       procedure CopyCmdClick(Sender: TObject);
       procedure CutCmdClick(Sender: TObject);
       procedure PasteCmdClick(Sender: TObject);
       procedure WMEraseBkGnd(var Msg:TWMEraseBkGnd); message WM_ERASEBKGND;

 

implementation

 

//procedure TForm1.WMEraseBkGnd(var Msg:TWMEraseBkGnd);
//begin
//   Msg.Result:=0;
//end;

procedure TForm1.CopyCmdClick(Sender: TObject);
var
   Bmp:TBitmap;
begin     //复制图片
   Bmp:=TBitmap.Create;
   try
       DrawClipFrame;
       Bmp.Width:=ClipImg.Width;
       Bmp.Height:=ClipImg.Height;
       Bmp.Canvas.Draw(0,0,ClipImg.Picture.Bitmap);
       ClipBoard.Assign(Bmp);
       DrawClipFrame;
   finally
       Bmp.Free;
   end;
end;

procedure TForm1.CutCmdClick(Sender: TObject);
begin   //剪切图片
   CopyCmdClick(Sender);
   ClipImg.Visible:=False;
end;

procedure TForm1.PasteCmdClick(Sender: TObject);
var
   Bmp:TBitmap;
begin   //粘贴图片
   if ClipBoard.HasFormat(CF_BITMAP) then begin
       if ClipImg.Visible then RestoreImage;
       Bmp:=TBitmap.Create;
       try
           Bmp.Assign(ClipBoard);
           with ClipImg do begin
               Width:=Bmp.Width;
               Height:=Bmp.Height;
               Canvas.Draw(0,0,Bmp);
               Visible:=True;
               Left:=0;
               Top:=0;
           end;
           DrawClipFrame;
       finally
           Bmp.Free;
       end;             
   end;
end;

procedure TForm1.DrawFrame;
begin   //在Image上画一个选择框
   with Image.Canvas do
   begin
       Brush.Style:=bsClear;
       Pen.Color:=clAqua;
       Pen.Mode:=pmXor;
       Rectangle(StartX,StartY,EndX,EndY);
   end;
end;

procedure TForm1.DrawClipFrame;
begin   //在ClipImg上画一个选择框
   with ClipImg,Canvas do
   begin
       Brush.Style:=bsClear;
       Pen.Color:=clAqua;
       Pen.Mode:=pmXor;
       Rectangle(ClientRect);
   end;
end;

procedure TForm1.RestoreImage;
begin     //恢复图像
   DrawClipFrame;
   with ClipImg do
       Image.Canvas.CopyRect(
               Rect(Left,Top,Left+Width,Top+Height),
               ClipImg.Canvas,
               Rect(0,0,Width,Height));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
   Pos: TPoint;
   Handle: HWND;
   ScreenDC: HDC;
   Buf: array[0..1024] of Char;
   ScreenColor: COLORREF;
begin
   GetCursorPos(Pos); // 得到当前光标位置
   Label7.Caption := 'y:'+inttostr(Pos.X)+'   y:'+inttostr(Pos.Y);
   Handle := WindowFromPoint(Pos); // 返回当前位置的句柄
   HandleText.Caption := IntToStr(Handle);
   GetClassName(Handle, Buf, 1024); // 得到类名
   ClassNameText.Caption := Buf;
   SendMessage(Handle, WM_GETTEXT, 33, Integer(@Buf)); // 得到标题
   TitleText.Caption := Buf;
   {得到光标处点的颜色}
   ScreenDC := GetDC(0);
   ScreenColor := GetPixel(ScreenDC, Pos.X, Pos.Y);
   Shape.Brush.Color := TColor(ScreenColor);
   RGBColorText.Caption := '红: ' + IntToStr(GetRValue(ScreenColor)) +
   '   绿: ' + IntToStr(GetGValue(ScreenColor)) + '   蓝: ' +
   IntToStr(GetBValue(ScreenColor));
   ReleaseDC(0, ScreenDC);
   DelphiColorText.Caption := Format('Delphi中颜色值：$00%2.2x%2.2x%2.2x', [GetBValue(ScreenColor),
   GetGValue(ScreenColor), GetRValue(ScreenColor)]);
   HTMLColorText.Caption := Format('HTML颜色值：#%2.2x%2.2x%2.2x', [GetRValue(ScreenColor),
   GetGValue(ScreenColor), GetBValue(ScreenColor)]);
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   if not MouseDown then begin
   if ClipImg.Visible then RestoreImage;
   MouseDown:=True;
   StartX:=X;
   StartY:=Y;
   EndX:=X;
   EndY:=Y;
   DrawFrame;
end;
end;

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
begin
   if MouseDown then begin
       DrawFrame;
       EndX:=X;
       EndY:=Y;
       DrawFrame;
   end;
end;

procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   if MouseDown then
   begin
       MouseDown:=False;
       if (StartX=EndX) and (StartY=EndY) then
       begin
           DrawFrame;
           ClipImg.Visible:=False;
       end else
       begin
           with ClipImg,Canvas do
           begin
               Width:=EndX-StartX;
               Height:=EndY-StartY;
               CopyRect(Rect(0,0,Width,Height),
                                 Image.Canvas,
                                 Rect(StartX,StartY,EndX,EndY));
               Visible:=True;
               Left:=StartX;
               Top:=StartY;
           end;
           with Image.Canvas do
           begin
               Brush.Color:=clWhite;
               Brush.Style:=bsSolid;
               FillRect(Rect(StartX,StartY,EndX,EndY));
           end;
       end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
   Bmp:TBitmap;
begin
   ClipImg.Visible:=False;
   {with Image,Canvas do
   begin
       Brush.Color:=clWhite;
       FillRect(ClientRect);
   end;   }
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   Bmp:TBitmap;
begin
   Bmp:=TBitmap.Create;
   try
       DrawClipFrame;
       Bmp.Width:=ClipImg.Width;
       Bmp.Height:=ClipImg.Height;
       Bmp.Canvas.Draw(0,0,ClipImg.Picture.Bitmap);
       ClipBoard.Assign(Bmp);
       DrawClipFrame;
   finally
       Bmp.Free;
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   CopyCmdClick(Sender);
   ClipImg.Visible:=False;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
   Bmp:TBitmap;
begin
   if ClipBoard.HasFormat(CF_BITMAP) then
   begin
       if ClipImg.Visible then RestoreImage;
       Bmp:=TBitmap.Create;
       try
           Bmp.Assign(ClipBoard);
           with ClipImg do
           begin
               Width:=Bmp.Width;
               Height:=Bmp.Height;
               Canvas.Draw(412,192,Bmp);
               Visible:=True;
               Left:=412;
               Top:=192;
           end;
           DrawClipFrame;
       finally
           Bmp.Free;
       end;             
   end;
end;

procedure TForm1.ClipImgMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   if not MouseDown then
   begin
       MouseDown:=True;
       StartX:=X;
       StartY:=Y;
   end;
end;

procedure TForm1.ClipImgMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
begin
   if MouseDown then begin
       ClipImg.Left:=ClipImg.Left+X-StartX;
       ClipImg.Top:=ClipImg.Top+Y-StartY;
   end;
end;

procedure TForm1.ClipImgMouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   if MouseDown then MouseDown:=False;
end;

procedure TForm1.Button4Click(Sender: TObject);
var FName                     : string;
       Bmp                         : TBitmap;
begin
   ClipBoard.Clear ;
   OpenPictureDialog1.Title := '请选择相应的照片文件';
   if OpenPictureDialog1.Execute then
       FName := OpenPictureDialog1.FileName;

   try
       Bmp := TBitmap.Create;
       Bmp.LoadFromFile(FName);
       Image.Picture.Bitmap := Bmp;
   except
       showMessage('请选择正确的jpg图片！');
   end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Clipbrd, ExtDlgs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp:TBitmap;
begin
  Bmp:=TBitmap.Create;
  try
    //DrawClipFrame;
    Bmp.Width:=Image1.Width;
    Bmp.Height:=Image1.Height;
    Bmp.Canvas.Draw(0,0,Image1.Picture.Bitmap);
    ClipBoard.Assign(Bmp);
    //DrawClipFrame;
  finally
    Bmp.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

end.