知识大全一个实用的Delphi屏幕拷贝程序的设计

Posted 2022-07-14 知

篇首语：你不好好奋斗，拿什么显摆的自己的成功，对于背后的人看不起。本文由小常识网(cha138.com)小编为大家整理，主要介绍了知识大全一个实用的Delphi屏幕拷贝程序的设计相关的知识，希望对你有一定的参考价值。

一个实用的Delphi屏幕拷贝程序的设计 以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容，让我们赶快一起来看一下吧！

　　Borland 公司( 现改名为INPRISE 公司) 的DELPHI 是当前最为方便的Windows 程序设计工具之一许多人以为DELPHI 是作为数据库开发工具出现的其实用DELPHI可以以极快的速度开发出高效的Windows 程序

　　现在我们就用DELPHI 来编写一个实用的屏幕拷贝程序

　　Borland 公司的天才设计师们用画布(Tcanvas) 对象封装了Windows 的大部分图形输出功能这使得我们可以通过他以更直观的方式和Windows 的屏幕打交道而不必关心令人头疼的Windows API 函数下面的一小段程序就可以实现整个屏幕的图象拷贝了

　　var //变量声明

　　Fullscreen:Tbitmap;

　　FullscreenCanvas:TCanvas;

　　dc:HDC;

　　DC := GetDC ( ); //取得屏幕的 DC 参数指的是屏幕

　　FullscreenCanvas := TCanvas Create; //创建一个CANVAS对象

　　FullscreenCanvas Handle := DC; //将屏幕的DC赋给HANDLE

　　Fullscreen Canvas CopyRect (Rect ( screen Width screen Height)

　　fullscreenCanvas Rect ( Screen Width Screen Height));

　　//把整个屏幕复制到BITMAP中

　　FullscreenCanvas Free; //释放CANVAS对象

　　ReleaseDC ( DC); //释放DC

　　//SCREEN对象是DELPHI预先定义的屏幕对象直接使用就行了

　　看了以上代码你就会发现用DELPHI 写屏幕拷贝程序的确很简单当然要写一个实用的屏幕拷贝程序光靠上述代码是不够的下面讲一下主要的编程思路

　　全屏幕拷贝的实现

　　首先隐藏拷屏程序延长一定时间后利用上述的程序即可实现屏幕的拷贝

　　区域拷贝的实现

　　要实现区域拷贝要用个小技巧首先调用全屏幕拷贝程序把整个屏幕拷贝下来然后把拷贝下来的图象显示在屏幕上之后就可以让用户在上面选择需要的区域最后才将用户选定的区域复制下来

　　编程实现

　　首先用DELPHI 开一个工程

　　在FORM 上放置一个TPANEL 元件设置ALIGN=ALTOP 再选部件条ADDITIONAL 上的TSCROLLBOX 放到FORM 上设置ALIGN=ALCLIENT 然后在SCROLLBOX 上放置一个TIMAGE 对象

　　在PANEL 上放置个按钮分别为FULL SCREEN REGIN SAVE EXIT

　　容易干的先干在EXIT 按钮的CLICK 事件里写下代码

　　procedure TForm ExitClick(Sender: TObject);

　　begin

　　close;

　　end;

　　接著是实现全屏幕拷贝了在FROM 上放置一个记时器TTIMER ENABLED 设为FALSE INTERVAL 设为也就是半秒钟激活一次双击TIMER 部件写上如下的代码

　　procedure TForm Timer Timer(Sender: TObject);

　　var

　　Fullscreen:Tbitmap;

　　FullscreenCanvas:TCanvas;

　　dc:HDC;

　　begin

　　timer Enabled:=false; //取消时钟

　　Fullscreen := TBitmap Create; //创建一个BITMAP来存放图象

　　Fullscreen Width := screen width;

　　Fullscreen Height := screen Height;

　　DC := GetDC ( ); //取得屏幕的 DC 参数指的是屏幕

　　FullscreenCanvas := TCanvas Create; //创建一个CANVAS对象

　　FullscreenCanvas Handle := DC;

　　Fullscreen Canvas CopyRect (Rect ( screen Width screen Height) fullscreenCanvas Rect ( Screen Width Screen Height));

　　//把整个屏幕复制到BITMAP中

　　FullscreenCanvas Free; //释放CANVAS对象

　　ReleaseDC ( DC); //释放DC

　　image picture Bitmap:=fullscreen;//拷贝下的图象赋给IMAGE对象

　　image Width:=fullscreen Width;

　　image Height:=fullscreen Height;

　　fullscreen free; //释放bitmap

　　form WindowState:=wsNormal; //复原窗口状态

　　form show; //显示窗口

　　messagebeep( ); //BEEP叫一声报告图象已经截取好了

　　end;

　　接下去FULLSCREEN 按钮上的代码就很简单了

　　procedure TForm FullscreenClick(Sender: TObject);

　　begin

