中国IT动力,最新最全的IT技术教程
最新100篇 | 推荐100篇 | 专题100篇 | 排行榜 | 搜索 | 在线API文档 | 网通镜像
首 页 | 程序开发 | 操作系统 | 软件应用 | 图形图象 | 网络应用 | 精文荟萃 | 教育认证 | 硬件维护 | 未整理篇 | 站长教程
ASP JS PHP工程 ASP.NET 网站建设 UML J2EESUN .NET VC VB VFP 网络维护 数据库 DB2 SQL2000 Oracle Mysql
服务器 Win2000 Office C DreamWeaver FireWorks Flash PhotoShop 上网宝典 CorelDraw 协议大全 网络安全 微软认证
硬件维护  CPU  主板  硬盘  内存  显卡  显示器  键盘鼠标  声卡音箱  打印机  机箱电源  BIOS  网卡  C#  Java  Delphi  vs.net2005
  当前位置:> 程序开发 > 编程语言 > Delphi > 临时文章
Delphi图象截取编程示例(4)
作者:LuckyJan 时间:2002-09-27 11:41 出处:互联网 责编:chinaitpower
              摘要:Delphi图象截取编程示例(4)

(六)TMainForm的 (抓图)Action 事件
1)全屏抓图
[Capture Desktop]  Action 事件
procedure TMainForm.cptDesktopExecute(Sender: TObject);
begin
  inc(CaptureNum,1);
  Application.Minimize ;  //窗体最小化
  Delay(500);             //最小化后延时,为了全屏抓图不把自身抓进图中
  FileName:='Capture'+IntToStr(CaptureNum)+'.bmp';
  FileName:=DefaultDirectory+FileName;
  CreateMDIChild(FileName,true);
  StatusBar.SimpleText := FileName;
  with ActiveMDIChild as TMDIChild do begin
    Image1.Picture.Bitmap := CaptureScreen;         //抓图
    HorzScrollBar.Range := Image1.Picture.Width;
    VertScrollBar.Range := Image1.Picture.Height;
  end;
  Child.Image1.Hint := 'Height:'+intToStr(child.Image1.Picture.Height)+'pixels'
                     + ' Width:'+intToStr(child.Image1.Picture.Width)+'pixels';
  application.Restore ;
end;

2)区域抓图
   抓取区域图片,即要用到一个新的Form1,参见《Delphi图象截取编程示例(6)》  .
   在Main单元implementation的uses中添加Capture1。
   在Main单元添加私有过程CaptureArea :

procedure TMainForm.CaptureArea;
begin
  with TForm1.Create(Application) do
  try
    if ShowModal=mrOK then
    with fRect do begin
      if (Right>Left)and(Bottom>Top) then begin
        Delay(400);
        ABitmap:=TBitmap.Create;
        ABitmap.Assign(CaptureScreenRect(fRect));
        Child.Image1.Picture.Bitmap:=ABitmap;
        Child.ClientWidth := Child.Image1.Picture.Width ;
        Child.ClientHeight:= Child.Image1.Picture.Height;
        Child.HorzScrollBar.Range:=Child.Image1.Picture.Width ;
        Child.VertScrollBar.Range:=Child.Image1.Picture.Height;
        ABitmap.Free ;
      end else begin
        MessageDlg('选择图片区域错误,请重新选择!',mtInformation,[mbOK],0);
        Child.Close ;
        Form1.Free ;
        exit;
      end;
    end;
  finally
    Free;
  end;
end;

[Capture Area]区域抓图的Action 事件
procedure TMainForm.cptAreaExecute(Sender: TObject);
begin
  Inc(CaptureNum,1);
  Application.Minimize ;
  Delay(500);
  FileName:='Capture'+IntToStr(CaptureNum)+'.bmp';
  FileName:=DefaultDirectory+FileName;
  { Create MDI Child Window }
  CreateMDIChild(FileName,true);
  StatusBar.SimpleText := FileName;

  { Capture Area of screen }
  CaptureArea;
  Child.Image1.Hint := 'Height:'+intToStr(child.Image1.Picture.Height)+'pixels'
                     + ' Width:'+intToStr(child.Image1.Picture.Width)+'pixels';
  application.Restore ;
end;

 


关闭本页
 
首页 | 投资与合作 | 服务条款 | 隐私政策 | 收藏本站 | 设为首页 | 新用户注册 | 免责声明 | 使用帮助
Copyright ©2005-2008 chinaitpower.com All rights reserved. www.chinaitpower.com 版权所有