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.
只需要将其加入你的任意一个工程文件中,便可运行!!
|