用Delphi编写屏幕取色程序
软件世界
相信大家也见过不少的屏幕取色的软件吧！《电脑报》也介绍过用VB来编写的取色程序，但喜欢Delphi的朋友，有没有试过用Delphi写一个呢？好，那就开始吧。
新建一工程，在窗体中加入以下控件(见（图1）)：
label1 name='label1' caption='拾取'
label2 name='label2' caption='当前颜色'
label3 name='colorlab' caption='颜色值'
label4 name='rlab' caption='红色'
label5 name='glab' caption='绿色'
label6 name='blab' caption='蓝色'
timer1 name='timer1' enabled='false' interval='100'
edit1 name='edit1' text='#'
shape1 name='shape1'
控件加入完后，便开始进行分析。首先，要想获取屏幕上任意一点的颜色，先要获得鼠标所在位置的坐标，然后再获取这个坐标的颜色值。这里用三个API函数来完成所需操作：GetDC(获取窗体场景句柄)；GetCursorpos(获取当前鼠标坐标)；GetPixel(当前颜色值)。接下来就是当鼠标移动到了你所需的颜色点上时的确定操作，这里，我们设置一个全局热键来进行选定处理。程序主要代码段如下：
private
ztpoint;
hotkeyidinteger;
procedure WMhotkeyhandle (var msg:Tmessage);
message wm_hotkey; //响应热键按键消息
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Wmhotkeyhandle (var msg:Tmessage);
begin
if (msg.LParamHi=$41) and (msg.lparamLo=mod_Alt) then
begin //我们将全局热键定义为'Alt+A'
msg.Result:=1; //该消息已经处理
application.BringToFront; //当热键响应后将窗口放在最前面
unregisterhotkey(handle,hotkeyid);
DeleteAtom(HotKeyID);
timer1.Enabled:=false; //按下热键后暂停鼠标取色模式
label1.Visible:=true; //显示提示信息
end;
end;
procedure TForm1.Timer1Timer (Sender: TObject);
var
co,r,g,b,integer;
cor:array [0..3] of string;
begin
hotkeyid:=GlobalAddAtom(pchar('UserDefineHotKey'))-$C000;
//减去$C000是为了保证取值范围的限制
registerhotkey(handle,hotkeyid,mod_Alt,$41);
getcursorpos(z); //取得鼠标坐标
co:=getpixel(getdc(0),z.x,z.y); //取得鼠标所在位置颜色值
form1.Shape1.Brush.Color:=co; //在shape1里实时显示所选颜色
r:=getrvalue(co); //分离出红色
g:=getgvalue(co); //分离出绿色
b:=getbvalue(co); //分离出蓝色
rlab.Caption:='红色:'+inttostr(r);
glab.Caption:='绿色:'+inttostr(g);
blab.Caption:='蓝色:'+inttostr(b);
edit1.Text:='#';
cor[0]:=''; //由于程序与系统所用的调色板不同，应将之进行按位转换
cor[1]:=copy(inttohex(co,6),1,2);
cor[2]:=copy(inttohex(co,6),3,2);
cor[3]:=copy(inttohex(co,6),5,2);
cor[0]:=cor[3]+cor[2]+cor[1]; //转换后的颜色值
edit1.Text:=edit1.Text+cor[0];
end;
procedure TForm1.Shape1MouseDown(Sender:TObject;Button:TMouseButton);
Shift:TShiftState;X,Y:Integer;
begin
timer1.Enabled:=true;
label1.Visible:=false; {当点击shape1时进入鼠标取色模式，同时提示消失}
end;
注：此程序在Windows 98、Delphi 6.0环境下测试通过。