　　form WindowState:=wsMinimized; //最小化程序窗口

　　form hide; //把程序藏起来

　　timer enabled:=true; //打开记时器

　　end;

　　拷贝到了图象当然要存起来了 SAVE 按钮就有了用武之地我们写下如下代码

　　procedure TForm Save Click(Sender: TObject);

　　begin

　　if savedialog Execute then

　　begin

　　form Image Picture SaveToFile(savedialog filename)

　　end;

　　下面是区域拷贝的实现再New 一个FORM BorderStype 设为 bsNone 这样能够显示为全屏幕上面放置一个TIMAGE 部件 ALIGN 设为ALCLIENT 另外放置一个TTIMER部件 TIMER 部件的程序跟上面的很象因为它首先要实现的是全屏幕的拷贝

　　procedure TForm Timer Timer(Sender: TObject);

　　var

　　Fullscreen:Tbitmap;

　　FullscreenCanvas:TCanvas;

　　dc:HDC;

　　begin

　　timer Enabled:=false;

　　Fullscreen := TBitmap Create;

　　Fullscreen Width := screen width;

　　Fullscreen Height := screen Height;

　　DC := GetDC ( );

　　FullscreenCanvas := TCanvas Create;

　　FullscreenCanvas Handle := DC;

　　Fullscreen Canvas CopyRect (Rect ( screen Width screen Height) fullscreenCanvas Rect ( Screen Width Screen Height));

　　FullscreenCanvas Free;

　　ReleaseDC ( DC);

　　image picture Bitmap:=fullscreen;

　　image Width:=fullscreen Width;

　　image Height:=fullscreen Height;

　　fullscreen free;

　　form WindowState:=wsMaximized;

　　form show;

　　messagebeep( );

　　foldx:= ;

　　foldy:= ;

　　image Canvas Pen mode:=pmnot; //笔的模式为取反

　　image canvas pen color:=clblack; //笔为黑色

　　image canvas brush Style:=bsclear; //空白刷子

　　flag:=true;

　　end;

　　 TIMAGE 部件上有两个事件的程序需要编写一个是ONMOUSEDOWN 另一个是ONMOUSEMOVE

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

　　所以MOUSEDOWN 有两次响应的处理见以下程序

　　procedure TForm Image MouseDown

　　(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 image canvas do

　　begin

　　moveTo(foldx );

　　LineTo(foldx screen height);

　　moveto( foldy);

　　lineto(screen width foldy);

　　end;

　　x :=x;

　　y :=y;

　　oldx:=x;

　　oldy:=y;

　　trace:=true;

　　image Canvas Pen mode:=pmnot; //笔的模式为取反

　　//这样再在原处画一遍矩形相当于擦除矩形

　　image canvas pen color:=clblack; //笔为黑色

　　image canvas brush Style:=bsclear;//空白刷子

　　end

　　else

　　begin //第二次点击表示已经得到矩形了

　　//把它拷贝到FORM 中的IMAGE部件上

　　x :=x;

　　y :=y;

　　trace:=false;

　　image canvas rectangle(x y oldx oldy);

　　width:=abs(x x );

　　height:=abs(y y );

　　form image Width:=Width;

　　form image Height:=Height;

　　newbitmap:=Tbitmap create;

　　newbitmap width:=width;

　　newbitmap height:=height;

　　newbitmap Canvas CopyRect

　　(Rect ( width Height) form image canvas

　　Rect (x y x y )); //拷贝

　　form image picture bitmap:=newbitmap; //放到FORM的IMAGE上

　　newbitmap free;

　　form hide;

　　form show;

　　end;

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

　　procedure TForm Image MouseMove

　　(Sender: TObject; Shift: TShiftState; X

　　Y: Integer);

　　begin

　　if trace=true then //是否在追踪鼠标?

　　begin //是擦除旧的矩形并画上新的矩形

　　with image canvas do

　　begin

　　rectangle(x y oldx oldy);

　　Rectangle(x y x y);

　　oldx:=x;

　　oldy:=y;

　　end;

　　end

　　else if flag=true then //在鼠标所在的位置上画十字

　　begin

　　with image canvas do

　　begin

　　moveTo(foldx ); //擦除旧的十字

　　LineTo(foldx screen height);

　　moveto( foldy);

　　lineto(screen width foldy);

　　moveTo(x ); //画上新的十字

　　LineTo(x screen height);

　　moveto( y);

　　lineto(screen width y);

　　foldx:=x;

　　foldy:=y;

　　end;

　　好了让我们回过头来编写REGION 按钮的代码

　　procedure TForm RegionClick(Sender: TObject);

　　begin

　　form Hide;

　　form hide;

　　form Timer Enabled:=true;

　　end;

cha138/Article/program/Delphi/201311/8540

知识大全 一个实用的Delphi屏幕拷贝程序的设计

知识大全一个实用的Delphi屏幕拷贝程序的设计