comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] DH GetColor 0.3

  • 1 Respuestas
  • 1430 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Mayo 16, 2014, 01:21:11 pm »
Version final de este programa para encontrar el color de un pixel.

Una imagen :



El codigo :

Código: Delphi
  1. // DH GetColor 0.3
  2. // (C) Doddy Hackman 2014
  3. // Credits :
  4. // Based on  : http://stackoverflow.com/questions/15155505/get-pixel-color-under-mouse-cursor-fast-way
  5. // Based on : http://www.coldtail.com/wiki/index.php?title=Borland_Delphi_Example_-_Show_pixel_color_under_mouse_cursor
  6.  
  7. unit dh;
  8.  
  9. interface
  10.  
  11. uses
  12.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  13.   System.Classes, Vcl.Graphics,
  14.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.pngimage,
  15.   Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Clipbrd;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     Image1: TImage;
  20.     StatusBar1: TStatusBar;
  21.     Timer1: TTimer;
  22.     GroupBox1: TGroupBox;
  23.     Shape1: TShape;
  24.     GroupBox2: TGroupBox;
  25.     Memo1: TMemo;
  26.     Label1: TLabel;
  27.     Label2: TLabel;
  28.     Timer2: TTimer;
  29.     procedure Timer1Timer(Sender: TObject);
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure Timer2Timer(Sender: TObject);
  32.  
  33.   private
  34.     capturanow: HDC;
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.dfm}
  46.  
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. begin
  49.  
  50.   capturanow := GetDC(0);
  51.   if (capturanow <> 0) then
  52.   begin
  53.     Timer1.Enabled := True;
  54.   end;
  55.  
  56. end;
  57.  
  58. procedure TForm1.Timer1Timer(Sender: TObject);
  59. var
  60.   aca: TPoint;
  61.   color: TColor;
  62.   re: string;
  63.  
  64. begin
  65.  
  66.   if GetCursorPos(aca) then
  67.   begin
  68.     color := GetPixel(capturanow, aca.X, aca.Y);
  69.     Shape1.Brush.color := color;
  70.     re := IntToHex(GetRValue(color), 2) + IntToHex(GetGValue(color), 2) +
  71.       IntToHex(GetBValue(color), 2);
  72.     Label2.Caption := re;
  73.     StatusBar1.Panels[0].Text := '[+] Finding colors ...';
  74.     Form1.StatusBar1.Update;
  75.   end;
  76. end;
  77.  
  78. procedure TForm1.Timer2Timer(Sender: TObject);
  79. var
  80.   re: Longint;
  81. begin
  82.  
  83.   re := GetAsyncKeyState(65);
  84.   if re = -32767 then
  85.   begin
  86.     Clipboard.AsText := Label2.Caption;
  87.     StatusBar1.Panels[0].Text := '[+] Color copied to clipboard';
  88.     Form1.StatusBar1.Update;
  89.   end;
  90.  
  91. end;
  92.  
  93. end.
  94.  
  95. // The End ?
  96.  

Si quieren bajar el programa lo pueden hacer de No tienes permisos para ver links. Registrate o Entra con tu cuenta.

Desconectado Snifer

  • *
  • Underc0der
  • Mensajes: 1439
  • Actividad:
    0%
  • Reputación 1
  • Snifer@L4b's
    • Ver Perfil
    • Snifer@L4bs
  • Twitter: sniferl4bs
« Respuesta #1 en: Mayo 16, 2014, 02:09:19 pm »
Excelente aporte!

Enviado desde mi Snifer Mobile - Perdonen los errores tipográficos

No tienes permisos para ver links. Registrate o Entra con tu cuenta


Llaman traidor a la persona que evito que caiga el foro, gente bruta!



 

¿Te gustó el post? COMPARTILO!



Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3130
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1984
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3258
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Project Spartacus 1.0 (Regalo de Navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 1603
Último mensaje Diciembre 26, 2014, 11:54:34 pm
por n4pst3r
Poner splash screen con progress bar en delphi

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2886
Último mensaje Febrero 24, 2010, 04:54:23 pm
por ANTRAX