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 / Exemple :
{
################################################################################
# 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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.