|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 COMPOSANT : TDBPCOLORPIKKER
 Information sur la source
 Description
Hello ! voici mon 18eme composant réalisé avec Delphi7 Le colorPikker est connu, il s'agit de la pipette ki chope le code RGB et HEXA de la pixel située sous le curseur de la souris. Elle contient le source de BLG, je lui ai ajouté des propriétés tres utile, on peut meintenant refaire le source de BLG avec 4 composants (donc 3 de base +1 le mien) et 0 ligne de code, je vous file la demo (projet + exe) pour vous en convaincre :) la fonction contenu dans le ActTimer est de BLG, merci a lui de m'avoir "expliqué" (lol) que c'etait le handle qui faisait office de refresh automatique :D PS : CECI EST UN COMPOSANT NON VISIBLE :) source de BLG : http://www.delphifr.com/code.aspx?ID=28414
 Source
- {
- ################################################################################
- # DBPCOLORPIKKER #
- ################################################################################
- # #
- # VERSION : 1.3 #
- # FICHIERS : dbpColorPikker.pas,.dcu,.dcr,.bmp,ReadMe.htm #
- # AUTEUR : Julio P. (Diabloporc) #
- # CREATION : 31 dec 2004 #
- # MODIFIEE : 02 dec 2004 #
- # SITE WEB : http://diabloporc.free.fr #
- # MAIL : juliobox@free.fr #
- # LEGAL : Free sous Licence GNU/GPL #
- # INFOS : Retrouvez moi sur www.delphifr.com : "JulioDelphi" #
- # #
- ################################################################################
- }
- unit dbpcolorpikker;
-
- interface
-
- uses
- controls, windows, SysUtils, Classes, graphics, extctrls, stdctrls;
-
- type
- TdbpInterval = 10..60000;
-
- TdbpColorPikker = class(TComponent)
- private
- FAbout: string;
- FBValue: Word;
- FCanvas: TCanvas;
- FColor: TColor;
- FColorInverted: TColor;
- FEnabled: Boolean;
- FFontColor: TColor;
- FGValue: Word;
- FHexa: Cardinal;
- FHexaString: string;
- FLabelHexa: TLabel;
- FLabelRGB: TLabel;
- FRGBString: string;
- FRValue: Word;
- FShape: TShape;
- FTimer: TTimer;
- FTimerEvent: TNotifyEvent;
- FTimerInterval: TdbpInterval;
- FUseInvertedFont: Boolean;
- procedure SetAbout(const s: string);
- procedure SetEnabled(Value: Boolean);
- procedure SetInterval(Value: TdbpInterval);
- protected
- procedure ActTimer(Sender: TObject);
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property BlueValue: Word read FBValue;
- property Color: TColor read FColor;
- property ColorInverted: TColor read FColorInverted;
- property GreenValue: Word read FGValue;
- property HexaString: string read FHexaString;
- property HexaValue: Cardinal read FHexa;
- property RedValue: Word read FRValue;
- property RGBString: string read FRGBString;
- published
- property About: string read FAbout write SetAbout;
- property DefaultFontColor: TColor read FFontColor write FFontColor;
- property Enabled: Boolean read FEnabled write SetEnabled default False;
- property Interval: TdbpInterval read FTimerInterval write SetInterval default 10;
- property LabelHexa: TLabel read FLabelHexa write FLabelHexa;
- property LabelRGB: TLabel read FLabelRGB write FLabelRGB;
- property OnTimer: TNotifyEvent read FTimerEvent write FTimerEvent;
- property Shape: TShape read FShape write FShape;
- property UseInvertedFont: Boolean read FUseInvertedFont write
- FUseInvertedFont default false;
- end;
-
- procedure Register;
-
- implementation
-
- {
- ******************************* TdbpColorPikker ********************************
- }
-
- constructor TdbpColorPikker.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- fCanvas := TCanvas.Create;
- fCanvas.Handle := GetWindowDC(GetDesktopWindow);
- fAbout := 'v1.3 par Julio P. (diabloporc)';
- fEnabled := False;
- fColor := clBlack;
- fRValue := 0;
- fGValue := 0;
- fBValue := 0;
- fHexa := 0;
- fTimerInterval := 10;
- fRGBString := 'RGB(0,0,0)';
- fHexaString := '#000000';
- fUseInvertedFont := false;
- fFontColor := clBlack;
-
- fTimer := TTimer.Create(self);
- fTimer.Enabled := fEnabled;
- fTimer.Interval := fTimerInterval;
- fTimer.OnTimer := ActTimer;
- end;
-
- destructor TdbpColorPikker.Destroy;
- begin
- fTimer.free;
- fCanvas.Free;
- inherited destroy;
- end;
-
- procedure TdbpColorPikker.ActTimer(Sender: TObject);
- begin
- if (csDesigning in ComponentState) then
- exit;
- fColor := fCanvas.Pixels[Mouse.CursorPos.X, Mouse.CursorPos.Y];
- fColorInverted := $00FFFFFF - fColor;
- fRValue := GetRValue(fColor);
- fGValue := GetGValue(fColor);
- fBValue := GetBValue(fColor);
- fHexa := StrToInt(format('$%s%s%s', [IntToHex(GetRValue(fColor), 2),
- IntToHex(GetGValue(fColor), 2), IntToHex(GetBValue(fColor), 2)]));
- fRGBString := format('RGB(%d,%d,%d)', [fRValue, fGValue, FBValue]);
- {fHExaString := format('#%s%s%s', [IntToHex(GetRValue(fColor), 2),
- IntToHex(GetGValue(fColor), 2), IntToHex(GetBValue(fColor), 2)]);}
-
- FHexaString := Format('#%.2x%.2x%.2x', [FRValue, FGValue, FBValue]);
-
- if assigned(FShape) then
- FShape.Brush.Color := fColor;
-
- if FUseInvertedFont then
- begin
- if Assigned(FLabelRGB) then
- fLabelRgb.Font.Color := fColorInverted;
- if Assigned(FLabelHexa) then
- FLabelHexa.Font.Color := FColorInverted;
- end
- else
- begin
- if Assigned(FLabelRgb) then
- FLabelRGB.Font.Color := fFontColor;
- if Assigned(FLabelHexa) then
- FLabelHexa.Font.Color := FFontColor;
- end;
-
- if assigned(fLabelRGB) then
- fLabelRGB.caption := fRGBString;
-
- if assigned(fLabelHexa) then
- fLabelHexa.caption := fHexaString;
-
- if Assigned(FTimerEvent) then
- FTimerEvent(Self);
- end;
-
- procedure TdbpColorPikker.Notification(AComponent: TComponent; Operation:
- TOperation);
- begin
- if Operation = opRemove then
- begin
- if aComponent = FShape then
- FShape := nil;
-
- if aComponent = fLabelRGB then
- fLabelRGB := nil;
-
- if aComponent = fLabelHexa then
- fLabelHexa := nil;
- end;
- end;
-
- procedure TdbpColorPikker.SetAbout(const s: string);
- begin
- //
- end;
-
- procedure TdbpColorPikker.SetEnabled(Value: Boolean);
- begin
- if Value = fEnabled then
- exit;
- fEnabled := value;
- fTimer.Enabled := Value;
- end;
-
- procedure TdbpColorPikker.SetInterval(Value: TdbpInterval);
- begin
- fTimer.interval := value;
- fTimerInterval := Value;
- end;
-
- procedure Register;
- begin
- RegisterComponents('Diabloporc', [TdbpColorPikker]);
- end;
-
- end.
-
{
################################################################################
# DBPCOLORPIKKER #
################################################################################
# #
# VERSION : 1.3 #
# FICHIERS : dbpColorPikker.pas,.dcu,.dcr,.bmp,ReadMe.htm #
# AUTEUR : Julio P. (Diabloporc) #
# CREATION : 31 dec 2004 #
# MODIFIEE : 02 dec 2004 #
# SITE WEB : http://diabloporc.free.fr #
# MAIL : juliobox@free.fr #
# LEGAL : Free sous Licence GNU/GPL #
# INFOS : Retrouvez moi sur www.delphifr.com : "JulioDelphi" #
# #
################################################################################
}
unit dbpcolorpikker;
interface
uses
controls, windows, SysUtils, Classes, graphics, extctrls, stdctrls;
type
TdbpInterval = 10..60000;
TdbpColorPikker = class(TComponent)
private
FAbout: string;
FBValue: Word;
FCanvas: TCanvas;
FColor: TColor;
FColorInverted: TColor;
FEnabled: Boolean;
FFontColor: TColor;
FGValue: Word;
FHexa: Cardinal;
FHexaString: string;
FLabelHexa: TLabel;
FLabelRGB: TLabel;
FRGBString: string;
FRValue: Word;
FShape: TShape;
FTimer: TTimer;
FTimerEvent: TNotifyEvent;
FTimerInterval: TdbpInterval;
FUseInvertedFont: Boolean;
procedure SetAbout(const s: string);
procedure SetEnabled(Value: Boolean);
procedure SetInterval(Value: TdbpInterval);
protected
procedure ActTimer(Sender: TObject);
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property BlueValue: Word read FBValue;
property Color: TColor read FColor;
property ColorInverted: TColor read FColorInverted;
property GreenValue: Word read FGValue;
property HexaString: string read FHexaString;
property HexaValue: Cardinal read FHexa;
property RedValue: Word read FRValue;
property RGBString: string read FRGBString;
published
property About: string read FAbout write SetAbout;
property DefaultFontColor: TColor read FFontColor write FFontColor;
property Enabled: Boolean read FEnabled write SetEnabled default False;
property Interval: TdbpInterval read FTimerInterval write SetInterval default 10;
property LabelHexa: TLabel read FLabelHexa write FLabelHexa;
property LabelRGB: TLabel read FLabelRGB write FLabelRGB;
property OnTimer: TNotifyEvent read FTimerEvent write FTimerEvent;
property Shape: TShape read FShape write FShape;
property UseInvertedFont: Boolean read FUseInvertedFont write
FUseInvertedFont default false;
end;
procedure Register;
implementation
{
******************************* TdbpColorPikker ********************************
}
constructor TdbpColorPikker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fCanvas := TCanvas.Create;
fCanvas.Handle := GetWindowDC(GetDesktopWindow);
fAbout := 'v1.3 par Julio P. (diabloporc)';
fEnabled := False;
fColor := clBlack;
fRValue := 0;
fGValue := 0;
fBValue := 0;
fHexa := 0;
fTimerInterval := 10;
fRGBString := 'RGB(0,0,0)';
fHexaString := '#000000';
fUseInvertedFont := false;
fFontColor := clBlack;
fTimer := TTimer.Create(self);
fTimer.Enabled := fEnabled;
fTimer.Interval := fTimerInterval;
fTimer.OnTimer := ActTimer;
end;
destructor TdbpColorPikker.Destroy;
begin
fTimer.free;
fCanvas.Free;
inherited destroy;
end;
procedure TdbpColorPikker.ActTimer(Sender: TObject);
begin
if (csDesigning in ComponentState) then
exit;
fColor := fCanvas.Pixels[Mouse.CursorPos.X, Mouse.CursorPos.Y];
fColorInverted := $00FFFFFF - fColor;
fRValue := GetRValue(fColor);
fGValue := GetGValue(fColor);
fBValue := GetBValue(fColor);
fHexa := StrToInt(format('$%s%s%s', [IntToHex(GetRValue(fColor), 2),
IntToHex(GetGValue(fColor), 2), IntToHex(GetBValue(fColor), 2)]));
fRGBString := format('RGB(%d,%d,%d)', [fRValue, fGValue, FBValue]);
{fHExaString := format('#%s%s%s', [IntToHex(GetRValue(fColor), 2),
IntToHex(GetGValue(fColor), 2), IntToHex(GetBValue(fColor), 2)]);}
FHexaString := Format('#%.2x%.2x%.2x', [FRValue, FGValue, FBValue]);
if assigned(FShape) then
FShape.Brush.Color := fColor;
if FUseInvertedFont then
begin
if Assigned(FLabelRGB) then
fLabelRgb.Font.Color := fColorInverted;
if Assigned(FLabelHexa) then
FLabelHexa.Font.Color := FColorInverted;
end
else
begin
if Assigned(FLabelRgb) then
FLabelRGB.Font.Color := fFontColor;
if Assigned(FLabelHexa) then
FLabelHexa.Font.Color := FFontColor;
end;
if assigned(fLabelRGB) then
fLabelRGB.caption := fRGBString;
if assigned(fLabelHexa) then
fLabelHexa.caption := fHexaString;
if Assigned(FTimerEvent) then
FTimerEvent(Self);
end;
procedure TdbpColorPikker.Notification(AComponent: TComponent; Operation:
TOperation);
begin
if Operation = opRemove then
begin
if aComponent = FShape then
FShape := nil;
if aComponent = fLabelRGB then
fLabelRGB := nil;
if aComponent = fLabelHexa then
fLabelHexa := nil;
end;
end;
procedure TdbpColorPikker.SetAbout(const s: string);
begin
//
end;
procedure TdbpColorPikker.SetEnabled(Value: Boolean);
begin
if Value = fEnabled then
exit;
fEnabled := value;
fTimer.Enabled := Value;
end;
procedure TdbpColorPikker.SetInterval(Value: TdbpInterval);
begin
fTimer.interval := value;
fTimerInterval := Value;
end;
procedure Register;
begin
RegisterComponents('Diabloporc', [TdbpColorPikker]);
end;
end.
 Conclusion
