在屏幕上涂鸦！(200分)

microsoft的powerpoint幻灯片演示中有一个功能，就是在屏幕上用鼠标写字画图，但是使用太麻烦，要点几次右键菜单，我想在程序中实现，在屏幕上涂鸦，特点是：程序启动后在任务栏以小图标显示，用时以热键呼出(像万能五笔一样)，在屏幕上涂鸦，画笔可选颜色（热键），用热键还原屏幕。
可能比较复杂，还望高手指点一二。

var
dc:hDc;
begin
dc:=getdc(0);
//得到的是桌面dc,你可以在dc上面涂鸦了，最好再装个鼠标钩子
ReleaseDC (0,dc);

鼠标钩子是什么?
ReleaseDC (0,dc);是什么意思?

ypy你的程序，似乎没有什么用呀！

没用，呵呵，不会用？procedure TForm1.Button1Click(Sender: TObject);
试试

var mydc:HDC;
Acanvas:TCanvas;
begin
mydc:=getdc(0);
Acanvas:=TCanvas.Create;
Acanvas.Handle:=mydc;
Acanvas.FillRect(Rect(10,10,100,100));
Acanvas.Free;
ReleaseDC(0,mydc);
end;

以上程序没问题，但不是涂鸦！所谓涂鸦我认为是用鼠标在屏幕上乱画！
在FORM的MOUSEMOVE时间中写鼠标拖动程序，首先确定起点！然后LINETO函数
画线！线的粗细可调，是画布的CANVA.PEN.WIDTH=xx;

注意在此之前一定要获得屏幕的设备句柄，也就是其设备描述表！
用getDc(0)可以获得其句柄！具体见以上两位的帖子！
注：可以不给我分！

用手写板如何？

呵呵

在用热键呼出后，生成一满屏窗口，把当屏幕内容拷贝上去。

此时任你在自己的窗口内为所欲为。

再用热键取消时，只要销毁该窗口即可。

至于涂鸦的具体编制方法，应该简单吧。

只是个思路，具体实现还复杂，可惜我没有时间给你做个例子。
鼠标钩子可以捕获鼠标消息，以便在屏幕上随便画。
GetDC,ReleaseDC 等函数的具体用法参见MSDN.

你要做“玩具的报复”吗?

简单例子，应能满足要求；
程序一激活就可涂鸦，按 Esc 就恢复屏幕, 按 C 改画笔色彩， 按 + /- 改线宽
按 Q 结束程序。
至于托盘图标，自己解决吧。


unit ScreenModi;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, AppEvnts,math;

type
TForm1 = class(TForm) // borderStyle设置为bsNone;
Image1: TImage; //Align 设置为Alclient;
ApplicationEvents1: TApplicationEvents;
ColorDialog1: TColorDialog;
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Activate(Sender: TObject);
procedure ApplicationEvents1Deactivate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private

public

end;

var
Form1: TForm1;
ISDown:Boolean;
CurrentColor:TColor;
CurrentWidth:Integer;


implementation

{$R *.DFM}

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin

IF Key=Chr(27) then //Esc 隐藏
Begin
width:=0;
height:=0;
End;

IF Uppercase(Key)='Q' then // Q 键退出
Close;

IF Uppercase(Key)='C' then // C 键改色
IF ColorDialog1.Execute then
CurrentColor:=ColorDialog1.Color;

IF (Key='+') or (Key='=') //加减 笔宽
then
Inc(CurrentWidth);

IF (Key='-') or (Key='_')
then
Dec(CurrentWidth);

CurrentWidth:=Max(1,CurrentWidth);

End;

procedure TForm1.FormCreate(Sender: TObject);
begin
left:=0; top:=0; width:=0; height:=0;
CurrentColor:=Clred;
CurrentWidth:=3;
End;

procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
Var Adc:HDC;
ACanvas:Tcanvas;
X:Tbitmap;
begin //抓屏幕到Image
X:=Tbitmap.Create;
X.width:=Screen.Width;
X.height:=Screen.height;

ADC:=getDC(0);
Acanvas:=TCanvas.Create;
Acanvas.Handle:=Adc;
X.Canvas.CopyRect(X.canvas.Cliprect,Acanvas,X.canvas.Cliprect);

width:=Screen.Width;
height:=Screen.Height;

Image1.Picture.Bitmap.assign(X);
Image1.refresh;
X.Free;
Acanvas.Free;
End;

procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
left:=0;
top:=0;
width:=0;
height:=0;
ISDOwn:=False;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

Begin
ISDown:=True; //开始手工绘制
With Image1.Picture.Bitmap.Canvas do
Begin
Pen.width:=CurrentWidth;
Pen.Color:=CurrentColor;
Moveto(X,Y);
Lineto(X,Y);
End;
End;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
IF ISdown then Image1.Picture.Bitmap.Canvas.Lineto(X,Y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ISDOwn:=False;
end;

End.

GetDC没用的. 要想在Desktop上涂鸦, 必须使用
CreateDC('DISPLAY', nil, nil, nil)建立一个指向屏幕的DC, 然后才能在上面画. 要删除
建立的DC, 用DeleteDC

Another_eYes:

请试一下，就能明白

同意 -->>GGCAT

没人了？
我可是热心专门定做的Demo ,调试通过后才贴出来的。难到还不满意？

去下载一个空间得了

多人接受答案了。

use AppEvnts 没有AppEvnts.DCU
没有TApplicationEvents??