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

  • 1 Respuestas
  • 1507 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Agosto 23, 2013, 01:44:46 pm »
Un simple programa para buscar el color de un pixel.

Una imagen :



El codigo :

Código: Delphi
  1. // DH GetColor 0.1
  2. // Coded By Doddy H
  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 get;
  8.  
  9. interface
  10.  
  11. uses
  12.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  13.   Dialogs, ExtCtrls, StdCtrls, sSkinManager, sGroupBox, sEdit, sLabel, ComCtrls,
  14.   sStatusBar, acPNG, sMemo, Clipbrd;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     Timer1: TTimer;
  19.     sSkinManager1: TsSkinManager;
  20.     sGroupBox1: TsGroupBox;
  21.     Shape1: TShape;
  22.     sLabel1: TsLabel;
  23.     sLabel2: TsLabel;
  24.     sStatusBar1: TsStatusBar;
  25.     sGroupBox2: TsGroupBox;
  26.     Image1: TImage;
  27.     sLabel3: TsLabel;
  28.     procedure Timer1Timer(Sender: TObject);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  31.  
  32.   private
  33.     capturanow: HDC;
  34.     { Private declarations }
  35.   public
  36.     { Public declarations }
  37.   end;
  38.  
  39. var
  40.   Form1: TForm1;
  41.  
  42. implementation
  43.  
  44. {$R *.dfm}
  45.  
  46. procedure TForm1.FormCreate(Sender: TObject);
  47. begin
  48.  
  49.   sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  50.   sSkinManager1.SkinName := 'cold';
  51.   sSkinManager1.Active := True;
  52.  
  53.   sLabel3.Caption := 'This program is used to' + #13 +
  54.     'find the color of a pixel' + #13 + #13 + 'Use control + v to copy' + #13 +
  55.     'the color to the clipboard' + #13 + #13 + #13 + 'The End ?';
  56.  
  57.   capturanow := GetDC(0);
  58.   if (capturanow <> 0) then
  59.     Timer1.Enabled := True;
  60. end;
  61.  
  62. procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  63. begin
  64.   if (Shift = [ssCtrl]) and (Key = 86) then
  65.   begin
  66.     Clipboard().AsText := sLabel2.Caption;
  67.     sStatusBar1.Panels[0].Text := '[+] Color copied to clipboard';
  68.     Form1.sStatusBar1.Update;
  69.   end;
  70. end;
  71.  
  72. procedure TForm1.Timer1Timer(Sender: TObject);
  73. var
  74.   aca: TPoint;
  75.   color: TColor;
  76.   re: string;
  77.  
  78. begin
  79.  
  80.   if GetCursorPos(aca) then
  81.   begin
  82.     color := GetPixel(capturanow, aca.x, aca.y);
  83.     Shape1.Brush.color := color;
  84.     re := '#' + IntToHex(GetRValue(color), 2) + IntToHex(GetGValue(color), 2)
  85.       + IntToHex(GetBValue(color), 2);
  86.     sLabel2.Caption := re;
  87.     sStatusBar1.Panels[0].Text := '[+] Finding colors ...';
  88.     Form1.sStatusBar1.Update;
  89.   end;
  90. end;
  91.  
  92. end.
  93.  
  94. // The End ?
  95.  

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

Desconectado Flemon

  • *
  • Underc0der
  • Mensajes: 235
  • Actividad:
    0%
  • Reputación 0
  • NO HAY FORMA DE DETENERME!!
    • Ver Perfil
    • Email
« Respuesta #1 en: Agosto 23, 2013, 09:40:33 pm »
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

 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1983
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

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

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3257
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1411
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 2575
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear