[Delphi] DH GetColor 0.3

[BigBear]

Version final de este programa para encontrar el color de un pixel.

Una imagen :



El codigo :

Código [Seleccionar] Expandir


// DH GetColor 0.3
// (C) Doddy Hackman 2014
// Credits :
// Based on  : http://stackoverflow.com/questions/15155505/get-pixel-color-under-mouse-cursor-fast-way
// Based on : http://www.coldtail.com/wiki/index.php?title=Borland_Delphi_Example_-_Show_pixel_color_under_mouse_cursor

unit dh;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.pngimage,
  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Clipbrd;

type
  TForm1 = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    GroupBox1: TGroupBox;
    Shape1: TShape;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Timer2: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);

  private
    capturanow: HDC;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  capturanow := GetDC(0);
  if (capturanow <> 0) then
  begin
    Timer1.Enabled := True;
  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  aca: TPoint;
  color: TColor;
  re: string;

begin

  if GetCursorPos(aca) then
  begin
    color := GetPixel(capturanow, aca.X, aca.Y);
    Shape1.Brush.color := color;
    re := IntToHex(GetRValue(color), 2) + IntToHex(GetGValue(color), 2) +
      IntToHex(GetBValue(color), 2);
    Label2.Caption := re;
    StatusBar1.Panels[0].Text := '[+] Finding colors ...';
    Form1.StatusBar1.Update;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  re: Longint;
begin

  re := GetAsyncKeyState(65);
  if re = -32767 then
  begin
    Clipboard.AsText := Label2.Caption;
    StatusBar1.Panels[0].Text := '[+] Color copied to clipboard';
    Form1.StatusBar1.Update;
  end;

end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de aca.