100分在线等待：拷屏老不成功，请大侠 指点

Question

procedure tform1.WMhotkey(var Message: TWMhotkey);
var
arect,brect:trect;
abmp:tbitmap;
fulls:tcanvas;
begin
abmp:=tbitmap.Create;
arect.top:=0;
   arect.Left:=0 ;
   arect.Right:=screen.Width;
   arect.Bottom:=screen.Height;
   fulls:=tcanvas.Create;
    fulls.Handle:=getdc(0);    
    abmp.canvas.CopyRect(arect,fulls,arect);
    image1.Picture.Bitmap:=abmp;
    abmp.free;
    releasedc(form1.handle,fulls.Handle);
    application.Restore;
    form1.Show;
end;

Answer 1

给你个例子看看,,,,
  var     //变量声明
  Fullscreen:Tbitmap;  
  FullscreenCanvas:TCanvas;
  dc:HDC;
  //------------------------------------------------------------
  DC := GetDC (0);      //取得屏幕的 DC,参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create;    //创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;        //将屏幕的DC赋给HANDLE
  Fullscreen.Canvas.CopyRect 
  (Rect (0, 0, screen.Width,screen.Height),
  fullscreenCanvas,
  Rect (0, 0, Screen.Width, Screen.Height));
                            //把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free;          //释放CANVAS对象
  ReleaseDC (0, DC);              //释放DC
  //SCREEN对象是DELPHI预先定义的屏幕对象,直接使用就行了。 
---- 看了以上代码,你就会发现用DELPHI 写屏幕拷贝程序的确很简单。 ---- 当然要写一个实用的屏幕拷贝程序,光靠上述代码是不够的,下面讲一
下主要的编程思路: ---- 1. 全屏幕拷贝的实现 ---- 首先隐藏拷屏程序,延长一定时间后,利用上述的程序即可实现屏幕的
拷贝。 ---- 2. 区域拷贝的实现 ---- 要实现区域拷贝要用个小技巧,首先调用全屏幕拷贝程序把整个屏幕拷
贝下来,然后把拷贝下来的图象显示在屏幕上,之后就可以让用户在上面
选择需要的区域,最后才将用户选定的区域复制下来。 ---- 编程实现: ---- 1. 首先用DELPHI3 开一个工程。 ---- 2. 在FORM 上放置一个TPANEL 元件,设置ALIGN=ALTOP,再选部件条ADDITIONAL 上
的TSCROLLBOX,放到FORM 上,设置ALIGN=ALCLIENT,然后在SCROLLBOX 上放置一个
TIMAGE 对象。 ---- 3. 在PANEL 上放置4 个按钮,分别为FULL SCREEN,REGIN,SAVE,EXIT。 ---- 4. 容易干的先干,在EXIT 按钮的CLICK 事件里写下代码 procedure TForm1.ExitClick(Sender: TObject);
begin
    close;
end;
---- 5. 接着是实现全屏幕拷贝了,在FROM 上放置一个记时器TTIMER,ENABLED 设为
FALSE,INTERVAL 设为500,也就是半秒钟激活一次。双击TIMER 部件,写上如下的
代码。 procedure TForm1.Timer1Timer(Sender: TObject);
var
 Fullscreen:Tbitmap;
 FullscreenCanvas:TCanvas;
 dc:HDC;
begin
    timer1.Enabled:=false;   //取消时钟
    Fullscreen := TBitmap.Create;      //创建一个BITMAP来存放图象
    Fullscreen.Width := screen.width;
    Fullscreen.Height := screen.Height;
    DC := GetDC (0);   //取得屏幕的 DC,参数0指的是屏幕
    FullscreenCanvas := TCanvas.Create; //创建一个CANVAS对象
    FullscreenCanvas.Handle := DC;Fullscreen.Canvas.CopyRect 
(Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
            //把整个屏幕复制到BITMAP中
    FullscreenCanvas.Free;          //释放CANVAS对象
    ReleaseDC (0, DC);              //释放DC
    //*******************************
    image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象
    image1.Width:=fullscreen.Width;
    image1.Height:=fullscreen.Height;
    fullscreen.free;                //释放bitmap
    form1.WindowState:=wsNormal;    //复原窗口状态
    form1.show;                     //显示窗口
    messagebeep(1);  //BEEP叫一声,报告图象已经截取好了。
end;
---- 6. 接下去FULLSCREEN 按钮上的代码就很简单了。 procedure TForm1.FullscreenClick(Sender: TObject);
begin
    form1.WindowState:=wsMinimized; //最小化程序窗口
    form1.hide;                     //把程序藏起来
    timer1.enabled:=true;           //打开记时器
end;
---- 7. 拷贝到了图象当然要存起来了,SAVE 按钮就有了用武之地,我们写下如
下代码。 procedure TForm1.Save1Click(Sender: TObject);
begin
  if savedialog1.Execute then
    begin
     form1.Image1.Picture.SaveToFile(savedialog1.filename)
    end;
end;
---- 8. 下面是区域拷贝的实现。再New 一个FORM,BorderStype 设为 bsNone, 这样能够显示
为全屏幕,上面放置一个TIMAGE 部件,ALIGN 设为ALCLIENT,另外放置一个TTIMER
部件,TIMER 部件的程序跟上面的很象,因为它首先要实现的是全屏幕的拷
贝。 procedure TForm2.Timer1Timer(Sender: TObject);
var
 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);
        lineto(screen.width,y);
        foldx:=x;
        foldy:=y;
        end;
      end;
end;---- 13. 好了,让我们回过头来编写REGION 按钮的代码。 procedure TForm1.RegionClick(Sender: TObject);
begin
 form1.Hide;
 form2.hide;
 form2.Timer1.Enabled:=true;
end;

Answer 2

兄弟，我用你方法试了一下
由于没有fullsreen:=tbitmap.create,产生了运行时错误