description du screen : - 1 TShape aux coins arrondis - 2 TLabel - 1 TdbpColorPikker (le reste c du vent pour faire mignon : 1 TImage, 2 TBevel, et 2 label) le shape, et les label changent de couleur et de caption grace au compo, le projet contient 0 ligne de code dans unit1.pas :) bugs ? ameliorations ? MP ou mail ! http://diabloporc.free.fr
 Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
 Télécharger le zip
 Historique
- 31 décembre 2004 17:56:33 :
- c'est un composant non visible !!
- 02 janvier 2005 01:08:48 :
- correction de delphiprog mises a jour, merci a toi :)
- 02 janvier 2005 01:23:10 :
- :)
 Sources du même auteur
 Sources de la même categorie
Sources en rapport avec celle ci
 Commentaires et avis
 Discussions en rapport avec ce code source dans le forum
Couleur RGB 24bits vers RGB 16bits [ par balgrim ]
Vonjour, j'aimerais savoir si il existe une procedure pour convertir les couleur 24bits en couleur 16bits... merci :)
De l'aide !!!! svp !!!! [ par zywx ]
Voila c'est à cause de mon moteur physik !!! J'aarive pas à obtenir la couleur d'un pixel d'un Trect !!
couleur pixel à partir d'un jpeg [ par kacola ]
Bonjour, est-il possible de récupérer la couleur du pixel de coordonnées (X;Y) d'une image jpeg?Merci.
Couleur Hexa [ par lan0sic ]
Savez vous comment convertir une variable Tcolor en couleur hexa html?Merci ;)Lanosic
couleur d'un pixel d'une video webcam [ par serbon ]
BonjourJe suis en train de faire un orgue lazer: le principe est simple, des lazer tombes du plafond, et se réfléchissent vers un écran, lequel est fi
Couleur Pixel écran [ par cedricbi ]
Bonjour,Je cherche une fonction permettant de récuperer la couleur d'un pixel de l'écran. Il y a la fonction GetPixel mais, elle est trop lente pour c
hexa vers string ? [ par Nero` ]
bonsoir à tous .Je rencontre un petit problème de débutant .J'ai besoin de lire un octèt dans un fichier et ensuit de l'afficher dans une textbox ou a
Problème impression couleur [ par kacola ]
Bonjour, j'ai une imprimante couleur Canon MP780 et une Laser N&B Canon (qui est par défaut),Je souhaite imprimer une image (un jpeg) en couleur,
Appliquer un cadre de couleur ou avec un bitmap [ par cincap ]
Bonjour à toutes et à tous,Voici mon problème du jour, après avoir redimensionné une image et avant de la sauver en jpeg, est t'il possible de lui app
Couleur [ par jlch24 ]
Je cherche à colorier une zone en consevant transparence la couleur du fondComment faire en Delphi ? merci
|
 Téléchargements
Logiciels à télécharger sur le même thème :
|