[Delphi] DH GetColor

Iniciado por BigBear, Agosto 23, 2013, 01:44:46 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Un simple programa para buscar el color de un pixel.

Una imagen :



El codigo :

Código: delphi

// 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 You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.

Excelente bro, viene de 10 para los que estamos comenzando... Muchas gracias!!!!!!!
No intentes pararme, trata de defenderte, trata de matarme, pero de cualqueir forma TE SUPERARE