简单取色器

看到同事用了一个取色器，叫远方屏幕取色器，看着挺有意思，发现一个bug，取色的时候内存一直往上爬(原因是没有释放DC)。。模仿着写了一个，人家30几K，猜着应该用vb或者C#写的用exeinfope查了下

果不其然，

用Delphi xe3 3M多。。去掉杂七杂八2M多

效果：

代码：

unit ColorPicker;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
    Vcl.ActnMan,
    Vcl.ActnColorMaps, Vcl.GraphUtil, VCLTee.TeCanvas, Vcl.Imaging.pngimage,
    Vcl.Buttons, Vcl.Clipbrd, System.UIConsts, Vcl.ComCtrls;

type
    TForm1 = class(TForm)
        Timer1: TTimer;
        ColorDialog1: TColorDialog;
        pgc1: TPageControl;
        ts1: TTabSheet;
        Label1: TLabel;
        lbl2: TLabel;
        btn1: TSpeedButton;
        lbl3: TLabel;
        Edit_hex: TEdit;
        pnl1: TPanel;
        Image2: TImage;
        Shape1: TShape;
        Panel2: TPanel;
        btn2: TButton;
        CheckBox1: TCheckBox;
        Memo1: TMemo;
        Image1: TImage;
        procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure Timer1Timer(Sender: TObject);
        procedure updateData(cc: Cardinal);
        procedure btn2Click(Sender: TObject);
        procedure chk1Click(Sender: TObject);
        procedure Image2MouseMove(Sender: TObject; Shift: TShiftState;
          X, Y: Integer);
        procedure btn1Click(Sender: TObject);
        procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

var
    r, g, b: Byte;
    col: Cardinal;

procedure TForm1.updateData(cc: Cardinal);
var
    h, s, l: Word;
begin
    r := GetRValue(cc);
    g := GetGValue(cc);
    b := GetBValue(cc);
    ColorRGBToHLS(cc, h, l, s);

    Memo1.Clear;
    Memo1.Lines.Add('红(R): ' + IntToStr(r));
    Memo1.Lines.Add('绿(G): ' + IntToStr(g));
    Memo1.Lines.Add('蓝(B): ' + IntToStr(b));
    Memo1.Lines.Add('色调(H): ' + IntToStr(h));
    Memo1.Lines.Add('饱和度(S): ' + IntToStr(s));
    Memo1.Lines.Add('亮度(L): ' + IntToStr(l));
    Edit_hex.Text := '#' + IntToHex(r, 2) + IntToHex(g, 2) + IntToHex(b, 2);
    // RGBToWebColorStr(cc)
end;

procedure TForm1.btn2Click(Sender: TObject);
var
    rect: TRect;
begin
    if not ColorDialog1.Execute then
        Exit;
    updateData(ColorDialog1.Color);
    Panel2.Color := ColorDialog1.Color;
    rect.SetLocation(0, 0);
    rect.Width := Image2.Width;
    rect.Height := Image2.Height;
    Image2.Canvas.Brush.Color := ColorDialog1.Color;
    Image2.Canvas.FillRect(rect);
end;

procedure TForm1.chk1Click(Sender: TObject);
begin
    if CheckBox1.Checked then
        self.FormStyle := fsStayOnTop
    else
        self.FormStyle := TFormStyle.fsNormal;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    h: HCURSOR;
begin
    Image1.Picture := nil;
    h := LoadCursor(HInstance, 'Cursor_1');
    SetSystemCursor(h, ocr_normal);
    Timer1.Enabled := true;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    Image1.Picture.Icon.LoadFromResourceName(HInstance, 'Icon_1');
    SystemParametersinfo(SPI_SETCURSORS, 0, NIL, SPIF_SENDCHANGE);
    Timer1.Enabled := false;
    WindowState := wsNormal;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
    Shape1.Left := (X div 16) * 16;
    Shape1.Top := (Y div 16) * 16;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    cal: Cardinal;
begin
    //
    cal := GetPixel(Image2.Canvas.Handle, Shape1.Left, Shape1.Top);
    Panel2.Color := cal;
    // Shape1.Left := x - 16;
    // Shape1.top := y - 16;
    updateData(cal);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
    //
    Clipboard.AsText := Edit_hex.Text;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
    outRect: TRect;
    point: TPoint;
    dc: HDC;
begin
    //
    GetCursorPos(point);
    outRect := rect(Form1.Left, Form1.Top, Form1.Left + Form1.Width,
      Form1.Top + Form1.Height);
    if not PtInRect(outRect, point) then
    begin
        Label1.Caption := 'x: ' + IntToStr(point.X) + ',y: ' +
          IntToStr(point.Y);
        dc := GetDC(0);
        col := GetPixel(dc, point.X, point.Y);

        updateData(col);
        Panel2.Color := col;
        StretchBlt(Image2.Canvas.Handle, 0, 0, Image2.Width, Image2.Height, dc,
          point.X - 5, point.Y - 2, 8, 8, SRCCOPY);
        // Image2.Canvas.FillRect();
        Image2.Refresh;
        ReleaseDC(0, dc);
    end;

end;

end.