一个实用的Delphi屏幕拷贝程序的设计[2]

fullscreen:tbitmap;
fullscreencanvas:tcanvas;
dc:hdc;
begin
    timer1.enabled:=false;
    fullscreen := tbitmap.create;   
    fullscreen.width := screen.width;
    fullscreen.height := screen.height;
    dc := getdc (0); 
    fullscreencanvas := tcanvas.create;
    fullscreencanvas.handle := dc;
fullscreen.canvas.copyrect (rect
(0, 0, screen.width, screen.height), fullscreencanvas,
    rect (0, 0, screen.width, screen.height));
    fullscreencanvas.free;       
    releasedc (0, dc);
    image1.picture.bitmap:=fullscreen;
    image1.width:=fullscreen.width;
    image1.height:=fullscreen.height;
    fullscreen.free;               
    form2.windowstate:=wsmaximized;
    form2.show;

    messagebeep(1);
    foldx:=-1;
    foldy:=-1;
    image1.canvas.pen.mode:=pmnot; //笔的模式为取反
    image1.canvas.pen.color:=clblack; //笔为黑色
    image1.canvas.brush.style:=bsclear; //空白刷子
    flag:=true;
end;
9.timage 部 件 上 有 两 个 事 件 的 程 序 需 要 编 写， 一 个 是onmousedown， 另 一 个
是onmousemove。

10. 可 以 回 头 看 看 区 域 拷 贝 的 思 路， 此 时 需 要 作 区 域 拷 贝 的 屏 幕 我 们 已 经
得 到， 也 显 示 在 屏 幕 上 了， 按 下 鼠 标 左 键 是 区 域 的 原 点， 此 后 移 动 鼠 标， 将
有 一 个 矩 形 在 原 点 和 鼠 标 之 间， 它 会 随 着 鼠 标 的 移 动 而 变 化， 再 次 按 下 鼠
标 的 左 键， 此 时 矩 形 所 包 含 的 区 域 就 是 我 们 要 得 到 的 图 象 了。

11. 所 以mousedown 有 两 次 响 应 的 处 理， 见 以 下 程 序。

procedure tform2.image1mousedown
(sender: tobject; button: tmousebutton;
  shift: tshiftstate; x, y: integer);
var
width,height:integer;
newbitmap:tbitmap;
begin
  if (trace=false) then  // trace表示是否在追踪鼠标
  begin      //首次点击鼠标左键，开始追踪鼠标。
      flag:=false;
  with image1.canvas do
      begin             
        moveto(foldx,0);
        lineto(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
      end;
  x1:=x;           
  y1:=y;
  oldx:=x;
  oldy:=y;
  trace:=true;
  image1.canvas.pen.mode:=pmnot;    //笔的模式为取反
        //这样再在原处画一遍矩形，相当于擦除矩形。
  image1.canvas.pen.color:=clblack;  //笔为黑色
  image1.canvas.brush.style:=bsclear;//空白刷子
  end
  else           
  begin      //第二次点击，表示已经得到矩形了，
              //把它拷贝到form1中的image部件上。
    x2:=x;
    y2:=y;
    trace:=false;
    image1.canvas.rectangle(x1,y1,oldx,oldy);
    width:=abs(x2-x1);
    height:=abs(y2-y1);
    form1.image1.width:=width;
    form1.image1.height:=height;

    newbitmap:=tbitmap.create; 
    newbitmap.width:=width;
    newbitmap.height:=height;
newbitmap.canvas.copyrect
(rect (0, 0, width, height),form2.image1.canvas,
    rect (x1, y1,x2,y2)); //拷贝
    form1.image1.picture.bitmap:=newbitmap; //放到form的image上
    newbitmap.free;   
    form2.hide;
    form1.show;
  end;
end;

12.mousemove 的 处 理 就 是 在 原 点 和 鼠 标 当 前 位 置 之 间 不 断 地 画 矩 形 和 擦
除 矩 形。

procedure tform2.image1mousemove
(sender: tobject; shift: tshiftstate; x,
  y: integer);
begin
if trace=true then  //是否在追踪鼠标？
    begin            //是，擦除旧的矩形并画上新的矩形
    with image1.canvas do
      begin
      rectangle(x1,y1,oldx,oldy);
      rectangle(x1,y1,x,y);
      oldx:=x;
      oldy:=y;
      end;
    end
  else if flag=true then  //在鼠标所在的位置上画十字
      begin
      with image1.canvas do
        begin
        moveto(foldx,0);          //擦除旧的十字
        lineto(foldx,screen.height);
        moveto(0,foldy);
        lineto(screen.width,foldy);
        moveto(x,0);              //画上新的十字
        lineto(x,screen.height);
        moveto(0,y);