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
  • 1551 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 aca.

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!



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

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3260
Ú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: 2050
Ú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: 3502
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 2938
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear
Poner splash screen con progress bar en delphi

Iniciado por ANTRAX

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