[Delphi] DH GetColor

[BigBear]

Un simple programa para buscar el color de un pixel.

Una imagen :



El codigo :

Código (delphi) [Seleccionar] Expandir


// DH GetColor 0.1
// Coded By Doddy H
// 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 get;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, sSkinManager, sGroupBox, sEdit, sLabel, ComCtrls,
  sStatusBar, acPNG, sMemo, Clipbrd;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    sSkinManager1: TsSkinManager;
    sGroupBox1: TsGroupBox;
    Shape1: TShape;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sStatusBar1: TsStatusBar;
    sGroupBox2: TsGroupBox;
    Image1: TImage;
    sLabel3: TsLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  sSkinManager1.SkinName := 'cold';
  sSkinManager1.Active := True;

  sLabel3.Caption := 'This program is used to' + #13 +
    'find the color of a pixel' + #13 + #13 + 'Use control + v to copy' + #13 +
    'the color to the clipboard' + #13 + #13 + #13 + 'The End ?';

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

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = 86) then
  begin
    Clipboard().AsText := sLabel2.Caption;
    sStatusBar1.Panels[0].Text := '[+] Color copied to clipboard';
    Form1.sStatusBar1.Update;
  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);
    sLabel2.Caption := re;
    sStatusBar1.Panels[0].Text := '[+] Finding colors ...';
    Form1.sStatusBar1.Update;
  end;
end;

end.

// The End ?


Si quieren bajar el programa lo pueden hacer de aca.