随心所欲取颜色(鼠标经过的地方颜色值均可取到)

2008-04-09 04:31:10来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

unit Ugetcor;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;

type
Tgetcol = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
procedure FormClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1Click(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
tx,ty : integer;
procedure WMEraseBkng(var MSg:TWMEraseBkgnd);message WM_ERASEBKGND;
public
{ Public declarations }
end;

var
getcol: Tgetcol;
implementation

{$R *.DFM}
const
Digits : array[0..$F] of Char = ''''0123456789ABCDEF'''';

function HexB(B : Byte) : string;
{-Return hex string for byte}
begin
HexB[0] := #2;
HexB[1] := Digits[B shr 4];
HexB[2] := Digits[B and $F];
end;

procedure Tgetcol.WMEraseBkng(var MSg:TWMEraseBkgnd);
begin
Msg.Result:=1;
end;

procedure Tgetcol.FormClick(Sender: TObject);
var t : tcolor;
r,g,b : byte;
begin
t := canvas.pixels[tx,ty];
r := getRvalue(t);
g := getGvalue(t);
B := getBvalue(t);
LABEL2.COLOR := T;
LABEL1.CAPTION := ''''$00'''' HEXB(R) HEXB(G) HEXB(B);
end;

procedure Tgetcol.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
tx := x;
ty := y;
end;

procedure Tgetcol.Panel1Click(Sender: TObject);
begin
CLOSE;
end;

procedure Tgetcol.FormDblClick(Sender: TObject);
begin
close;
end;

procedure Tgetcol.FormResize(Sender: TObject);
begin
panel1.top := height - panel1.height -1;
panel1.left := width - panel1.width -1;
panel1.visible := true;
end;

end.

只需要将其加入你的任意一个工程文件中,便可运行!!

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:注册机制

下一篇:与文件相关Api函数列表