Choix de couleurs personnalisées.

Soyez le premier à donner votre avis sur cette source.

Vue 2 533 fois - Téléchargée 472 fois

Description

Sans prétentions aucunes, programme permettant de choisir rapidement une couleur, et de pouvoir l'intégrer dans un programme.
Couleur donnée en RGB, et Hexadécimal

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_pseudo3
Messages postés
270
Date d'inscription
mardi 24 juillet 2007
Statut
Membre
Dernière intervention
7 juin 2018
-
Bonjour,

J'ai bien aimé le principe de l'interface, par contre dans le code il y avait plein de trucs à simplifier notamment dans la Function Chif(motChif : string) simplifiable par utilisation de StrToInt et la ColorToString(Cor : TColor) simplifiable par utilisation de la ColorToString qui existe déjà dans l'unité Graphics et comme j'ai vraiment pas aimé la cuisine de gestion de la luminosité et que le sujet m'intéresse j'y ai appliqué les conversions RGB <-> H.S.L et voici le code qui tient compte de tout ceci :

unit Couleurs;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
TrackBar3: TTrackBar;
TrackBar4: TTrackBar;
Label7: TLabel; // < Ajouté our afficher la luminosité
procedure FormCreate(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure TrackBar3Change(Sender: TObject);
procedure TrackBar4Change(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Edit2Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
clChoisie: TColor; // pour pouvoir récupérer la couleur choisie depuis une autre fiche
ValHexa: string; // et éventuellement ses autres paramètres
RR, GG, BB: byte; HH, SS, LL: double; // HH Hue Teinte, SS = Saturation, LL = Luminosité (intervalle 0..1)
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function Chif(motChif: string): integer;
var NbChi1, erreur: integer;
MCh: string;
begin if motChif = '' then begin Result := 0; EXIT; end;
Result := StrToInt(motChif); // Simplification par utilisation de StrToInt
if Result > 255 then Result := 255; // Empêcher de saisir des nombres > 255
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
// Empêcher de saisir des valeurs négatives ou des caractères non numériques
begin if (Key = '.') then Key := #0;
if not (Key in ['0'..'9', Chr(VK_BACK), Chr(VK_DELETE)])
then Key := #0;
// Les propriétés des évènements OnKeyPress des Edit2 et Edit3 doivent pointer vers Edit1KeyPress dans l'Inspecteur d'Objets
// cela évite de reproduire cette procédure pour les autres Edit's
end;

function ColorToString2(Cor: TColor): string; // Léger changement de nom pour simplifier le code en utilisant la ColorToString de l'unité Graphics
// Renvoie le texte de la couleur en Héxadécimal
begin Form1.ValHexa := ColorToString(cor);
Result := 'Couleur en Hexadécimal : ' + Form1.ValHexa;
end;

// Pour les changement de couleurs ou de luminosité : ----- Conversions RGB <-> H.S.L ----------

procedure RGBtoHSL3(RGB3: TRGBTriple; var H, S, L: double);// pour R 184, G 151, B =52, renvoie :// H 0,125 (et x 360 45) (ou x 240 = 30 Idem Delphi) <- Teinte// S 0,559322033898305 (et x 240 134 Idem Delphi) <- Saturation// L 0,462745098039216 (et x 240 111 Idem Delphi) <- Luminosité

var delta, r, g, b, cmax, cmin: double;
begin
r := RGB3.rgbtRed / 255;
g := RGB3.rgbtGreen / 255;
b := RGB3.rgbtBlue / 255;

if (r > b) and (r > g) then cmax := r
else if g > b then cmax := g
else cmax := b;

if (r < b) and (r < g) then cmin := r
else if g < b then cmin := g
else cmin := b;

L := (cmax + cmin) / 2.0;

if cmax = cmin then begin
S := 0;
H := 0; // Teinte indéfinie
end else begin
delta := cmax - cmin;
if L <= 0.5 then s := delta / (cmax + cmin)
else s := delta / (2.0 - cmax - cmin);

if r = cmax then H := (g - b) / delta
else if g = cmax then H := 2.0 + (b - r) / delta
else H := 4.0 + (r - g) / delta;
H := H / 6.0;
if H < 0 then H := H + 1;
end;
end;

procedure HSLtoRGB3(H, S, L: double; var RGB3: TRGBTriple);
var r, g, b, m1, m2: double;

function HuetoRGB(m1, m2, h: double): double;
begin if h < 0 then h := h + 1.0
else if h > 1 then h := h - 1.0;

if 6.0 * h < 1 then result := (m1 + (m2 - m1) * h * 6.0)
else if 2.0 * h < 1 then result := m2
else if 3.0 * h < 2.0 then result := (m1 + (m2 - m1) * ((2.0 / 3.0) - h) * 6.0)
else result := m1;
end;

begin if S = 0 then begin
r := L;
g := L;
b := L;
end else begin
if L <= 0.5 then m2 := L * (1.0 + S)
else m2 := L + S - L * S;
m1 := 2.0 * L - m2;
r := HuetoRGB(m1, m2, H + 1.0 / 3.0);
g := HuetoRGB(m1, m2, H);
b := HuetoRGB(m1, m2, H - 1.0 / 3.0);
end;
RGB3.rgbtBlue := round(b * 255);
RGB3.rgbtGreen := round(g * 255);
RGB3.rgbtRed := round(r * 255);
end; //HSLtoRGB3

procedure ActuLabelsEtEdits(const R, G, B: byte);
var RGB3: TRGBTriple; H, S, L: double;
begin with Form1 do begin
// Couleurs :
edit1.text := inttostr(R);
edit2.text := inttostr(G);
edit3.text := inttostr(B);
clChoisie := RGB(R, G, B);
Panel1.Color := clChoisie;
ValHexa := ColorToString(clChoisie);
Label4.Caption := ColorToString2(clChoisie);
Label5.Caption := 'Couleur := RGB(' + inttostr(R) + ',' + inttostr(G) + ',' + inttostr(B) + ')';
// Luminosité :
with RGB3 do begin rgbtRed := R; rgbtGreen := G; rgbtBlue := B; end;
RGBtoHSL3(RGB3, H, S, L);
with form1 do begin HH := H; SS := S; LL := L; end;
label7.caption := IntToStr(round(L * 240));
end;
end;

procedure ActuPositions(const R, G, B: byte);
var RGB3: TRGBTriple; H, S, L: double;
begin with Form1 do begin
// Couleurs :
TrackBar1.position := R;
TrackBar2.position := G;
TrackBar3.position := B;
// Luminosité :
with RGB3 do begin rgbtRed := R; rgbtGreen := G; rgbtBlue := B; end;
RGBtoHSL3(RGB3, H, S, L);
Trackbar4.position := round(L * 240);
end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
// Changements dans Edit1
begin RR := Chif(form1.edit1.text);
ActuLabelsEtEdits(RR, GG, BB);
ActuPositions(RR, GG, BB);
end;

procedure TForm1.Edit2Change(Sender: TObject);
// Changements dans Edit2
begin GG := Chif(form1.edit2.text);
ActuLabelsEtEdits(RR, GG, BB);
ActuPositions(RR, GG, BB);
end;

procedure TForm1.Edit3Change(Sender: TObject);
// Changements dans Edit3
begin BB := Chif(form1.edit3.text);
ActuLabelsEtEdits(RR, GG, BB);
ActuPositions(RR, GG, BB);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
// Changement dans le trackbar du rouge
begin RR := trackbar1.position;
ActuLabelsEtEdits(RR, GG, BB);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
// Changement dans le trackbar du vert
begin GG := trackbar2.position;
ActuLabelsEtEdits(RR, GG, BB);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
// Changement dans le trackbar du Bleu
begin BB := trackbar3.position;
ActuLabelsEtEdits(RR, GG, BB);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin color := RGB(212, 204, 187); // couleur Beige
RR := 0; GG := 127; BB := 127; // couleur proche de clTeal
ActuLabelsEtEdits(RR, GG, BB);
ActuPositions(RR, GG, BB);
end;

procedure TForm1.TrackBar4Change(Sender: TObject);
// Changement de luminosité
var R, G, B, Lum: integer; Coul: tcolor;
RGB3: TRGBTriple; H, S, L: double; NouvelleLum: double;
begin
with RGB3 do begin
rgbtRed := RR;
rgbtGreen := GG;
rgbtBlue := BB;
RGBtoHSL3(RGB3, H, S, L); // Récupération de la teinte et de la saturation
Trackbar4.Max := 240; // <- à déclarer plutôt dans l'inspecteur d'objets
NouvelleLum := Trackbar4.position / 240; // Récupération de la nouvelle luminosité
HSLtoRGB3(H, S, NouvelleLum, RGB3); // Récupération de RGB3 changée compte tenu de la nouvelle luminosité
RR := RGB3.rgbtRed;
GG := RGB3.rgbtGreen;
BB := RGB3.rgbtBlue;
ActuLabelsEtEdits(RR, GG, BB);
end;
end;

end.

A+.
francoisbalsan
Messages postés
3
Date d'inscription
samedi 29 décembre 2007
Statut
Membre
Dernière intervention
27 juin 2012
-
Merci pour tes commentaires, mais, je connaissais peu les calculs avec ''HSL''.
Quand aux simplifications, procédure chif, merci.
Un programme similaire avec Bouton couleur et scanline est en ligne.
cs_pseudo3
Messages postés
270
Date d'inscription
mardi 24 juillet 2007
Statut
Membre
Dernière intervention
7 juin 2018
-
Bonjour,

>> "Un programme similaire avec Bouton couleur et scanline est en ligne." :
Oui, j'ai vu et consulté.
Pour ma part j'utilise un truc plus simple en créant des boutons colorés en utilisant des TLabel dont j'utilise la propriété Canvas pour y tracer ligne par ligne les couleurs d'un petit BitMap chargé dans un TImage invisible. En utilisant un petit BitMap (de largeur mini = qq Pixels et de hauteur égale à celle des TLabel) dont les couleurs varient de haut vers le bas ça permet d'obtenir des boutons profilés (Bombés, en creux, ou striés) et de n'importe quelles couleurs (Dégradées, ou plates).
Ces couleurs n'apparaissent donc qu'au lancement de l'application.
On pourrait également utiliser un BitMap de taille égale à celle des boutons et contenant n'importe quel dessin ou texture polychrome.
Si le sujet t'intéresse tu peux télécharger le code que j'ai publié sous le titre de LE TRI PAR CASIERS (ne pas se fier à la capture d'écran si celle comporte encore des boutons blancs datant d'avant la mise jour).

A+.

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.